From df47812ee1b8fe91972c142559bf4bf08c9064ea Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 6 Nov 2023 13:13:05 +0100 Subject: [PATCH 1/5] prototype indent for hamocc using emacs --- hamocc/aufr_bgc.F90 | 1054 ++++---- hamocc/aufw_bgc.F90 | 1786 ++++++------- hamocc/carchm.F90 | 1219 +++++---- hamocc/carchm_kequi.F90 | 300 +-- hamocc/carchm_solve.F90 | 181 +- hamocc/carchm_solve_DICsat.F90 | 194 +- hamocc/cyano.F90 | 160 +- hamocc/dipowa.F90 | 254 +- hamocc/get_cfc.F90 | 352 +-- hamocc/hamocc4bcm.F90 | 792 +++--- hamocc/hamocc_init.F90 | 174 +- hamocc/hamocc_step.F90 | 24 +- hamocc/inventory_bgc.F90 | 2620 +++++++++---------- hamocc/mo_Gdata_read.F90 | 1514 +++++------ hamocc/mo_apply_fedep.F90 | 191 +- hamocc/mo_apply_ndep.F90 | 213 +- hamocc/mo_apply_oafx.F90 | 158 +- hamocc/mo_apply_rivin.F90 | 331 ++- hamocc/mo_bgcmean.F90 | 4410 ++++++++++++++++---------------- hamocc/mo_biomod.F90 | 554 ++-- hamocc/mo_boxatm.F90 | 270 +- hamocc/mo_carbch.F90 | 570 ++--- hamocc/mo_chemcon.F90 | 386 +-- hamocc/mo_clim_swa.F90 | 215 +- hamocc/mo_control_bgc.F90 | 46 +- hamocc/mo_ini_fields.F90 | 494 ++-- hamocc/mo_intfcblom.F90 | 890 +++---- hamocc/mo_param1_bgc.F90 | 844 +++--- hamocc/mo_param_bgc.F90 | 282 +- hamocc/mo_read_fedep.F90 | 302 +-- hamocc/mo_read_ndep.F90 | 396 +-- hamocc/mo_read_oafx.F90 | 622 ++--- hamocc/mo_read_pi_ph.F90 | 94 +- hamocc/mo_read_rivin.F90 | 304 +-- hamocc/mo_read_sedpor.F90 | 198 +- hamocc/mo_sedmnt.F90 | 780 +++--- hamocc/mo_vgrid.F90 | 526 ++-- hamocc/ncout_hamocc.F90 | 1168 ++++----- hamocc/netcdf_def_vardb.F90 | 434 ++-- hamocc/ocprod.F90 | 1948 +++++++------- hamocc/powach.F90 | 744 +++--- hamocc/powadi.F90 | 164 +- hamocc/preftrc.F90 | 80 +- hamocc/profile_gd.F90 | 318 +-- hamocc/read_netcdf_var.F90 | 232 +- hamocc/restart_hamoccwt.F90 | 6 +- hamocc/sedshi.F90 | 450 ++-- hamocc/trc_limitc.F90 | 116 +- hamocc/write_netcdf_var.F90 | 300 +-- 49 files changed, 14825 insertions(+), 14835 deletions(-) diff --git a/hamocc/aufr_bgc.F90 b/hamocc/aufr_bgc.F90 index e2b56785..0dd24c9d 100644 --- a/hamocc/aufr_bgc.F90 +++ b/hamocc/aufr_bgc.F90 @@ -18,579 +18,579 @@ ! along with BLOM. If not, see https://www.gnu.org/licenses/. - SUBROUTINE AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & - kplyear,kplmon,kplday,omask,rstfnm) -!****************************************************************************** -! -!**** *AUFR_BGC* - reads marine bgc restart data. -! -! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 -! -! Modified -! -------- -! S.Legutke, *MPI-MaD, HH* 10.04.01 -! - extra SBR for reading bgc data from the restart file. -! S.Legutke, *MPI-MaD, HH* 15.08.01 -! - netCDF version (with cond.comp. PNETCDF) -! - no use of chemc values from netCDF restart -! -! Patrick Wetzel, *MPI-Met, HH* 16.04.02 -! - read chemcm(i,j,7,12) from netCDF restart -! -! J.Schwinger, *GFI, Bergen* 2013-10-21 -! - removed reading of chemcm and ak* fields -! - code cleanup, remoded preprocessor option "PNETCDF" -! and "NOMPI" -! -! J.Schwinger, *GFI, Bergen* 2014-05-21 -! - adapted code for writing of two time level tracer -! and sediment fields -! -! A.Moree, *GFI, Bergen* 2018-04-12 -! - new version of carbon isotope code -! -! J.Tjiputra, *Uni Research, Bergen* 2018-04-12 -! - added preformed and saturated DIC tracers -! -! J.Schwinger, *Uni Research, Bergen* 2018-04-12 -! - added cappability to restart c-isotopes from scratch (from -! 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 -! not found in the restart file. -! - removed satn2o which is not needed to restart the model -! - added sediment bypass preprocessor option -! -! J.Schwinger, *Uni Research, Bergen* 2018-08-23 -! - added reading of atmosphere field for BOXATM -! -! M. Bentsen, *NORCE, Bergen* 2020-05-03 -! - changed ocean model from MICOM to BLOM -! -! Purpose -! ------- -! Read restart data to continue an interrupted integration. -! -! Method -! ------- -! 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 -! difference of the offsets of restart files. -! -! -!** Interface to ocean model (parameter list): -! ----------------------------------------- -! -! *INTEGER* *kpie* - 1st dimension of model grid. -! *INTEGER* *kpje* - 2nd dimension of model grid. -! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. -! *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 -! ocean model [mol/kg] -! *INTEGER* *kplyear* - year in ocean restart date -! *INTEGER* *kplmon* - month in ocean restart date -! *INTEGER* *kplday* - day in ocean restart date -! *REAL* *omask* - land/ocean mask -! *CHAR* *rstfnm* - restart file name-informations -! -! -!************************************************************************** +SUBROUTINE AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & + kplyear,kplmon,kplday,omask,rstfnm) + !****************************************************************************** + ! + !**** *AUFR_BGC* - reads marine bgc restart data. + ! + ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 + ! + ! Modified + ! -------- + ! S.Legutke, *MPI-MaD, HH* 10.04.01 + ! - extra SBR for reading bgc data from the restart file. + ! S.Legutke, *MPI-MaD, HH* 15.08.01 + ! - netCDF version (with cond.comp. PNETCDF) + ! - no use of chemc values from netCDF restart + ! + ! Patrick Wetzel, *MPI-Met, HH* 16.04.02 + ! - read chemcm(i,j,7,12) from netCDF restart + ! + ! J.Schwinger, *GFI, Bergen* 2013-10-21 + ! - removed reading of chemcm and ak* fields + ! - code cleanup, remoded preprocessor option "PNETCDF" + ! and "NOMPI" + ! + ! J.Schwinger, *GFI, Bergen* 2014-05-21 + ! - adapted code for writing of two time level tracer + ! and sediment fields + ! + ! A.Moree, *GFI, Bergen* 2018-04-12 + ! - new version of carbon isotope code + ! + ! J.Tjiputra, *Uni Research, Bergen* 2018-04-12 + ! - added preformed and saturated DIC tracers + ! + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - added cappability to restart c-isotopes from scratch (from + ! 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 + ! not found in the restart file. + ! - removed satn2o which is not needed to restart the model + ! - added sediment bypass preprocessor option + ! + ! J.Schwinger, *Uni Research, Bergen* 2018-08-23 + ! - added reading of atmosphere field for BOXATM + ! + ! M. Bentsen, *NORCE, Bergen* 2020-05-03 + ! - changed ocean model from MICOM to BLOM + ! + ! Purpose + ! ------- + ! Read restart data to continue an interrupted integration. + ! + ! Method + ! ------- + ! 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 + ! difference of the offsets of restart files. + ! + ! + !** Interface to ocean model (parameter list): + ! ----------------------------------------- + ! + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. + ! *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 + ! ocean model [mol/kg] + ! *INTEGER* *kplyear* - year in ocean restart date + ! *INTEGER* *kplmon* - month in ocean restart date + ! *INTEGER* *kplday* - day in ocean restart date + ! *REAL* *omask* - land/ocean mask + ! *CHAR* *rstfnm* - restart file name-informations + ! + ! + !************************************************************************** - use netcdf, only: nf90_global,nf90_noerr,nf90_nowrite,nf90_close,nf90_open,nf90_get_att,nf90_inq_varid - use mod_xc, only: nbdy,mnproc,iqr,jqr,xcbcst,xchalt - use mod_dia, only: iotype - use mo_carbch, only: co2star,co3,hi,satoxy,ocetra,atm,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, & - 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 - use mo_vgrid, only: kbo - use mo_sedmnt, only: sedhpl - use mo_intfcblom, only: sedlay2,powtra2,burial2,atm2 - use mo_param_bgc, only: bifr13,bifr14,c14fac,re1312,re14to,prei13,prei14 + use netcdf, only: nf90_global,nf90_noerr,nf90_nowrite,nf90_close,nf90_open,nf90_get_att,nf90_inq_varid + use mod_xc, only: nbdy,mnproc,iqr,jqr,xcbcst,xchalt + use mod_dia, only: iotype + use mo_carbch, only: co2star,co3,hi,satoxy,ocetra,atm,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, & + 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 + use mo_vgrid, only: kbo + use mo_sedmnt, only: sedhpl + use mo_intfcblom, only: sedlay2,powtra2,burial2,atm2 + use mo_param_bgc, only: bifr13,bifr14,c14fac,re1312,re14to,prei13,prei14 - implicit none + implicit none - 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 + 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, 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 - REAL :: rco213,rco214,alpha14,beta13,beta14,d13C_atm,d14cat ! cisonew - INTEGER :: ncid,ncstat,ncvarid + ! Local variables + 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 + REAL :: rco213,rco214,alpha14,beta13,beta14,d13C_atm,d14cat ! cisonew + INTEGER :: ncid,ncstat,ncvarid #ifdef PNETCDF # include # include - integer*4 ,save :: info=MPI_INFO_NULL - integer :: mpicomm,mpierr,mpireq,mpistat - common/xcmpii/ mpicomm,mpierr,mpireq(4), & - & mpistat(mpi_status_size,4*max(iqr,jqr)) - save /xcmpii/ + integer*4 ,save :: info=MPI_INFO_NULL + integer :: mpicomm,mpierr,mpireq,mpistat + common/xcmpii/ mpicomm,mpierr,mpireq(4), & + & mpistat(mpi_status_size,4*max(iqr,jqr)) + save /xcmpii/ #endif - character(len=3) :: stripestr - 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 - ! - testio=0 - IF(mnproc==1 .AND. IOTYPE==0) THEN - - ncstat = NF90_OPEN(rstfnm,NF90_NOWRITE, ncid) - IF ( ncstat .NE. NF90_NOERR ) THEN - CALL xchalt('(AUFR: Problem with netCDF1)') - stop '(AUFR: Problem with netCDF1)' - ENDIF - ! - ! 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)' - ENDIF - restyear = idate(1) - restmonth = idate(2) - restday = idate(3) - restdtoce = idate(4) - ldtbgc = idate(5) - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Date of bgc restart file : ' - WRITE(io_stdo_bgc,*) ' year = ',restyear - WRITE(io_stdo_bgc,*) ' month = ',restmonth - WRITE(io_stdo_bgc,*) ' day = ',restday - WRITE(io_stdo_bgc,*) ' dtoce = ',restdtoce - WRITE(io_stdo_bgc,*) ' dtbgc = ',ldtbgc - WRITE(io_stdo_bgc,*) ' ' - ELSE IF(IOTYPE==1) THEN + character(len=3) :: stripestr + 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 + ! + testio=0 + IF(mnproc==1 .AND. IOTYPE==0) THEN + + ncstat = NF90_OPEN(rstfnm,NF90_NOWRITE, ncid) + IF ( ncstat .NE. NF90_NOERR ) THEN + CALL xchalt('(AUFR: Problem with netCDF1)') + stop '(AUFR: Problem with netCDF1)' + ENDIF + ! + ! 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)' + ENDIF + restyear = idate(1) + restmonth = idate(2) + restday = idate(3) + restdtoce = idate(4) + ldtbgc = idate(5) + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) 'Date of bgc restart file : ' + WRITE(io_stdo_bgc,*) ' year = ',restyear + WRITE(io_stdo_bgc,*) ' month = ',restmonth + WRITE(io_stdo_bgc,*) ' day = ',restday + WRITE(io_stdo_bgc,*) ' dtoce = ',restdtoce + WRITE(io_stdo_bgc,*) ' dtbgc = ',ldtbgc + WRITE(io_stdo_bgc,*) ' ' + ELSE IF(IOTYPE==1) THEN #ifdef PNETCDF - testio=1 - write(stripestr,('(i3)')) 16 - write(stripestr2,('(i9)')) 1024*1024 - call mpi_info_create(info,ierr) - call mpi_info_set(info,'romio_ds_read','disable',ierr) - call mpi_info_set(info,'romio_ds_write','disable',ierr) - call mpi_info_set(info,"striping_factor",stripestr,ierr) - call mpi_info_set(info,"striping_unit",stripestr2,ierr) + testio=1 + write(stripestr,('(i3)')) 16 + write(stripestr2,('(i9)')) 1024*1024 + call mpi_info_create(info,ierr) + call mpi_info_set(info,'romio_ds_read','disable',ierr) + call mpi_info_set(info,'romio_ds_write','disable',ierr) + call mpi_info_set(info,"striping_factor",stripestr,ierr) + call mpi_info_set(info,"striping_unit",stripestr2,ierr) - ncstat = NFMPI_OPEN(mpicomm,rstfnm,NF_NOWRITE,INFO, ncid) - IF ( ncstat .NE. NF_NOERR ) THEN - CALL xchalt('(AUFR: Problem with netCDF1)') - stop '(AUFR: Problem with netCDF1)' - ENDIF + ncstat = NFMPI_OPEN(mpicomm,rstfnm,NF_NOWRITE,INFO, ncid) + IF ( ncstat .NE. NF_NOERR ) THEN + CALL xchalt('(AUFR: Problem with netCDF1)') + stop '(AUFR: Problem with netCDF1)' + ENDIF - ! - ! 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)' - ENDIF - restyear = idate(1) - restmonth = idate(2) - restday = idate(3) - restdtoce = idate(4) - ldtbgc = idate(5) - IF(mnproc==1) THEN - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Date of bgc restart file : ' - WRITE(io_stdo_bgc,*) ' year = ',restyear - WRITE(io_stdo_bgc,*) ' month = ',restmonth - WRITE(io_stdo_bgc,*) ' day = ',restday - WRITE(io_stdo_bgc,*) ' dtoce = ',restdtoce - WRITE(io_stdo_bgc,*) ' dtbgc = ',ldtbgc - WRITE(io_stdo_bgc,*) ' ' - ENDIF + ! + ! 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)' + ENDIF + restyear = idate(1) + restmonth = idate(2) + restday = idate(3) + restdtoce = idate(4) + ldtbgc = idate(5) + IF(mnproc==1) THEN + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) 'Date of bgc restart file : ' + WRITE(io_stdo_bgc,*) ' year = ',restyear + WRITE(io_stdo_bgc,*) ' month = ',restmonth + WRITE(io_stdo_bgc,*) ' day = ',restday + WRITE(io_stdo_bgc,*) ' dtoce = ',restdtoce + WRITE(io_stdo_bgc,*) ' dtbgc = ',ldtbgc + WRITE(io_stdo_bgc,*) ' ' + ENDIF #endif - if(testio .eq. 0) then - CALL xchalt('(AUFR: Problem with namelist iotype)') - stop '(AUFR: Problem with namelist iotype)' - endif + if(testio .eq. 0) then + CALL xchalt('(AUFR: Problem with namelist iotype)') + stop '(AUFR: Problem with namelist iotype)' + endif - ENDIF ! mnproc==1 .AND. IOTYPE==0 + ENDIF ! mnproc==1 .AND. IOTYPE==0 - ! - ! Compare with date read from ocean restart file - ! - IF (mnproc.eq.1) THEN + ! + ! Compare with date read from ocean restart file + ! + IF (mnproc.eq.1) THEN - IF ( kplyear .NE. restyear ) WRITE(io_stdo_bgc,*) & - 'WARNING: restart years in oce/bgc are not the same : ', kplyear,'/',restyear,' !!!' + IF ( kplyear .NE. restyear ) WRITE(io_stdo_bgc,*) & + 'WARNING: restart years in oce/bgc are not the same : ', kplyear,'/',restyear,' !!!' - IF ( kplmon .NE. restmonth ) WRITE(io_stdo_bgc,*) & - 'WARNING: restart months in oce/bgc are not the same : ',kplmon,'/',restmonth,' !!!' + IF ( kplmon .NE. restmonth ) WRITE(io_stdo_bgc,*) & + 'WARNING: restart months in oce/bgc are not the same : ',kplmon,'/',restmonth,' !!!' - IF ( kplday .NE. restday ) WRITE(io_stdo_bgc,*) & - 'WARNING: restart days in oce/bgc are not the same : ', kplday,'/',restday,' !!!' + IF ( kplday .NE. restday ) WRITE(io_stdo_bgc,*) & + 'WARNING: restart days in oce/bgc are not the same : ', kplday,'/',restday,' !!!' - ENDIF + ENDIF - ! 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 + ! 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,'cfc11',ncvarid) - if(ncstat.ne.nf_noerr) lread_cfc=.false. + 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 + 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 - 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 + ! 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,'natsco212',ncvarid) - if(ncstat.ne.nf_noerr) lread_nat=.false. + 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 - 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 + endif - ! 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 + ! 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,'sco213',ncvarid) - if(ncstat.ne.nf_noerr) lread_iso=.false. + ncstat=nfmpi_inq_varid(ncid,'sco213',ncvarid) + if(ncstat.ne.nf_noerr) lread_iso=.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 + 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 - 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 + ! 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,'bromo',ncvarid) - if(ncstat.ne.nf_noerr) lread_bro=.false. + ncstat=nfmpi_inq_varid(ncid,'bromo',ncvarid) + if(ncstat.ne.nf_noerr) lread_bro=.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 + 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 (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 + ! 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. + ncstat=nfmpi_inq_varid(ncid,'atmco2',ncvarid) + if(ncstat.ne.nf_noerr) lread_atm=.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 - ! - ! 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) - CALL read_netcdf_var(ncid,'oxygen',locetra(1,1,1,ioxygen),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'gasnit',locetra(1,1,1,igasnit),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'ano3',locetra(1,1,1,iano3),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'silica',locetra(1,1,1,isilica),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'doc',locetra(1,1,1,idoc),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'phyto',locetra(1,1,1,iphy),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'grazer',locetra(1,1,1,izoo),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'poc',locetra(1,1,1,idet),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'calciu',locetra(1,1,1,icalc),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'opal',locetra(1,1,1,iopal),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'n2o',locetra(1,1,1,ian2o),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'dms',locetra(1,1,1,idms),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'fdust',locetra(1,1,1,ifdust),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'iron',locetra(1,1,1,iiron),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'prefo2',locetra(1,1,1,iprefo2),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'prefpo4',locetra(1,1,1,iprefpo4),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'prefalk',locetra(1,1,1,iprefalk),2*kpke,0,iotype) - 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) + 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 + ! + ! 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) + CALL read_netcdf_var(ncid,'oxygen',locetra(1,1,1,ioxygen),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'gasnit',locetra(1,1,1,igasnit),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'ano3',locetra(1,1,1,iano3),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'silica',locetra(1,1,1,isilica),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'doc',locetra(1,1,1,idoc),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'phyto',locetra(1,1,1,iphy),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'grazer',locetra(1,1,1,izoo),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'poc',locetra(1,1,1,idet),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'calciu',locetra(1,1,1,icalc),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'opal',locetra(1,1,1,iopal),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'n2o',locetra(1,1,1,ian2o),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'dms',locetra(1,1,1,idms),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'fdust',locetra(1,1,1,ifdust),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'iron',locetra(1,1,1,iiron),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'prefo2',locetra(1,1,1,iprefo2),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'prefpo4',locetra(1,1,1,iprefpo4),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'prefalk',locetra(1,1,1,iprefalk),2*kpke,0,iotype) + 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) - if (use_cisonew .and. 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 - 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) - endif - if (use_CFC .and. 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) + if (use_cisonew .and. 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 + 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) + endif + if (use_CFC .and. 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 + 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 + endif + if (use_BROMO .and. lread_bro) then + CALL read_netcdf_var(ncid,'bromo',locetra(1,1,1,ibromo),2*kpke,0,iotype) + endif + ! + ! 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. + ! + 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 .and. 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 + ! + ! 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 - 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 - if (use_BROMO .and. lread_bro) then - CALL read_netcdf_var(ncid,'bromo',locetra(1,1,1,ibromo),2*kpke,0,iotype) - endif - ! - ! 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. - ! - 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 .and. 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 - ! - ! 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 + 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 - IF(mnproc==1 .AND. IOTYPE==0) THEN - ncstat = NF90_CLOSE(ncid) - ELSE IF(IOTYPE==1) THEN + IF(mnproc==1 .AND. IOTYPE==0) THEN + ncstat = NF90_CLOSE(ncid) + ELSE IF(IOTYPE==1) THEN #ifdef PNETCDF - ncstat = NFMPI_CLOSE(ncid) + ncstat = NFMPI_CLOSE(ncid) #endif - ENDIF + ENDIF - if (use_cisonew .and. .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) + if (use_cisonew .and. .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 + ! 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 + ! 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 - DO k=1,2*ks - DO j=1,kpje - DO i=1,kpie - IF(omask(i,j) .GT. 0.5) THEN - rco213=locetra(i,j,kbo(i,j),isco213)/(locetra(i,j,kbo(i,j),isco212)+safediv) - rco214=locetra(i,j,kbo(i,j),isco214)/(locetra(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 + if (.not. use_sedbypass) then + DO k=1,2*ks + DO j=1,kpje + DO i=1,kpie + IF(omask(i,j) .GT. 0.5) THEN + rco213=locetra(i,j,kbo(i,j),isco213)/(locetra(i,j,kbo(i,j),isco212)+safediv) + rco214=locetra(i,j,kbo(i,j),isco214)/(locetra(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=locetra(i,j,kbo(i,j),isco213)/(locetra(i,j,kbo(i,j),isco212)+safediv) - rco214=locetra(i,j,kbo(i,j),isco214)/(locetra(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 + DO k=1,2 + DO j=1,kpje + DO i=1,kpie + IF(omask(i,j) .GT. 0.5) THEN + rco213=locetra(i,j,kbo(i,j),isco213)/(locetra(i,j,kbo(i,j),isco212)+safediv) + rco214=locetra(i,j,kbo(i,j),isco214)/(locetra(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 ! .NOT. use_sedbypass - endif ! use_cisonew .and. .NOT. lread_iso + endif ! .NOT. use_sedbypass + endif ! use_cisonew .and. .NOT. lread_iso - ! 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 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 SUBROUTINE AUFR_BGC + RETURN +END SUBROUTINE AUFR_BGC diff --git a/hamocc/aufw_bgc.F90 b/hamocc/aufw_bgc.F90 index 9c6347f3..20b8c340 100644 --- a/hamocc/aufw_bgc.F90 +++ b/hamocc/aufw_bgc.F90 @@ -18,934 +18,934 @@ ! along with BLOM. If not, see https://www.gnu.org/licenses/. - SUBROUTINE AUFW_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & - kplyear,kplmon,kplday,kpldtoce,omask,rstfnm) -!****************************************************************************** -! -!**** *AUFW_BGC* - write marine bgc restart data. -! -! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 -! -! Modified -! -------- -! S.Legutke, *MPI-MaD, HH* 10.04.01 -! - extra SBR for writing bgc data to the restart file. -! S.Legutke, *MPI-MaD, HH* 15.08.01 -! - netCDF version (cond.comp. PNETCDF) -! - chemcm is multiplied with layer-dependent constant in order -! to be displayable by ncview. It is not read in AUFR_BGC! -! -! J.Schwinger, *GFI, Bergen* 2013-10-21 -! - tracer field is passed from ocean model for writing now -! - removed writing of chemcm and ak* fields -! - code cleanup, removed preprocessor option "PNETCDF" -! -! J.Schwinger, *GFI, Bergen* 2014-05-21 -! - adapted code for writing of two time level tracer and -! sediment fields -! -! A.Moree, *GFI, Bergen* 2018-04-12 -! - new version of carbon isotope code -! -! J.Tjiputra, *Uni Research, Bergen* 2018-04-12 -! - added preformed and saturated DIC tracers -! -! J.Schwinger, *Uni Research, Bergen* 2018-04-12 -! - removed satn2o which is not needed to restart the model -! - added sediment bypass preprocessor option -! -! J.Schwinger, *Uni Research, Bergen* 2018-08-23 -! - added writing of atmosphere field for BOXATM -! -! M. Bentsen, *NORCE, Bergen* 2020-05-03 -! - changed ocean model from MICOM to BLOM -! -! Purpose -! ------- -! Write restart data for continuation of interrupted integration. -! -! Method -! ------- -! 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)). -! It can differ from that of the ocean (idate(4)) by the difference -! of the offsets of restart files. -! -! -!** Interface to ocean model (parameter list): -! ----------------------------------------- -! -! *INTEGER* *kpie* - 1st dimension of model grid. -! *INTEGER* *kpje* - 2nd dimension of model grid. -! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. -! *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 -! ocean model [mol/kg] -! *REAL* *sedlay2* - initial/restart sediment (two time levels) field -! *REAL* *powtra2* - initial/restart pore water tracer (two time levels) field -! *REAL* *burial2* - initial/restart sediment burial (two time levels) field -! *INTEGER* *kplyear* - year in ocean restart date -! *INTEGER* *kplmon* - month in ocean restart date -! *INTEGER* *kplday* - day in ocean restart date -! *INTEGER* *kpldtoce* - step in ocean restart date -! *REAL* *omask* - land/ocean mask -! *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 mod_xc, only: nbdy,itdm,jtdm,mnproc,iqr,jqr,xchalt - use mod_dia, only: iotype - use mo_carbch, only: co2star,co3,hi,satoxy,nathi - use mo_control_bgc, only: io_stdo_bgc,ldtbgc,rmasks,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 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 - REAL, intent(in) :: trc(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy,2*kpke,ntr) - REAL, intent(in) :: omask(kpie,kpje) - INTEGER, intent(in) :: kplyear,kplmon,kplday,kpldtoce - character(len=*), intent(in) :: rstfnm - - ! Local variables - INTEGER :: i,j - REAL :: locetra(kpie,kpje,2*kpke,nocetra) - INTEGER :: errstat - - ! Variables for netcdf - INTEGER :: ncid,ncvarid,ncstat,ncoldmod,ncdimst(4) - INTEGER :: nclatid,nclonid,nclevid,nclev2id,ncksid,ncks2id,nctlvl2id - INTEGER :: idate(5),ierr,testio - REAL :: rmissing - character(len=3) :: stripestr - character(len=9) :: stripestr2 +SUBROUTINE AUFW_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & + kplyear,kplmon,kplday,kpldtoce,omask,rstfnm) + !****************************************************************************** + ! + !**** *AUFW_BGC* - write marine bgc restart data. + ! + ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 + ! + ! Modified + ! -------- + ! S.Legutke, *MPI-MaD, HH* 10.04.01 + ! - extra SBR for writing bgc data to the restart file. + ! S.Legutke, *MPI-MaD, HH* 15.08.01 + ! - netCDF version (cond.comp. PNETCDF) + ! - chemcm is multiplied with layer-dependent constant in order + ! to be displayable by ncview. It is not read in AUFR_BGC! + ! + ! J.Schwinger, *GFI, Bergen* 2013-10-21 + ! - tracer field is passed from ocean model for writing now + ! - removed writing of chemcm and ak* fields + ! - code cleanup, removed preprocessor option "PNETCDF" + ! + ! J.Schwinger, *GFI, Bergen* 2014-05-21 + ! - adapted code for writing of two time level tracer and + ! sediment fields + ! + ! A.Moree, *GFI, Bergen* 2018-04-12 + ! - new version of carbon isotope code + ! + ! J.Tjiputra, *Uni Research, Bergen* 2018-04-12 + ! - added preformed and saturated DIC tracers + ! + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - removed satn2o which is not needed to restart the model + ! - added sediment bypass preprocessor option + ! + ! J.Schwinger, *Uni Research, Bergen* 2018-08-23 + ! - added writing of atmosphere field for BOXATM + ! + ! M. Bentsen, *NORCE, Bergen* 2020-05-03 + ! - changed ocean model from MICOM to BLOM + ! + ! Purpose + ! ------- + ! Write restart data for continuation of interrupted integration. + ! + ! Method + ! ------- + ! 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)). + ! It can differ from that of the ocean (idate(4)) by the difference + ! of the offsets of restart files. + ! + ! + !** Interface to ocean model (parameter list): + ! ----------------------------------------- + ! + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. + ! *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 + ! ocean model [mol/kg] + ! *REAL* *sedlay2* - initial/restart sediment (two time levels) field + ! *REAL* *powtra2* - initial/restart pore water tracer (two time levels) field + ! *REAL* *burial2* - initial/restart sediment burial (two time levels) field + ! *INTEGER* *kplyear* - year in ocean restart date + ! *INTEGER* *kplmon* - month in ocean restart date + ! *INTEGER* *kplday* - day in ocean restart date + ! *INTEGER* *kpldtoce* - step in ocean restart date + ! *REAL* *omask* - land/ocean mask + ! *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 mod_xc, only: nbdy,itdm,jtdm,mnproc,iqr,jqr,xchalt + use mod_dia, only: iotype + use mo_carbch, only: co2star,co3,hi,satoxy,nathi + use mo_control_bgc, only: io_stdo_bgc,ldtbgc,rmasks,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 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 + REAL, intent(in) :: trc(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy,2*kpke,ntr) + REAL, intent(in) :: omask(kpie,kpje) + INTEGER, intent(in) :: kplyear,kplmon,kplday,kpldtoce + character(len=*), intent(in) :: rstfnm + + ! Local variables + INTEGER :: i,j + REAL :: locetra(kpie,kpje,2*kpke,nocetra) + INTEGER :: errstat + + ! Variables for netcdf + INTEGER :: ncid,ncvarid,ncstat,ncoldmod,ncdimst(4) + INTEGER :: nclatid,nclonid,nclevid,nclev2id,ncksid,ncks2id,nctlvl2id + INTEGER :: idate(5),ierr,testio + REAL :: rmissing + character(len=3) :: stripestr + character(len=9) :: stripestr2 #ifdef PNETCDF # include # include - integer(kind=MPI_OFFSET_KIND) :: clen - integer*4 ,save :: info=MPI_INFO_NULL - integer :: mpicomm,mpierr,mpireq,mpistat - common/xcmpii/ mpicomm,mpierr,mpireq(4), & - & mpistat(mpi_status_size,4*max(iqr,jqr)) - save /xcmpii/ + integer(kind=MPI_OFFSET_KIND) :: clen + integer*4 ,save :: info=MPI_INFO_NULL + integer :: mpicomm,mpierr,mpireq,mpistat + common/xcmpii/ mpicomm,mpierr,mpireq(4), & + & mpistat(mpi_status_size,4*max(iqr,jqr)) + 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 - !-------------------------------------------------------------------- - ! - testio=0 - ! - ! Initialize local array for writing (locetra) - ! - locetra(:,:,:,:) = trc(1:kpie,1:kpje,:,itrbgc:itrbgc+ntrbgc-1) - - idate(1) = kplyear - idate(2) = kplmon - idate(3) = kplday - 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) - ENDIF - - rmissing = rmasko - ! - ! 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) - IF ( ncstat .NE. NF90_NOERR ) THEN - call xchalt('(AUFW: Problem with netCDF1)') - stop '(AUFW: Problem with netCDF1)' - ENDIF - ELSE IF (IOTYPE==1) THEN + ! 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 + ! + ! Initialize local array for writing (locetra) + ! + locetra(:,:,:,:) = trc(1:kpie,1:kpje,:,itrbgc:itrbgc+ntrbgc-1) + + idate(1) = kplyear + idate(2) = kplmon + idate(3) = kplday + 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) + ENDIF + + rmissing = rmasko + ! + ! 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) + IF ( ncstat .NE. NF90_NOERR ) THEN + call xchalt('(AUFW: Problem with netCDF1)') + stop '(AUFW: Problem with netCDF1)' + ENDIF + ELSE IF (IOTYPE==1) THEN #ifdef PNETCDF - testio=1 - IF(mnproc==1) write(io_stdo_bgc,*) 'BGC RESTART ',rstfnm - write(stripestr,('(i3)')) 16 - write(stripestr2,('(i9)')) 1024*1024 - call mpi_info_create(info,ierr) - call mpi_info_set(info,'romio_ds_read','disable',ierr) - call mpi_info_set(info,'romio_ds_write','disable',ierr) - call mpi_info_set(info,"striping_factor",stripestr,ierr) - call mpi_info_set(info,"striping_unit",stripestr2,ierr) - ncstat = NFMPI_CREATE(mpicomm,rstfnm, & - & IOR(nf_clobber,nf_64bit_offset),info,ncid) - IF ( ncstat .NE. NF_NOERR ) THEN - call xchalt('(AUFW: Problem with PnetCDF1)') - stop '(AUFW: Problem with PnetCDF1)' - ENDIF + testio=1 + IF(mnproc==1) write(io_stdo_bgc,*) 'BGC RESTART ',rstfnm + write(stripestr,('(i3)')) 16 + write(stripestr2,('(i9)')) 1024*1024 + call mpi_info_create(info,ierr) + call mpi_info_set(info,'romio_ds_read','disable',ierr) + call mpi_info_set(info,'romio_ds_write','disable',ierr) + call mpi_info_set(info,"striping_factor",stripestr,ierr) + call mpi_info_set(info,"striping_unit",stripestr2,ierr) + ncstat = NFMPI_CREATE(mpicomm,rstfnm, & + & IOR(nf_clobber,nf_64bit_offset),info,ncid) + IF ( ncstat .NE. NF_NOERR ) THEN + call xchalt('(AUFW: Problem with PnetCDF1)') + stop '(AUFW: Problem with PnetCDF1)' + ENDIF #endif - if(testio .eq. 0) then - CALL xchalt('(AUFW: Problem with namelist iotype)') - stop '(AUFW: Problem with namelist iotype)' - endif - - ENDIF - ! - ! 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)' - ENDIF - - ncstat = NF90_DEF_DIM(ncid, 'lat', jtdm, nclatid) - IF ( ncstat .NE. NF90_NOERR ) THEN - call xchalt('(AUFW: Problem with netCDF3)') - stop '(AUFW: Problem with netCDF3)' - ENDIF - - ncstat = NF90_DEF_DIM(ncid, 'depth', kpke, nclevid) - IF ( ncstat .NE. NF90_NOERR ) THEN - call xchalt('(AUFW: Problem with netCDF4)') - stop '(AUFW: Problem with netCDF4)' - ENDIF - - ncstat = NF90_DEF_DIM(ncid, 'depth2', 2*kpke, nclev2id) - IF ( ncstat .NE. NF90_NOERR ) THEN - call xchalt('(AUFW: Problem with netCDF5)') - stop '(AUFW: Problem with netCDF5)' - ENDIF - - ncstat = NF90_DEF_DIM(ncid, 'nks', ks, ncksid) - IF ( ncstat .NE. NF90_NOERR ) THEN - call xchalt('(AUFW: Problem with netCDF6)') - stop '(AUFW: Problem with netCDF6)' - ENDIF - - ncstat = NF90_DEF_DIM(ncid, 'nks2', 2*ks, ncks2id) - IF ( ncstat .NE. NF90_NOERR ) THEN - call xchalt('(AUFW: Problem with netCDF7)') - stop '(AUFW: Problem with netCDF7)' - ENDIF - - ncstat = NF90_DEF_DIM(ncid, 'tlvl2', 2, nctlvl2id) - IF ( ncstat .NE. NF90_NOERR ) THEN - call xchalt('(AUFW: Problem with netCDF8)') - stop '(AUFW: Problem with netCDF8)' - ENDIF - - ELSE IF (IOTYPE==1) THEN + if(testio .eq. 0) then + CALL xchalt('(AUFW: Problem with namelist iotype)') + stop '(AUFW: Problem with namelist iotype)' + endif + + ENDIF + ! + ! 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)' + ENDIF + + ncstat = NF90_DEF_DIM(ncid, 'lat', jtdm, nclatid) + IF ( ncstat .NE. NF90_NOERR ) THEN + call xchalt('(AUFW: Problem with netCDF3)') + stop '(AUFW: Problem with netCDF3)' + ENDIF + + ncstat = NF90_DEF_DIM(ncid, 'depth', kpke, nclevid) + IF ( ncstat .NE. NF90_NOERR ) THEN + call xchalt('(AUFW: Problem with netCDF4)') + stop '(AUFW: Problem with netCDF4)' + ENDIF + + ncstat = NF90_DEF_DIM(ncid, 'depth2', 2*kpke, nclev2id) + IF ( ncstat .NE. NF90_NOERR ) THEN + call xchalt('(AUFW: Problem with netCDF5)') + stop '(AUFW: Problem with netCDF5)' + ENDIF + + ncstat = NF90_DEF_DIM(ncid, 'nks', ks, ncksid) + IF ( ncstat .NE. NF90_NOERR ) THEN + call xchalt('(AUFW: Problem with netCDF6)') + stop '(AUFW: Problem with netCDF6)' + ENDIF + + ncstat = NF90_DEF_DIM(ncid, 'nks2', 2*ks, ncks2id) + IF ( ncstat .NE. NF90_NOERR ) THEN + call xchalt('(AUFW: Problem with netCDF7)') + stop '(AUFW: Problem with netCDF7)' + ENDIF + + ncstat = NF90_DEF_DIM(ncid, 'tlvl2', 2, nctlvl2id) + IF ( ncstat .NE. NF90_NOERR ) THEN + call xchalt('(AUFW: Problem with netCDF8)') + stop '(AUFW: Problem with netCDF8)' + ENDIF + + ELSE IF (IOTYPE==1) THEN #ifdef PNETCDF - clen=itdm - ncstat = NFMPI_DEF_DIM(ncid, 'lon', clen, nclonid) - IF ( ncstat .NE. NF_NOERR ) THEN - call xchalt('(AUFW: Problem with PnetCDF2)') - stop '(AUFW: Problem with PnetCDF2)' - ENDIF - - clen=jtdm - ncstat = NFMPI_DEF_DIM(ncid, 'lat', clen, nclatid) - IF ( ncstat .NE. NF_NOERR ) THEN - call xchalt('(AUFW: Problem with PnetCDF3)') - stop '(AUFW: Problem with PnetCDF3)' - ENDIF - - clen=kpke - ncstat = NFMPI_DEF_DIM(ncid, 'depth', clen, nclevid) - IF ( ncstat .NE. NF_NOERR ) THEN - call xchalt('(AUFW: Problem with PnetCDF4)') - stop '(AUFW: Problem with PnetCDF4)' - ENDIF - - clen=2*kpke - ncstat = NFMPI_DEF_DIM(ncid, 'depth2', clen, nclev2id) - IF ( ncstat .NE. NF_NOERR ) THEN - call xchalt('(AUFW: Problem with PnetCDF5)') - stop '(AUFW: Problem with PnetCDF5)' - ENDIF - - clen=ks - ncstat = NFMPI_DEF_DIM(ncid, 'nks', clen, ncksid) - IF ( ncstat .NE. NF_NOERR ) THEN - call xchalt('(AUFW: Problem with PnetCDF6)') - stop '(AUFW: Problem with PnetCDF6)' - ENDIF - - clen=2*ks - ncstat = NFMPI_DEF_DIM(ncid, 'nks2', clen, ncks2id) - IF ( ncstat .NE. NF_NOERR ) THEN - call xchalt('(AUFW: Problem with PnetCDF7)') - stop '(AUFW: Problem with PnetCDF7)' - ENDIF - - clen=2 - ncstat = NFMPI_DEF_DIM(ncid, 'tlvl2', clen, nctlvl2id) - IF ( ncstat .NE. NF_NOERR ) THEN - call xchalt('(AUFW: Problem with PnetCDF8)') - stop '(AUFW: Problem with PnetCDF8)' - ENDIF + clen=itdm + ncstat = NFMPI_DEF_DIM(ncid, 'lon', clen, nclonid) + IF ( ncstat .NE. NF_NOERR ) THEN + call xchalt('(AUFW: Problem with PnetCDF2)') + stop '(AUFW: Problem with PnetCDF2)' + ENDIF + + clen=jtdm + ncstat = NFMPI_DEF_DIM(ncid, 'lat', clen, nclatid) + IF ( ncstat .NE. NF_NOERR ) THEN + call xchalt('(AUFW: Problem with PnetCDF3)') + stop '(AUFW: Problem with PnetCDF3)' + ENDIF + + clen=kpke + ncstat = NFMPI_DEF_DIM(ncid, 'depth', clen, nclevid) + IF ( ncstat .NE. NF_NOERR ) THEN + call xchalt('(AUFW: Problem with PnetCDF4)') + stop '(AUFW: Problem with PnetCDF4)' + ENDIF + + clen=2*kpke + ncstat = NFMPI_DEF_DIM(ncid, 'depth2', clen, nclev2id) + IF ( ncstat .NE. NF_NOERR ) THEN + call xchalt('(AUFW: Problem with PnetCDF5)') + stop '(AUFW: Problem with PnetCDF5)' + ENDIF + + clen=ks + ncstat = NFMPI_DEF_DIM(ncid, 'nks', clen, ncksid) + IF ( ncstat .NE. NF_NOERR ) THEN + call xchalt('(AUFW: Problem with PnetCDF6)') + stop '(AUFW: Problem with PnetCDF6)' + ENDIF + + clen=2*ks + ncstat = NFMPI_DEF_DIM(ncid, 'nks2', clen, ncks2id) + IF ( ncstat .NE. NF_NOERR ) THEN + call xchalt('(AUFW: Problem with PnetCDF7)') + stop '(AUFW: Problem with PnetCDF7)' + ENDIF + + clen=2 + ncstat = NFMPI_DEF_DIM(ncid, 'tlvl2', clen, nctlvl2id) + IF ( ncstat .NE. NF_NOERR ) THEN + call xchalt('(AUFW: Problem with PnetCDF8)') + stop '(AUFW: Problem with PnetCDF8)' + ENDIF #endif - ENDIF !mnproc==1 .AND. IOTYPE==0 - - ! - ! Define global attributes - ! ---------------------------------------------------------------------- - ! - IF (mnproc==1 .AND. IOTYPE==0) THEN - - ncstat = NF90_PUT_ATT(ncid, NF90_GLOBAL,'title' & - &, 'Restart data for marine bgc modules') - IF ( ncstat .NE. NF90_NOERR ) THEN - call xchalt('(AUFW: Problem with netCDF9)') - stop '(AUFW: Problem with netCDF9)' - ENDIF - - ncstat = NF90_PUT_ATT(ncid, NF90_GLOBAL,'history' & - &, 'Restart data for marine bgc modules') - IF ( ncstat .NE. NF90_NOERR ) THEN - call xchalt('(AUFW: Problem with netCDF10)') - stop '(AUFW: Problem with netCDF10)' - ENDIF - - ncstat = NF90_PUT_ATT(ncid, NF90_GLOBAL,'conventions' & - &,'COARDS') - IF ( ncstat .NE. NF90_NOERR ) THEN - call xchalt('(AUFW: Problem with netCDF11)') - stop '(AUFW: Problem with netCDF11)' - ENDIF - - ncstat = NF90_PUT_ATT(ncid, NF90_GLOBAL,'source' & - &, 'Marine bgc model output HOPC68/grob') - IF ( ncstat .NE. NF90_NOERR ) THEN - call xchalt('(AUFW: Problem with netCDF12)') - stop '(AUFW: Problem with netCDF12)' - ENDIF - - ncstat = NF90_PUT_ATT(ncid, NF90_GLOBAL, 'date', idate) - IF ( ncstat .NE. NF90_NOERR ) THEN - call xchalt('(AUFW: Problem with netCDF13)') - stop '(AUFW: Problem with netCDF13)' - ENDIF - - ELSE IF (IOTYPE==1) THEN + ENDIF !mnproc==1 .AND. IOTYPE==0 + + ! + ! Define global attributes + ! ---------------------------------------------------------------------- + ! + IF (mnproc==1 .AND. IOTYPE==0) THEN + + ncstat = NF90_PUT_ATT(ncid, NF90_GLOBAL,'title' & + &, 'Restart data for marine bgc modules') + IF ( ncstat .NE. NF90_NOERR ) THEN + call xchalt('(AUFW: Problem with netCDF9)') + stop '(AUFW: Problem with netCDF9)' + ENDIF + + ncstat = NF90_PUT_ATT(ncid, NF90_GLOBAL,'history' & + &, 'Restart data for marine bgc modules') + IF ( ncstat .NE. NF90_NOERR ) THEN + call xchalt('(AUFW: Problem with netCDF10)') + stop '(AUFW: Problem with netCDF10)' + ENDIF + + ncstat = NF90_PUT_ATT(ncid, NF90_GLOBAL,'conventions' & + &,'COARDS') + IF ( ncstat .NE. NF90_NOERR ) THEN + call xchalt('(AUFW: Problem with netCDF11)') + stop '(AUFW: Problem with netCDF11)' + ENDIF + + ncstat = NF90_PUT_ATT(ncid, NF90_GLOBAL,'source' & + &, 'Marine bgc model output HOPC68/grob') + IF ( ncstat .NE. NF90_NOERR ) THEN + call xchalt('(AUFW: Problem with netCDF12)') + stop '(AUFW: Problem with netCDF12)' + ENDIF + + ncstat = NF90_PUT_ATT(ncid, NF90_GLOBAL, 'date', idate) + IF ( ncstat .NE. NF90_NOERR ) THEN + call xchalt('(AUFW: Problem with netCDF13)') + stop '(AUFW: Problem with netCDF13)' + ENDIF + + ELSE IF (IOTYPE==1) THEN #ifdef PNETCDF - clen=len('Restart data for marine bgc modules') - ncstat = NFMPI_PUT_ATT_TEXT(ncid, NF_GLOBAL,'title' & - &, clen,'Restart data for marine bgc modules') - IF ( ncstat .NE. NF_NOERR ) THEN - call xchalt('(AUFW: Problem with PnetCDF9)') - stop '(AUFW: Problem with PnetCDF9)' - ENDIF - - clen=len('Restart data for marine bgc modules') - ncstat = NFMPI_PUT_ATT_TEXT(ncid, NF_GLOBAL,'history' & - &, clen,'Restart data for marine bgc modules') - IF ( ncstat .NE. NF_NOERR ) THEN - call xchalt('(AUFW: Problem with PnetCDF10)') - stop '(AUFW: Problem with PnetCDF10)' - ENDIF - - clen=6 - ncstat = NFMPI_PUT_ATT_TEXT(ncid, NF_GLOBAL,'conventions' & - &,clen, 'COARDS') - IF ( ncstat .NE. NF_NOERR ) THEN - call xchalt('(AUFW: Problem with PnetCDF11)') - stop '(AUFW: Problem with PnetCDF11)' - ENDIF - - clen=len('Marine bgc model output HOPC68/grob') - ncstat = NFMPI_PUT_ATT_TEXT(ncid, NF_GLOBAL,'source' & - &,clen, 'Marine bgc model output HOPC68/grob') - IF ( ncstat .NE. NF_NOERR ) THEN - call xchalt('(AUFW: Problem with PnetCDF12)') - stop '(AUFW: Problem with PnetCDF12)' - ENDIF - - clen=5 - ncstat = NFMPI_PUT_ATT_INT(ncid, NF_GLOBAL, 'date', & - & nf_int, clen, idate) - IF ( ncstat .NE. NF_NOERR ) THEN - call xchalt('(AUFW: Problem with netCDF13)') - stop '(AUFW: Problem with netCDF13)' - - ENDIF + clen=len('Restart data for marine bgc modules') + ncstat = NFMPI_PUT_ATT_TEXT(ncid, NF_GLOBAL,'title' & + &, clen,'Restart data for marine bgc modules') + IF ( ncstat .NE. NF_NOERR ) THEN + call xchalt('(AUFW: Problem with PnetCDF9)') + stop '(AUFW: Problem with PnetCDF9)' + ENDIF + + clen=len('Restart data for marine bgc modules') + ncstat = NFMPI_PUT_ATT_TEXT(ncid, NF_GLOBAL,'history' & + &, clen,'Restart data for marine bgc modules') + IF ( ncstat .NE. NF_NOERR ) THEN + call xchalt('(AUFW: Problem with PnetCDF10)') + stop '(AUFW: Problem with PnetCDF10)' + ENDIF + + clen=6 + ncstat = NFMPI_PUT_ATT_TEXT(ncid, NF_GLOBAL,'conventions' & + &,clen, 'COARDS') + IF ( ncstat .NE. NF_NOERR ) THEN + call xchalt('(AUFW: Problem with PnetCDF11)') + stop '(AUFW: Problem with PnetCDF11)' + ENDIF + + clen=len('Marine bgc model output HOPC68/grob') + ncstat = NFMPI_PUT_ATT_TEXT(ncid, NF_GLOBAL,'source' & + &,clen, 'Marine bgc model output HOPC68/grob') + IF ( ncstat .NE. NF_NOERR ) THEN + call xchalt('(AUFW: Problem with PnetCDF12)') + stop '(AUFW: Problem with PnetCDF12)' + ENDIF + + clen=5 + ncstat = NFMPI_PUT_ATT_INT(ncid, NF_GLOBAL, 'date', & + & nf_int, clen, idate) + IF ( ncstat .NE. NF_NOERR ) THEN + call xchalt('(AUFW: Problem with netCDF13)') + stop '(AUFW: Problem with netCDF13)' + + ENDIF #endif - ENDIF ! IOTYPE == 1 - ! - ! Define variables : advected ocean tracer - ! ---------------------------------------------------------------------- - ! - IF((mnproc==1 .AND. IOTYPE==0) .OR. IOTYPE==1) THEN + 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,'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,'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,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,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,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,'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,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,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,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,'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,6,'dicsat',3,ncdimst,ncvarid, & + & 6,'mol/kg',13,'Saturated dic', & + rmissing,31,io_stdo_bgc) + + 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) + + CALL NETCDF_DEF_VARDB(ncid,6,'sco214',3,ncdimst,ncvarid, & + & 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) + + CALL NETCDF_DEF_VARDB(ncid,5,'doc14',3,ncdimst,ncvarid, & + & 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) + + CALL NETCDF_DEF_VARDB(ncid,5,'poc14',3,ncdimst,ncvarid, & + & 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) + + 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) + + CALL NETCDF_DEF_VARDB(ncid,8,'grazer14',3,ncdimst,ncvarid, & + & 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) + + CALL NETCDF_DEF_VARDB(ncid,8,'calciu14',3,ncdimst,ncvarid, & + & 7,'molC/kg',19,'Calcium carbonate14', & + & rmissing,43,io_stdo_bgc) + endif + 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) + + CALL NETCDF_DEF_VARDB(ncid,5,'adust',3,ncdimst,ncvarid, & + & 4,'g/kg',15,'Aggregated dust', & + & rmissing,45,io_stdo_bgc) + endif + if (use_CFC) then + CALL NETCDF_DEF_VARDB(ncid,5,'cfc11',3,ncdimst,ncvarid, & + & 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) + + CALL NETCDF_DEF_VARDB(ncid,3,'sf6',3,ncdimst,ncvarid, & + & 6,'mol/kg',4,'SF-6', & + & rmissing,49,io_stdo_bgc) + endif + 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) + + CALL NETCDF_DEF_VARDB(ncid,9,'natalkali',3,ncdimst,ncvarid, & + & 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 + 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 + + 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,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) + + 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 + ! + ! Define variables : sediment + ! ---------------------------------------------------------------------- + ! + if (.not. use_sedbypass) then + + IF((mnproc==1 .AND. IOTYPE==0) .OR. IOTYPE==1) THEN ncdimst(1) = nclonid ncdimst(2) = nclatid - ncdimst(3) = nclev2id + ncdimst(3) = ncks2id ncdimst(4) = 0 - ENDIF + 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) + + CALL NETCDF_DEF_VARDB(ncid,6,'sssc12',3,ncdimst,ncvarid, & + & 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) + + CALL NETCDF_DEF_VARDB(ncid,6,'ssster',3,ncdimst,ncvarid, & + & 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) + + CALL NETCDF_DEF_VARDB(ncid,6,'powaal',3,ncdimst,ncvarid, & + & 9,'kmol/m**3',30,'Sediment pore water alkalinity', & + & rmissing,75,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,'powaph',3,ncdimst,ncvarid, & + & 9,'kmol/m**3',29,'Sediment pore water phosphate', & + & rmissing,76,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,'powaox',3,ncdimst,ncvarid, & + & 9,'kmol/m**3',26,'Sediment pore water oxygen', & + & rmissing,77,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,5,'pown2',3,ncdimst,ncvarid, & + & 9,'kmol/m**3',36,'Sediment pore water gaseous nitrogen', & + & rmissing,78,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,'powno3',3,ncdimst,ncvarid, & + & 9,'kmol/m**3',33,'Sediment pore water nitrate (NO3)', & + & rmissing,79,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,'powasi',3,ncdimst,ncvarid, & + & 9,'kmol/m**3',42,'Sediment pore water silicid acid (Si(OH)4)', & + & rmissing,80,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,4,'ano3',3,ncdimst,ncvarid, & - & 6,'mol/kg',17,'Dissolved nitrate', & - rmissing,15,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,'silica',3,ncdimst,ncvarid, & - & 6,'mol/kg',22,'Silicid acid (Si(OH)4)', & - rmissing,16,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,3,'doc',3,ncdimst,ncvarid, & - & 6,'mol/kg',24,'Dissolved organic carbon', & - & rmissing,17,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,3,'poc',3,ncdimst,ncvarid, & - & 6,'mol/kg',25,'Particulate organic carbon', & - & rmissing,18,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,5,'phyto',3,ncdimst,ncvarid, & - & 7,'molP/kg',27,'Phytoplankton concentration', & - & rmissing,19,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,'grazer',3,ncdimst,ncvarid, & - & 7,'molP/kg',25,'Zooplankton concentration', & - & rmissing,20,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) - 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,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,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,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,'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,6,'dicsat',3,ncdimst,ncvarid, & - & 6,'mol/kg',13,'Saturated dic', & - rmissing,31,io_stdo_bgc) - - 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) - - CALL NETCDF_DEF_VARDB(ncid,6,'sco214',3,ncdimst,ncvarid, & - & 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) - - CALL NETCDF_DEF_VARDB(ncid,5,'doc14',3,ncdimst,ncvarid, & - & 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) - - CALL NETCDF_DEF_VARDB(ncid,5,'poc14',3,ncdimst,ncvarid, & - & 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) - - 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) - - CALL NETCDF_DEF_VARDB(ncid,8,'grazer14',3,ncdimst,ncvarid, & - & 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) - - CALL NETCDF_DEF_VARDB(ncid,8,'calciu14',3,ncdimst,ncvarid, & - & 7,'molC/kg',19,'Calcium carbonate14', & - & rmissing,43,io_stdo_bgc) - endif - 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) - - CALL NETCDF_DEF_VARDB(ncid,5,'adust',3,ncdimst,ncvarid, & - & 4,'g/kg',15,'Aggregated dust', & - & rmissing,45,io_stdo_bgc) - endif - if (use_CFC) then - CALL NETCDF_DEF_VARDB(ncid,5,'cfc11',3,ncdimst,ncvarid, & - & 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) - - CALL NETCDF_DEF_VARDB(ncid,3,'sf6',3,ncdimst,ncvarid, & - & 6,'mol/kg',4,'SF-6', & - & rmissing,49,io_stdo_bgc) - endif - 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) - - CALL NETCDF_DEF_VARDB(ncid,9,'natalkali',3,ncdimst,ncvarid, & - & 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 - 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 + endif + + IF((mnproc==1 .AND. IOTYPE==0) .OR. IOTYPE==1) THEN + 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 + ! ---------------------------------------------------------------------- + ! + 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,7,'bur_o12',3,ncdimst,ncvarid, & + & 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) + + 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) + + 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) + + 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) + endif + + endif ! not sedbypass + ! + ! Define variables: atmosphere + ! ---------------------------------------------------------------------- + ! + if (use_BOXATM) then + + IF((mnproc==1 .AND. IOTYPE==0) .OR. IOTYPE==1) THEN ncdimst(1) = nclonid ncdimst(2) = nclatid - ncdimst(3) = nclevid + ncdimst(3) = nctlvl2id 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,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,6,'satoxy',3,ncdimst,ncvarid, & - & 6,'mol/kg',16 ,'Saturated oxygen', & - & rmissing,63,io_stdo_bgc) - - 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 - ! - ! Define variables : sediment - ! ---------------------------------------------------------------------- - ! - if (.not. use_sedbypass) then - - IF((mnproc==1 .AND. IOTYPE==0) .OR. IOTYPE==1) THEN - 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) - - CALL NETCDF_DEF_VARDB(ncid,6,'sssc12',3,ncdimst,ncvarid, & - & 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) - - CALL NETCDF_DEF_VARDB(ncid,6,'ssster',3,ncdimst,ncvarid, & - & 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) - - CALL NETCDF_DEF_VARDB(ncid,6,'powaal',3,ncdimst,ncvarid, & - & 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) - - CALL NETCDF_DEF_VARDB(ncid,6,'powaox',3,ncdimst,ncvarid, & - & 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) - - 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) - - 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) - - 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,'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,'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 - - IF((mnproc==1 .AND. IOTYPE==0) .OR. IOTYPE==1) THEN - 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 - ! ---------------------------------------------------------------------- - ! - 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,7,'bur_o12',3,ncdimst,ncvarid, & - & 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) - - 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) - - 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) - - 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) - endif - - endif ! not sedbypass - ! - ! Define variables: atmosphere - ! ---------------------------------------------------------------------- - ! - if (use_BOXATM) then - - 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) - - CALL NETCDF_DEF_VARDB(ncid,5,'atmo2',3,ncdimst,ncvarid, & - & 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) - - 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) - endif - 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) - endif - endif ! 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)' - ENDIF - ! - ! Set fill mode - ! ---------------------------------------------------------------------- - ! - ncstat = NF90_SET_FILL(ncid,NF90_NOFILL, ncoldmod) - IF ( ncstat .NE. NF90_NOERR ) THEN - call xchalt('(AUFW: Problem with netCDF97)') - stop '(AUFW: Problem with netCDF97)' - ENDIF - - ELSE IF (IOTYPE==1) THEN + ENDIF + + CALL NETCDF_DEF_VARDB(ncid,6,'atmco2',3,ncdimst,ncvarid, & + & 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) + + CALL NETCDF_DEF_VARDB(ncid,5,'atmn2',3,ncdimst,ncvarid, & + & 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) + endif + 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) + endif + endif ! 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)' + ENDIF + ! + ! Set fill mode + ! ---------------------------------------------------------------------- + ! + ncstat = NF90_SET_FILL(ncid,NF90_NOFILL, ncoldmod) + IF ( ncstat .NE. NF90_NOERR ) THEN + call xchalt('(AUFW: Problem with netCDF97)') + stop '(AUFW: Problem with netCDF97)' + ENDIF + + 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 + 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) - 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) - endif - 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 - 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 - 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 - 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) - if (use_natDIC) then - CALL write_netcdf_var(ncid,'nathi',nathi(1,1,1),kpke,0) - endif - ! - ! 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) - CALL write_netcdf_var(ncid,'ssster',sedlay2(1,1,1,issster),2*ks,0) - CALL write_netcdf_var(ncid,'bur_o12',burial2(1,1,1,issso12),2,0) - CALL write_netcdf_var(ncid,'bur_c12',burial2(1,1,1,isssc12),2,0) - CALL write_netcdf_var(ncid,'bur_sil',burial2(1,1,1,issssil),2,0) - CALL write_netcdf_var(ncid,'bur_clay',burial2(1,1,1,issster),2,0) - CALL write_netcdf_var(ncid,'sedhpl',sedhpl(1,1,1),ks,0) - CALL write_netcdf_var(ncid,'powaic',powtra2(1,1,1,ipowaic),2*ks,0) - CALL write_netcdf_var(ncid,'powaal',powtra2(1,1,1,ipowaal),2*ks,0) - CALL write_netcdf_var(ncid,'powaph',powtra2(1,1,1,ipowaph),2*ks,0) - CALL write_netcdf_var(ncid,'powaox',powtra2(1,1,1,ipowaox),2*ks,0) - 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) - 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) - endif - endif - ! - ! 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) - 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) - endif - if (use_natDIC) then - 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 + 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) + endif + 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 + 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 + 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 + 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) + if (use_natDIC) then + CALL write_netcdf_var(ncid,'nathi',nathi(1,1,1),kpke,0) + endif + ! + ! 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) + CALL write_netcdf_var(ncid,'ssster',sedlay2(1,1,1,issster),2*ks,0) + CALL write_netcdf_var(ncid,'bur_o12',burial2(1,1,1,issso12),2,0) + CALL write_netcdf_var(ncid,'bur_c12',burial2(1,1,1,isssc12),2,0) + CALL write_netcdf_var(ncid,'bur_sil',burial2(1,1,1,issssil),2,0) + CALL write_netcdf_var(ncid,'bur_clay',burial2(1,1,1,issster),2,0) + CALL write_netcdf_var(ncid,'sedhpl',sedhpl(1,1,1),ks,0) + CALL write_netcdf_var(ncid,'powaic',powtra2(1,1,1,ipowaic),2*ks,0) + CALL write_netcdf_var(ncid,'powaal',powtra2(1,1,1,ipowaal),2*ks,0) + CALL write_netcdf_var(ncid,'powaph',powtra2(1,1,1,ipowaph),2*ks,0) + CALL write_netcdf_var(ncid,'powaox',powtra2(1,1,1,ipowaox),2*ks,0) + 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) + 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) + endif + endif + ! + ! 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) + 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) + endif + if (use_natDIC) then + 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 #ifdef PNETCDF - ncstat = NFMPI_CLOSE(ncid) - IF ( ncstat .NE. NF_NOERR ) THEN - call xchalt('(AUFW: PnetCDF200)') - stop '(AUFW: PnetCDF200)' - ENDIF + ncstat = NFMPI_CLOSE(ncid) + IF ( ncstat .NE. NF_NOERR ) THEN + call xchalt('(AUFW: PnetCDF200)') + stop '(AUFW: PnetCDF200)' + ENDIF #endif - ENDIF + ENDIF - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*) 'End of AUFW_BGC' - WRITE(io_stdo_bgc,*) '***************' - ENDIF + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*) 'End of AUFW_BGC' + WRITE(io_stdo_bgc,*) '***************' + ENDIF - RETURN - END SUBROUTINE AUFW_BGC + RETURN +END SUBROUTINE AUFW_BGC diff --git a/hamocc/carchm.F90 b/hamocc/carchm.F90 index f878640d..9862a504 100644 --- a/hamocc/carchm.F90 +++ b/hamocc/carchm.F90 @@ -1,627 +1,626 @@ ! Copyright (C) 2001 Ernst Maier-Reimer, S. Legutke -! Copyright (C) 2020 K. Assmann, J. Tjiputra, J. Schwinger, A. Moree, +! Copyright (C) 2020 K. Assmann, J. Tjiputra, J. Schwinger, A. Moree, ! C. Heinze ! ! 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 CARCHM(kpie,kpje,kpke,kbnd, & - pdlxp,pdlyp,pddpo,prho,pglat,omask, & - psicomo,ppao,pfu10,ptho,psao) - -!****************************************************************************** -! -!**** *CARCHM* - . -! -! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 -! -! Modified -! -------- -! S.Legutke, *MPI-MaD, HH* 10.04.01 -! - rename: ssso12(i,j,k)=sedlay(i,j,k,issso12 ) etc.; no equivalence statements -! - rename: powasi(i,j,k )=powtra(i,j,1,ipowasi) etc.; no equivalence statements -! - interfacing with ocean model -! -! J.Tjiputra, *BCCR* 09.18.08 -! - modified all carbon chemistry formulations following the OCMIP protocols -! -! J.Schwinger, *GFI, UiB* 2013-04-22 -! - Use density prho consistent with MICOM for conversion to mol/kg -! - Calculate solubility of O2 and N2 every timestep, consistent with -! what is done for carbon chemistry. Array chemcm not used any more. -! - Added J.Tjiputras code for cfc- and sf6-fluxes -! - Cautious code clean-up -! -! J.Schwinger, *UNI-RESEARCH* 2017-08-30 -! - Moved the accumulation of global fields for output to routine -! hamocc4bgc. -! -! A.Moree, *GFI, Bergen* 2018-04-12 -! - new version of carbon isotope code -! -! J.Tjiputra, *Uni Research, Bergen* 2018-04-12 -! - added preformed and saturated DIC tracers -! -! J.Schwinger, *Uni Research, Bergen* 2018-04-12 -! - moved accumulation of all output fields to seperate subroutine, -! related code-restructuring -! - dissolution of CaCO3 moved into main loop -! - added sediment bypass preprocessor option -! -! Purpose -! ------- -! Inorganic carbon cycle. -! -! Method -! ------- -! Surface fluxes of CO2 / N2O / dms -! Dissolution of calcium -! -! -!**** Parameter list: -! --------------- -! -! *INTEGER* *kpie* - 1st dimension of model grid. -! *INTEGER* *kpje* - 2nd dimension of model grid. -! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. -! *INTEGER* *kbnd* - nb of halo grid points -! *REAL* *pdlxp* - size of scalar grid cell (1st dimension) [m]. -! *REAL* *pdlyp* - size of scalar grid cell (2nd dimension) [m]. -! *REAL* *pddpo* - size of scalar grid cell (3rd dimension) [m]. -! *REAL* *prho* - density [g/cm^3]. -! *REAL* *pglat* - latitude of grid cells [deg north]. -! *REAL* *omask* - ocean mask. -! *REAL* *psicomo* - sea ice. -! *REAL* *ppao* - sea level presure [Pascal]. -! *REAL* *pfu10* - forcing field wind speed. -! *REAL* *ptho* - potential temperature. -! *REAL* *psao* - salinity [psu]. -! -! Externals -! --------- -! none. -! -!********************************************************************** - 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,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, & - 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_param_bgc, only: c14dec,atm_co2_nat - use mo_vgrid, only: dp_min,kmle,kbo,ptiestu - 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, & - nathi,natco3,natpco2d,natomegaa,natomegac - use mo_sedmnt, only: sedlay,powtra,burial - - implicit none - - INTEGER, intent(in) :: kpie,kpje,kpke,kbnd - REAL, intent(in) :: pdlxp(kpie,kpje) - REAL, intent(in) :: pdlyp(kpie,kpje) - REAL, intent(in) :: pddpo(kpie,kpje,kpke) - REAL, intent(in) :: prho(kpie,kpje,kpke) - REAL, intent(in) :: pglat(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - REAL, intent(in) :: omask(kpie,kpje) - REAL, intent(in) :: psicomo(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - REAL, intent(in) :: ppao(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - REAL, intent(in) :: pfu10(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - REAL, intent(in) :: ptho(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) - REAL, intent(in) :: psao(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) - - ! 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 - REAL :: scco2,sco2,scn2,scdms,scn2o - REAL :: Xconvxa - REAL :: oxflux,niflux,dmsflux,n2oflux - REAL :: ato2,atn2,atco2,pco2 - REAL :: oxy,ani,anisa - REAL :: rrho,t,t2,t3,t4,tk,tk100,prb,s,rs - 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 - 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. - pco2d (:,:)=0. - pco2m (:,:)=0. - kwco2d (:,:)=0. - co2sold (:,:)=0. - co2solm (:,:)=0. - kwco2sol (:,:)=0. - co2star(:,:,:)=0. - co3 (:,:,:)=0. - satoxy (:,:,:)=0. - omegaA (:,:,:)=0. - omegaC (:,:,:)=0. - if (use_cisonew) then - co213fxd (:,:)=0. - co213fxu (:,:)=0. - co214fxd (:,:)=0. - co214fxu (:,:)=0. - endif - if (use_natDIC) then - natpco2d (:,:)=0. - natco3 (:,:,:)=0. - natomegaA(:,:,:)=0. - natomegaC(:,:,:)=0. - endif - -!$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 & -!$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 & -!$OMP ,natcu,natcb,natcc,natpco2,natfluxd,natfluxu,natomega & -!$OMP ,natsupsat,natundsa,natdissol & -!$OMP ,atco213,atco214,rco213,rco214,pco213,pco214,frac_aqg & -!$OMP ,frac_dicg,flux13d,flux13u,flux14d,flux14u,dissol13,dissol14 & -!$OMP ,flx_bromo,sch_bromo,kw_bromo,a_bromo,atbrf,Kb1,lsub & -!$OMP ,j,i) - DO k=1,kpke - DO j=1,kpje +SUBROUTINE CARCHM(kpie,kpje,kpke,kbnd, & + pdlxp,pdlyp,pddpo,prho,pglat,omask, & + psicomo,ppao,pfu10,ptho,psao) + + !****************************************************************************** + ! + !**** *CARCHM* - . + ! + ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 + ! + ! Modified + ! -------- + ! S.Legutke, *MPI-MaD, HH* 10.04.01 + ! - rename: ssso12(i,j,k)=sedlay(i,j,k,issso12 ) etc.; no equivalence statements + ! - rename: powasi(i,j,k )=powtra(i,j,1,ipowasi) etc.; no equivalence statements + ! - interfacing with ocean model + ! + ! J.Tjiputra, *BCCR* 09.18.08 + ! - modified all carbon chemistry formulations following the OCMIP protocols + ! + ! J.Schwinger, *GFI, UiB* 2013-04-22 + ! - Use density prho consistent with MICOM for conversion to mol/kg + ! - Calculate solubility of O2 and N2 every timestep, consistent with + ! what is done for carbon chemistry. Array chemcm not used any more. + ! - Added J.Tjiputras code for cfc- and sf6-fluxes + ! - Cautious code clean-up + ! + ! J.Schwinger, *UNI-RESEARCH* 2017-08-30 + ! - Moved the accumulation of global fields for output to routine + ! hamocc4bgc. + ! + ! A.Moree, *GFI, Bergen* 2018-04-12 + ! - new version of carbon isotope code + ! + ! J.Tjiputra, *Uni Research, Bergen* 2018-04-12 + ! - added preformed and saturated DIC tracers + ! + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - moved accumulation of all output fields to seperate subroutine, + ! related code-restructuring + ! - dissolution of CaCO3 moved into main loop + ! - added sediment bypass preprocessor option + ! + ! Purpose + ! ------- + ! Inorganic carbon cycle. + ! + ! Method + ! ------- + ! Surface fluxes of CO2 / N2O / dms + ! Dissolution of calcium + ! + ! + !**** Parameter list: + ! --------------- + ! + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. + ! *INTEGER* *kbnd* - nb of halo grid points + ! *REAL* *pdlxp* - size of scalar grid cell (1st dimension) [m]. + ! *REAL* *pdlyp* - size of scalar grid cell (2nd dimension) [m]. + ! *REAL* *pddpo* - size of scalar grid cell (3rd dimension) [m]. + ! *REAL* *prho* - density [g/cm^3]. + ! *REAL* *pglat* - latitude of grid cells [deg north]. + ! *REAL* *omask* - ocean mask. + ! *REAL* *psicomo* - sea ice. + ! *REAL* *ppao* - sea level presure [Pascal]. + ! *REAL* *pfu10* - forcing field wind speed. + ! *REAL* *ptho* - potential temperature. + ! *REAL* *psao* - salinity [psu]. + ! + ! Externals + ! --------- + ! none. + ! + !********************************************************************** + 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,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, & + 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_param_bgc, only: c14dec,atm_co2_nat + use mo_vgrid, only: dp_min,kmle,kbo,ptiestu + 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, & + nathi,natco3,natpco2d,natomegaa,natomegac + use mo_sedmnt, only: sedlay,powtra,burial + + implicit none + + INTEGER, intent(in) :: kpie,kpje,kpke,kbnd + REAL, intent(in) :: pdlxp(kpie,kpje) + REAL, intent(in) :: pdlyp(kpie,kpje) + REAL, intent(in) :: pddpo(kpie,kpje,kpke) + REAL, intent(in) :: prho(kpie,kpje,kpke) + REAL, intent(in) :: pglat(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) + REAL, intent(in) :: omask(kpie,kpje) + REAL, intent(in) :: psicomo(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) + REAL, intent(in) :: ppao(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) + REAL, intent(in) :: pfu10(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) + REAL, intent(in) :: ptho(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) + REAL, intent(in) :: psao(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) + + ! 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 + REAL :: scco2,sco2,scn2,scdms,scn2o + REAL :: Xconvxa + REAL :: oxflux,niflux,dmsflux,n2oflux + REAL :: ato2,atn2,atco2,pco2 + REAL :: oxy,ani,anisa + REAL :: rrho,t,t2,t3,t4,tk,tk100,prb,s,rs + 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 + 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. + pco2d (:,:)=0. + pco2m (:,:)=0. + kwco2d (:,:)=0. + co2sold (:,:)=0. + co2solm (:,:)=0. + kwco2sol (:,:)=0. + co2star(:,:,:)=0. + co3 (:,:,:)=0. + satoxy (:,:,:)=0. + omegaA (:,:,:)=0. + omegaC (:,:,:)=0. + if (use_cisonew) then + co213fxd (:,:)=0. + co213fxu (:,:)=0. + co214fxd (:,:)=0. + co214fxu (:,:)=0. + endif + if (use_natDIC) then + natpco2d (:,:)=0. + natco3 (:,:,:)=0. + natomegaA(:,:,:)=0. + natomegaC(:,:,:)=0. + endif + + !$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 & + !$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 & + !$OMP ,natcu,natcb,natcc,natpco2,natfluxd,natfluxu,natomega & + !$OMP ,natsupsat,natundsa,natdissol & + !$OMP ,atco213,atco214,rco213,rco214,pco213,pco214,frac_aqg & + !$OMP ,frac_dicg,flux13d,flux13u,flux14d,flux14u,dissol13,dissol14 & + !$OMP ,flx_bromo,sch_bromo,kw_bromo,a_bromo,atbrf,Kb1,lsub & + !$OMP ,j,i) + 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 - -! Carbon chemistry: Calculate equilibrium constants and solve for [H+] and -! carbonate alkalinity (ac) - t = min(40.,max(-3.,ptho(i,j,k))) - t2 = t**2 - t3 = t**3 - t4 = t**4 - tk = t + tzero - tk100= tk/100.0 - s = min(40.,max( 25.,psao(i,j,k))) - rrho = prho(i,j,k) ! seawater density [g/cm3] - prb = ptiestu(i,j,k)*98060*1.027e-6 ! pressure in unit bars, 98060 = onem - - tc = ocetra(i,j,k,isco212) / rrho ! convert to mol/kg - ta = ocetra(i,j,k,ialkali) / rrho - sit = ocetra(i,j,k,isilica) / rrho - pt = ocetra(i,j,k,iphosph) / rrho - ah1 = hi(i,j,k) - - CALL CARCHM_KEQUI(t,s,prb,Kh,Khd,K1,K2,Kb,Kw,Ks1,Kf,Ksi, & - K1p,K2p,K3p,Kspc,Kspa) - - 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 - hi(i,j,k)=max(1.e-20,ah1) - endif - -! Determine CO2*, HCO3- and CO3-- concentrations (in mol/kg soln) - cu = ( 2. * tc - ac ) / ( 2. + K1 / ah1 ) - cb = K1 * cu / ah1 - cc = K2 * cb / ah1 - co2star(i,j,k)=cu - -! Carbonate ion concentration, convert from mol/kg to kmol/m^3 - co3(i,j,k) = cc * rrho - - 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) - - 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 - -! 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 - oxy=ox0+ox1/tk100+ox2*alog(tk100)+ox3*tk100+s*(ox4+ox5*tk100+ox6*tk100**2) - satoxy(i,j,k)=exp(oxy)*oxyco - - if (k.eq.1) then -! Determine CO2 pressure and fugacity (in micoatm) -! NOTE: equation below for pCO2 needs requires CO2 in mol/kg - pco2 = cu * 1.e6 / Kh - if (use_natDIC) then - natpco2 = natcu * 1.e6 / Kh - endif - - -! Schmidt numbers according to Wanninkhof (2014), Table 1 - scco2 = 2116.8 - 136.25*t + 4.7353*t2 - 0.092307*t3 + 0.0007555 *t4 - sco2 = 1920.4 - 135.6 *t + 5.2122*t2 - 0.10939 *t3 + 0.00093777*t4 - 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 - 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 - endif - 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 - endif - -! 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 - ani=an0+an1/tk100+an2*alog(tk100)+an3*tk100+s*(an4+an5*tk100+an6*tk100**2) - anisa=exp(ani)*oxyco - -! solubility of laughing gas (Weiss and Price 1980, Marine Chemistry, 8, 347-359) -! for moist air at 1 atm in kmol/m^3/atm - rs=al1+al2/tk100+al3*log(tk100)+al4*tk100**2+s*(bl1+bl2*tk100+bl3*tk100**2) - satn2o(i,j)=exp(rs) - - 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 - 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 - -! 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 - kwco2 = (1.-psicomo(i,j)) * Xconvxa * pfu10(i,j)**2*(660./scco2)**0.5 - kwo2 = (1.-psicomo(i,j)) * Xconvxa * pfu10(i,j)**2*(660./sco2)**0.5 - 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 - 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 - endif - 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 - - atco2 = atm(i,j,iatmco2) - ato2 = atm(i,j,iatmo2) - atn2 = atm(i,j,iatmn2) - if (use_cisonew) then - atco213 = atm(i,j,iatmc13) - atco214 = atm(i,j,iatmc14) - endif - if (use_BROMO) then - atbrf = atm(i,j,iatmbromo) - endif - -! 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 -! mixing ratio (i.e. partial presure = mixing ratio*SLP/P_0 [atm]) - rpp0 = ppao(i,j)/101325.0 - - fluxd=atco2*rpp0*kwco2*dtbgc*Kh*1e-6*rrho ! Kh is in mol/kg/atm. Multiply by rrho (g/cm^3) - 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)) - 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)) - endif - -! Calculate saturation DIC concentration in mixed layer - ta = ocetra(i,j,k,ialkali) / rrho - CALL carchm_solve_DICsat(s,atco2*rpp0,ta,sit,pt,Kh,K1,K2,Kb,Kw,Ks1,Kf, & - 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 - - 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 - - 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 - -! Update DIC - ocetra(i,j,1,isco212)=ocetra(i,j,1,isco212)+(fluxd-fluxu)/pddpo(i,j,1) - if (use_natDIC) then - ocetra(i,j,1,inatsco212)=ocetra(i,j,1,inatsco212)+(natfluxd-natfluxu)/pddpo(i,j,1) - endif - 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) - endif - -! Surface flux of oxygen - oxflux=kwo2*dtbgc*(ocetra(i,j,1,ioxygen)-satoxy(i,j,1)*(ato2/196800)*rpp0) - ocetra(i,j,1,ioxygen)=ocetra(i,j,1,ioxygen)-oxflux/pddpo(i,j,1) -! Surface flux of gaseous nitrogen (same piston velocity as for O2) - niflux=kwn2*dtbgc*(ocetra(i,j,1,igasnit)-anisa*(atn2/802000)*rpp0) - ocetra(i,j,1,igasnit)=ocetra(i,j,1,igasnit)-niflux/pddpo(i,j,1) -! 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) - 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)) -! flx12=kw_12*(a_12*cfc12_atm(i,j)*ppair/p0-trc(i,j,1,2)) -! 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 - -! 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) -! 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) -! 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 - -! Surface flux of dms - ! 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) - atmflx(i,j,iatmbromo) = -flx_bromo - endif - -! Save surface fluxes - atmflx(i,j,iatmco2)=fluxu-fluxd - atmflx(i,j,iatmo2)=oxflux - atmflx(i,j,iatmn2)=niflux - atmflx(i,j,iatmn2o)=n2oflux - if (use_cisonew) then - atmflx(i,j,iatmc13)=flux13u-flux13d - atmflx(i,j,iatmc14)=flux14u-flux14d - endif - if (use_CFC) then - atmflx(i,j,iatmf11)=flx11 - atmflx(i,j,iatmf12)=flx12 - atmflx(i,j,iatmsf6)=flxsf - endif - if (use_natDIC) then - atmflx(i,j,iatmnco2)=natfluxu-natfluxd - endif - -! Save up- and downward components of carbon fluxes for output - co2fxd(i,j) = fluxd - co2fxu(i,j) = fluxu - if (use_cisonew) then - co213fxd(i,j)= flux13d - co213fxu(i,j)= flux13u - co214fxd(i,j)= flux14d - co214fxu(i,j)= flux14u - endif - -! 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 - if (use_natDIC) then - natpco2d(i,j) = natcu * 1.e6 / Khd - endif - -! Save product of piston velocity and solubility for output - kwco2sol(i,j) = kwco2*Kh*1e-6 !m/s mol/kg/muatm - kwco2d(i,j) = kwco2 ! m/s (incl. ice fraction!) - co2sold(i,j) = Khd ! mol/kg/atm - co2solm(i,j) = Kh ! mol/kg/atm - - endif ! k==1 - - 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)) -! 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 -! ----------------------------------------------------------------- -! Deep ocean processes - -! Determine Omega Calcite/Aragonite and dissolution of caco3 based on OmegaC: -! omegaC=([CO3]*[Ca])/([CO3]sat*[Ca]sat) -! Following Sarmiento and Gruber book, assumed that [Ca]=[Ca]sat -! Thus, [CO3]sat=[CO3]/OmegaC. - omega = ( calcon * s / 35. ) * cc - OmegaA(i,j,k) = omega / Kspa - OmegaC(i,j,k) = omega / Kspc - 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)) - 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)) - endif - 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) - endif - 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 - 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 - endif - 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 - endif - - - 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 - endif - - ! Save bottom level dissociation konstants for use in sediment module - if( k==kbo(i,j) ) then - - keqb( 1,i,j) = K1 - keqb( 2,i,j) = K2 - keqb( 3,i,j) = Kb - keqb( 4,i,j) = Kw - keqb( 5,i,j) = Ks1 - keqb( 6,i,j) = Kf - keqb( 7,i,j) = Ksi - keqb( 8,i,j) = K1p - keqb( 9,i,j) = K2p - keqb(10,i,j) = K3p - keqb(11,i,j) = Kspc - - endif - - ENDIF ! omask>0.5 - ENDDO - ENDDO - ENDDO -!$OMP END PARALLEL DO - - ! 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 + IF(omask(i,j).gt.0.5.and.pddpo(i,j,k).GT.dp_min) THEN + + ! Carbon chemistry: Calculate equilibrium constants and solve for [H+] and + ! carbonate alkalinity (ac) + t = min(40.,max(-3.,ptho(i,j,k))) + t2 = t**2 + t3 = t**3 + t4 = t**4 + tk = t + tzero + tk100= tk/100.0 + s = min(40.,max( 25.,psao(i,j,k))) + rrho = prho(i,j,k) ! seawater density [g/cm3] + prb = ptiestu(i,j,k)*98060*1.027e-6 ! pressure in unit bars, 98060 = onem + + tc = ocetra(i,j,k,isco212) / rrho ! convert to mol/kg + ta = ocetra(i,j,k,ialkali) / rrho + sit = ocetra(i,j,k,isilica) / rrho + pt = ocetra(i,j,k,iphosph) / rrho + ah1 = hi(i,j,k) + + CALL CARCHM_KEQUI(t,s,prb,Kh,Khd,K1,K2,Kb,Kw,Ks1,Kf,Ksi, & + K1p,K2p,K3p,Kspc,Kspa) + + 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 + hi(i,j,k)=max(1.e-20,ah1) + endif + + ! Determine CO2*, HCO3- and CO3-- concentrations (in mol/kg soln) + cu = ( 2. * tc - ac ) / ( 2. + K1 / ah1 ) + cb = K1 * cu / ah1 + cc = K2 * cb / ah1 + co2star(i,j,k)=cu + + ! Carbonate ion concentration, convert from mol/kg to kmol/m^3 + co3(i,j,k) = cc * rrho + + 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) + + 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 + + ! 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 + oxy=ox0+ox1/tk100+ox2*alog(tk100)+ox3*tk100+s*(ox4+ox5*tk100+ox6*tk100**2) + satoxy(i,j,k)=exp(oxy)*oxyco + + if (k.eq.1) then + ! Determine CO2 pressure and fugacity (in micoatm) + ! NOTE: equation below for pCO2 needs requires CO2 in mol/kg + pco2 = cu * 1.e6 / Kh + if (use_natDIC) then + natpco2 = natcu * 1.e6 / Kh + endif + + + ! Schmidt numbers according to Wanninkhof (2014), Table 1 + scco2 = 2116.8 - 136.25*t + 4.7353*t2 - 0.092307*t3 + 0.0007555 *t4 + sco2 = 1920.4 - 135.6 *t + 5.2122*t2 - 0.10939 *t3 + 0.00093777*t4 + 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 + 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 + endif + 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 + endif + + ! 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 + ani=an0+an1/tk100+an2*alog(tk100)+an3*tk100+s*(an4+an5*tk100+an6*tk100**2) + anisa=exp(ani)*oxyco + + ! solubility of laughing gas (Weiss and Price 1980, Marine Chemistry, 8, 347-359) + ! for moist air at 1 atm in kmol/m^3/atm + rs=al1+al2/tk100+al3*log(tk100)+al4*tk100**2+s*(bl1+bl2*tk100+bl3*tk100**2) + satn2o(i,j)=exp(rs) + + 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 + 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 + + ! 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 + kwco2 = (1.-psicomo(i,j)) * Xconvxa * pfu10(i,j)**2*(660./scco2)**0.5 + kwo2 = (1.-psicomo(i,j)) * Xconvxa * pfu10(i,j)**2*(660./sco2)**0.5 + 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 + 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 + endif + 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 + + atco2 = atm(i,j,iatmco2) + ato2 = atm(i,j,iatmo2) + atn2 = atm(i,j,iatmn2) + if (use_cisonew) then + atco213 = atm(i,j,iatmc13) + atco214 = atm(i,j,iatmc14) + endif + if (use_BROMO) then + atbrf = atm(i,j,iatmbromo) + endif + + ! 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 + ! mixing ratio (i.e. partial presure = mixing ratio*SLP/P_0 [atm]) + rpp0 = ppao(i,j)/101325.0 + + fluxd=atco2*rpp0*kwco2*dtbgc*Kh*1e-6*rrho ! Kh is in mol/kg/atm. Multiply by rrho (g/cm^3) + 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)) + 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)) endif - enddo - enddo - !$OMP END PARALLEL DO - endif ! end of use_cisonew and not use_sedbypass - RETURN - END SUBROUTINE CARCHM + ! Calculate saturation DIC concentration in mixed layer + ta = ocetra(i,j,k,ialkali) / rrho + CALL carchm_solve_DICsat(s,atco2*rpp0,ta,sit,pt,Kh,K1,K2,Kb,Kw,Ks1,Kf, & + 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 + + 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 + + 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 + + ! Update DIC + ocetra(i,j,1,isco212)=ocetra(i,j,1,isco212)+(fluxd-fluxu)/pddpo(i,j,1) + if (use_natDIC) then + ocetra(i,j,1,inatsco212)=ocetra(i,j,1,inatsco212)+(natfluxd-natfluxu)/pddpo(i,j,1) + endif + 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) + endif + ! Surface flux of oxygen + oxflux=kwo2*dtbgc*(ocetra(i,j,1,ioxygen)-satoxy(i,j,1)*(ato2/196800)*rpp0) + ocetra(i,j,1,ioxygen)=ocetra(i,j,1,ioxygen)-oxflux/pddpo(i,j,1) + ! Surface flux of gaseous nitrogen (same piston velocity as for O2) + niflux=kwn2*dtbgc*(ocetra(i,j,1,igasnit)-anisa*(atn2/802000)*rpp0) + ocetra(i,j,1,igasnit)=ocetra(i,j,1,igasnit)-niflux/pddpo(i,j,1) + ! 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) + 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)) + ! flx12=kw_12*(a_12*cfc12_atm(i,j)*ppair/p0-trc(i,j,1,2)) + ! 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 + + ! 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) + ! 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) + ! 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 + + ! Surface flux of dms + ! 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) + atmflx(i,j,iatmbromo) = -flx_bromo + endif + + ! Save surface fluxes + atmflx(i,j,iatmco2)=fluxu-fluxd + atmflx(i,j,iatmo2)=oxflux + atmflx(i,j,iatmn2)=niflux + atmflx(i,j,iatmn2o)=n2oflux + if (use_cisonew) then + atmflx(i,j,iatmc13)=flux13u-flux13d + atmflx(i,j,iatmc14)=flux14u-flux14d + endif + if (use_CFC) then + atmflx(i,j,iatmf11)=flx11 + atmflx(i,j,iatmf12)=flx12 + atmflx(i,j,iatmsf6)=flxsf + endif + if (use_natDIC) then + atmflx(i,j,iatmnco2)=natfluxu-natfluxd + endif + + ! Save up- and downward components of carbon fluxes for output + co2fxd(i,j) = fluxd + co2fxu(i,j) = fluxu + if (use_cisonew) then + co213fxd(i,j)= flux13d + co213fxu(i,j)= flux13u + co214fxd(i,j)= flux14d + co214fxu(i,j)= flux14u + endif + + ! 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 + if (use_natDIC) then + natpco2d(i,j) = natcu * 1.e6 / Khd + endif + + ! Save product of piston velocity and solubility for output + kwco2sol(i,j) = kwco2*Kh*1e-6 !m/s mol/kg/muatm + kwco2d(i,j) = kwco2 ! m/s (incl. ice fraction!) + co2sold(i,j) = Khd ! mol/kg/atm + co2solm(i,j) = Kh ! mol/kg/atm + + endif ! k==1 + + 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)) + ! 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 + ! ----------------------------------------------------------------- + ! Deep ocean processes + + ! Determine Omega Calcite/Aragonite and dissolution of caco3 based on OmegaC: + ! omegaC=([CO3]*[Ca])/([CO3]sat*[Ca]sat) + ! Following Sarmiento and Gruber book, assumed that [Ca]=[Ca]sat + ! Thus, [CO3]sat=[CO3]/OmegaC. + omega = ( calcon * s / 35. ) * cc + OmegaA(i,j,k) = omega / Kspa + OmegaC(i,j,k) = omega / Kspc + 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)) + 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)) + endif + 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) + endif + 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 + 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 + endif + 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 + endif + + + 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 + endif + + ! Save bottom level dissociation konstants for use in sediment module + if( k==kbo(i,j) ) then + + keqb( 1,i,j) = K1 + keqb( 2,i,j) = K2 + keqb( 3,i,j) = Kb + keqb( 4,i,j) = Kw + keqb( 5,i,j) = Ks1 + keqb( 6,i,j) = Kf + keqb( 7,i,j) = Ksi + keqb( 8,i,j) = K1p + keqb( 9,i,j) = K2p + keqb(10,i,j) = K3p + keqb(11,i,j) = Kspc + + endif + + ENDIF ! omask>0.5 + ENDDO + ENDDO + ENDDO + !$OMP END PARALLEL DO + + ! 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 + endif ! end of use_cisonew and not use_sedbypass + + RETURN +END SUBROUTINE CARCHM diff --git a/hamocc/carchm_kequi.F90 b/hamocc/carchm_kequi.F90 index 781d6a0b..d7e565eb 100644 --- a/hamocc/carchm_kequi.F90 +++ b/hamocc/carchm_kequi.F90 @@ -3,172 +3,172 @@ ! 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 CARCHM_KEQUI(temp,saln,prb,Kh,Khd,K1,K2,Kb,Kw,Ks1,Kf,Ksi, & - K1p,K2p,K3p,Kspc,Kspa) -!******************************************************************************* -! -!**** *CARCHM_SOLVE* - . -! -! J. Schwinger, *BCCR, Bergen* 09.02.16 -! -! Modified -! -------- -! -! Purpose -! ------- -! Calculate equilibrium constant for the carbonate system -! -! Method -! ------- -! J.Schwinger, *Uni Research, Bergen* 2018-04-12 -! - added output Khd (CO2 solubility w.r.t. dry air) and -! Kspa -! -! -!**** Parameter list: -! --------------- -! -! *REAL* *temp* - potential temperature [degr C]. -! *REAL* *saln* - salinity [psu]. -! *REAL* *prb* - pressure [bar]. -! *REAL* *Kh* - equilibrium constant Kh = [CO2]/pCO2, moist air. -! *REAL* *Khd* - equilibrium constant Kh = [CO2]/pCO2, dry air. -! *REAL* *K1* - equilibrium constant K1 = [H][HCO3]/[H2CO3]. -! *REAL* *K2* - equilibrium constant K2 = [H][CO3]/[HCO3]. -! *REAL* *Kb* - equilibrium constant Kb = [H][BO2]/[HBO2]. -! *REAL* *Kw* - equilibrium constant Kw = [H][OH]. -! *REAL* *Ks1* - equilibrium constant Ks1 = [H][SO4]/[HSO4]. -! *REAL* *Kf* - equilibrium constant Kf = [H][F]/[HF]. -! *REAL* *Ksi* - equilibrium constant Ksi = [H][SiO(OH)3]/[Si(OH)4]. -! *REAL* *K1p* - equilibrium constant K1p = [H][H2PO4]/[H3PO4]. -! *REAL* *K2p* - equilibrium constant K2p = [H][HPO4]/[H2PO4]. -! *REAL* *K3p* - equilibrium constant K3p = [H][PO4]/[HPO4]. -! *REAL* *Kspc* - equilibrium constant Kspc= [Ca2+]T [CO3]T. -! *REAL* *Kspa* - equilibrium constant Kspa= [Ca2+]T [CO3]T. -! -! Externals -! --------- -! none. -! -!******************************************************************************* + K1p,K2p,K3p,Kspc,Kspa) + !******************************************************************************* + ! + !**** *CARCHM_SOLVE* - . + ! + ! J. Schwinger, *BCCR, Bergen* 09.02.16 + ! + ! Modified + ! -------- + ! + ! Purpose + ! ------- + ! Calculate equilibrium constant for the carbonate system + ! + ! Method + ! ------- + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - added output Khd (CO2 solubility w.r.t. dry air) and + ! Kspa + ! + ! + !**** Parameter list: + ! --------------- + ! + ! *REAL* *temp* - potential temperature [degr C]. + ! *REAL* *saln* - salinity [psu]. + ! *REAL* *prb* - pressure [bar]. + ! *REAL* *Kh* - equilibrium constant Kh = [CO2]/pCO2, moist air. + ! *REAL* *Khd* - equilibrium constant Kh = [CO2]/pCO2, dry air. + ! *REAL* *K1* - equilibrium constant K1 = [H][HCO3]/[H2CO3]. + ! *REAL* *K2* - equilibrium constant K2 = [H][CO3]/[HCO3]. + ! *REAL* *Kb* - equilibrium constant Kb = [H][BO2]/[HBO2]. + ! *REAL* *Kw* - equilibrium constant Kw = [H][OH]. + ! *REAL* *Ks1* - equilibrium constant Ks1 = [H][SO4]/[HSO4]. + ! *REAL* *Kf* - equilibrium constant Kf = [H][F]/[HF]. + ! *REAL* *Ksi* - equilibrium constant Ksi = [H][SiO(OH)3]/[Si(OH)4]. + ! *REAL* *K1p* - equilibrium constant K1p = [H][H2PO4]/[H3PO4]. + ! *REAL* *K2p* - equilibrium constant K2p = [H][HPO4]/[H2PO4]. + ! *REAL* *K3p* - equilibrium constant K3p = [H][PO4]/[HPO4]. + ! *REAL* *Kspc* - equilibrium constant Kspc= [Ca2+]T [CO3]T. + ! *REAL* *Kspa* - equilibrium constant Kspa= [Ca2+]T [CO3]T. + ! + ! Externals + ! --------- + ! none. + ! + !******************************************************************************* -use mo_chemcon, only: tzero,rgas,bor1,bor2,salchl,ac1,ac2,ac3,ac4,bc1,bc2,bc3,ad1,ad2,ad3,bd1,bd2,bd3,a0,a1,a2,b0,b1,b2 + use mo_chemcon, only: tzero,rgas,bor1,bor2,salchl,ac1,ac2,ac3,ac4,bc1,bc2,bc3,ad1,ad2,ad3,bd1,bd2,bd3,a0,a1,a2,b0,b1,b2 -IMPLICIT NONE -REAL, INTENT(IN) :: temp,saln,prb -REAL, INTENT(OUT) :: Kh,Khd,K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p,Kspc,Kspa + IMPLICIT NONE + REAL, INTENT(IN) :: temp,saln,prb + REAL, INTENT(OUT) :: Kh,Khd,K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p,Kspc,Kspa -! Local varibles -INTEGER :: js -REAL :: tk,tk100,invtk,dlogtk -REAL :: s,is,is2,sqrtis,s15,s2,sqrts,scl -REAL :: nKhwe74,deltav,deltak,zprb,zprb2 -REAL :: lnkpok0(11) + ! Local varibles + INTEGER :: js + REAL :: tk,tk100,invtk,dlogtk + REAL :: s,is,is2,sqrtis,s15,s2,sqrts,scl + REAL :: nKhwe74,deltav,deltak,zprb,zprb2 + REAL :: lnkpok0(11) -s = MAX(25.,saln) -tk = temp + tzero -tk100 = tk/100.0 -invtk = 1.0 / tk -dlogtk = log(tk) -is = 19.924 * s / ( 1000. - 1.005 * s ) -is2 = is * is -sqrtis = SQRT(is) -s15 = s**1.5 -s2 = s * s -sqrts = SQRT(s) -scl = s * salchl + s = MAX(25.,saln) + tk = temp + tzero + tk100 = tk/100.0 + invtk = 1.0 / tk + dlogtk = log(tk) + is = 19.924 * s / ( 1000. - 1.005 * s ) + is2 = is * is + sqrtis = SQRT(is) + s15 = s**1.5 + s2 = s * s + sqrts = SQRT(s) + scl = s * salchl -! Kh = [CO2]/ p CO2 -! Weiss (1974), refitted for moist air Weiss and Price (1980) [mol/kg/atm] -nKhwe74 = ac1+ac2/tk100+ac3*log(tk100)+ac4*tk100**2+s*(bc1+bc2*tk100+bc3*tk100**2) -Kh = exp( nKhwe74 ) -! Khd = [CO2]/ p CO2 -! Weiss (1974) for dry air [mol/kg/atm] -nKhwe74 = ad1+ad2/tk100+ad3*log(tk100)+s*(bd1+bd2*tk100+bd3*tk100**2) -Khd = exp( nKhwe74 ) -! K1 = [H][HCO3]/[H2CO3] ; K2 = [H][CO3]/[HCO3] -! Millero p.664 (1995) using Mehrbach et al. data on seawater scale -K1 = 10**( -1.0 * ( 3670.7 * invtk - 62.008 + 9.7944 * dlogtk - 0.0118 * s + 0.000116 * s2 ) ) -K2 = 10**( -1.0 * ( 1394.7 * invtk + 4.777 - 0.0184 * s + 0.000118 * s2 ) ) -! Kb = [H][BO2]/[HBO2] ! -! Millero p.669 (1995) using DATA from Dickson (1990) -Kb = exp( ( -8966.90 - 2890.53 * sqrts - 77.942 * s + 1.728 * s15 - 0.0996 * s2 ) * invtk + & - ( 148.0248 + 137.1942 * sqrts + 1.62142 * s ) + & - ( -24.4344 - 25.085 * sqrts - 0.2474 * s ) * dlogtk + 0.053105 * sqrts * tk ) -! K1p = [H][H2PO4]/[H3PO4] ; K2p = [H][HPO4]/[H2PO4] ; K3p = [H][PO4]/[HPO4] -! DOE(1994) eq 7.2.20 with footnote using data from Millero (1974) -K1p = exp( -4576.752 * invtk + 115.525 - 18.453 * dlogtk + ( -106.736 * invtk + 0.69171 ) * & - sqrts + ( -0.65643 * invtk - 0.01844 ) * s ) -K2p = exp( -8814.715 * invtk + 172.0883 - 27.927 * dlogtk + ( -160.340 * invtk + 1.3566 ) * & - sqrts + ( 0.37335 * invtk - 0.05778 ) *s ); -K3p = exp( -3070.75 * invtk - 18.141 + ( 17.27039 * invtk + 2.81197 ) * sqrts + ( -44.99486 * & - invtk - 0.09984 ) * s ); -! Ksi = [H][SiO(OH)3]/[Si(OH)4] -! Millero p.671 (1995) using data from Yao and Millero (1995) -Ksi = exp( -8904.2 * invtk + 117.385 - 19.334 * dlogtk + ( -458.79 * invtk + 3.5913 ) * sqrtis & + ! Kh = [CO2]/ p CO2 + ! Weiss (1974), refitted for moist air Weiss and Price (1980) [mol/kg/atm] + nKhwe74 = ac1+ac2/tk100+ac3*log(tk100)+ac4*tk100**2+s*(bc1+bc2*tk100+bc3*tk100**2) + Kh = exp( nKhwe74 ) + ! Khd = [CO2]/ p CO2 + ! Weiss (1974) for dry air [mol/kg/atm] + nKhwe74 = ad1+ad2/tk100+ad3*log(tk100)+s*(bd1+bd2*tk100+bd3*tk100**2) + Khd = exp( nKhwe74 ) + ! K1 = [H][HCO3]/[H2CO3] ; K2 = [H][CO3]/[HCO3] + ! Millero p.664 (1995) using Mehrbach et al. data on seawater scale + K1 = 10**( -1.0 * ( 3670.7 * invtk - 62.008 + 9.7944 * dlogtk - 0.0118 * s + 0.000116 * s2 ) ) + K2 = 10**( -1.0 * ( 1394.7 * invtk + 4.777 - 0.0184 * s + 0.000118 * s2 ) ) + ! Kb = [H][BO2]/[HBO2] ! + ! Millero p.669 (1995) using DATA from Dickson (1990) + Kb = exp( ( -8966.90 - 2890.53 * sqrts - 77.942 * s + 1.728 * s15 - 0.0996 * s2 ) * invtk + & + ( 148.0248 + 137.1942 * sqrts + 1.62142 * s ) + & + ( -24.4344 - 25.085 * sqrts - 0.2474 * s ) * dlogtk + 0.053105 * sqrts * tk ) + ! K1p = [H][H2PO4]/[H3PO4] ; K2p = [H][HPO4]/[H2PO4] ; K3p = [H][PO4]/[HPO4] + ! DOE(1994) eq 7.2.20 with footnote using data from Millero (1974) + K1p = exp( -4576.752 * invtk + 115.525 - 18.453 * dlogtk + ( -106.736 * invtk + 0.69171 ) * & + sqrts + ( -0.65643 * invtk - 0.01844 ) * s ) + K2p = exp( -8814.715 * invtk + 172.0883 - 27.927 * dlogtk + ( -160.340 * invtk + 1.3566 ) * & + sqrts + ( 0.37335 * invtk - 0.05778 ) *s ); + K3p = exp( -3070.75 * invtk - 18.141 + ( 17.27039 * invtk + 2.81197 ) * sqrts + ( -44.99486 * & + invtk - 0.09984 ) * s ); + ! Ksi = [H][SiO(OH)3]/[Si(OH)4] + ! Millero p.671 (1995) using data from Yao and Millero (1995) + Ksi = exp( -8904.2 * invtk + 117.385 - 19.334 * dlogtk + ( -458.79 * invtk + 3.5913 ) * sqrtis & + ( 188.74 * invtk - 1.5998) * is + ( -12.1652 * invtk + 0.07871) * is2 + & - log(1.0-0.001005*s)) -! Kw = [H][OH] -! Millero p.670 (1995) using composite data -Kw = exp( -13847.26 * invtk + 148.9652 - 23.6521 * dlogtk + ( 118.67 * invtk - 5.977 + 1.0495 * & - dlogtk ) * sqrts - 0.01615 * s) -! Ks = [H][SO4]/[HSO4] -! Dickson (1990, J. chem. Thermodynamics 22, 113) -Ks1 = exp( -4276.1 * invtk + 141.328 - 23.093 * dlogtk + ( -13856. * invtk + 324.57 - 47.986 * & - dlogtk ) * sqrtis + ( 35474. * invtk - 771.54 + 114.723 * dlogtk ) * is - 2698. * & - invtk * is**1.5 + 1776. * invtk * is2 + log(1.0 - 0.001005 * s ) ) -! Kf = [H][F]/[HF] -! Dickson and Riley (1979) -- change pH scale to total -Kf = exp( 1590.2 * invtk - 12.641 + 1.525 * sqrtis + log( 1.0 - 0.001005 * s ) + log( 1.0 + ( & - 0.1400 / 96.062 ) * scl / Ks1 ) ) -! Kspc (calcite) -! apparent solubility product of calcite : Kspc = [Ca2+]T [CO32-]T -! where $[]_T$ refers to the equilibrium total (free + complexed) ion concentration. -! Mucci 1983 mol/kg-soln -Kspc = 10**( -171.9065 - 0.077993 * tk + 2839.319 / tk + 71.595 * log10( tk ) + ( - 0.77712 + & - 0.0028426 * tk + 178.34 / tk ) * sqrts - 0.07711 * s + 0.0041249 * s15 ); -! Kspa (aragonite) -! apparent solubility product of aragonite : Kspa = [Ca2+]T [CO32-]T -! where $[]_T$ refers to the equilibrium total (free + complexed) ion concentration. -! Mucci 1983 mol/kg-soln -Kspa = 10**( -171.945 - 0.077993 * tk + 2903.293 / tk + 71.595 * log10( tk ) + ( -0.068393 + & - 0.0017276 * tk + 88.135 / tk ) * sqrts - 0.10018 * s + 0.0059415 * s15 ); + log(1.0-0.001005*s)) + ! Kw = [H][OH] + ! Millero p.670 (1995) using composite data + Kw = exp( -13847.26 * invtk + 148.9652 - 23.6521 * dlogtk + ( 118.67 * invtk - 5.977 + 1.0495 * & + dlogtk ) * sqrts - 0.01615 * s) + ! Ks = [H][SO4]/[HSO4] + ! Dickson (1990, J. chem. Thermodynamics 22, 113) + Ks1 = exp( -4276.1 * invtk + 141.328 - 23.093 * dlogtk + ( -13856. * invtk + 324.57 - 47.986 * & + dlogtk ) * sqrtis + ( 35474. * invtk - 771.54 + 114.723 * dlogtk ) * is - 2698. * & + invtk * is**1.5 + 1776. * invtk * is2 + log(1.0 - 0.001005 * s ) ) + ! Kf = [H][F]/[HF] + ! Dickson and Riley (1979) -- change pH scale to total + Kf = exp( 1590.2 * invtk - 12.641 + 1.525 * sqrtis + log( 1.0 - 0.001005 * s ) + log( 1.0 + ( & + 0.1400 / 96.062 ) * scl / Ks1 ) ) + ! Kspc (calcite) + ! apparent solubility product of calcite : Kspc = [Ca2+]T [CO32-]T + ! where $[]_T$ refers to the equilibrium total (free + complexed) ion concentration. + ! Mucci 1983 mol/kg-soln + Kspc = 10**( -171.9065 - 0.077993 * tk + 2839.319 / tk + 71.595 * log10( tk ) + ( - 0.77712 + & + 0.0028426 * tk + 178.34 / tk ) * sqrts - 0.07711 * s + 0.0041249 * s15 ); + ! Kspa (aragonite) + ! apparent solubility product of aragonite : Kspa = [Ca2+]T [CO32-]T + ! where $[]_T$ refers to the equilibrium total (free + complexed) ion concentration. + ! Mucci 1983 mol/kg-soln + Kspa = 10**( -171.945 - 0.077993 * tk + 2903.293 / tk + 71.595 * log10( tk ) + ( -0.068393 + & + 0.0017276 * tk + 88.135 / tk ) * sqrts - 0.10018 * s + 0.0059415 * s15 ); -!---------------------- Pressure effect on Ks (Millero, 95) -------------------- -! index: K1 1, K2 2, Kb 3, Kw 4, Ks 5, Kf 6, Kspc 7, Kspa 8, K1p 9, K2p 10, K3p 11 -DO js = 1,11 - deltav = a0(js) + a1(js) * temp + a2(js) * temp * temp - deltak = b0(js) + b1(js) * temp + b2(js) * temp * temp - zprb = prb / ( rgas * tk ) - zprb2 = prb * zprb - lnkpok0(js) = - ( deltav * zprb + 0.5 * deltak * zprb2 ) -ENDDO + !---------------------- Pressure effect on Ks (Millero, 95) -------------------- + ! index: K1 1, K2 2, Kb 3, Kw 4, Ks 5, Kf 6, Kspc 7, Kspa 8, K1p 9, K2p 10, K3p 11 + DO js = 1,11 + deltav = a0(js) + a1(js) * temp + a2(js) * temp * temp + deltak = b0(js) + b1(js) * temp + b2(js) * temp * temp + zprb = prb / ( rgas * tk ) + zprb2 = prb * zprb + lnkpok0(js) = - ( deltav * zprb + 0.5 * deltak * zprb2 ) + ENDDO -K1 = K1 * exp( lnkpok0(1) ) -K2 = K2 * exp( lnkpok0(2) ) -Kb = Kb * exp( lnkpok0(3) ) -Kw = Kw * exp( lnkpok0(4) ) -Ks1 = Ks1 * exp( lnkpok0(5) ) -Kf = Kf * exp( lnkpok0(6) ) -Kspc = Kspc * exp( lnkpok0(7) ) -Kspa = Kspa * exp( lnkpok0(8) ) -K1p = K1p * exp( lnkpok0(9) ) -K2p = K2p * exp( lnkpok0(10) ) -K3p = K3p * exp( lnkpok0(11) ) + K1 = K1 * exp( lnkpok0(1) ) + K2 = K2 * exp( lnkpok0(2) ) + Kb = Kb * exp( lnkpok0(3) ) + Kw = Kw * exp( lnkpok0(4) ) + Ks1 = Ks1 * exp( lnkpok0(5) ) + Kf = Kf * exp( lnkpok0(6) ) + Kspc = Kspc * exp( lnkpok0(7) ) + Kspa = Kspa * exp( lnkpok0(8) ) + K1p = K1p * exp( lnkpok0(9) ) + K2p = K2p * exp( lnkpok0(10) ) + K3p = K3p * exp( lnkpok0(11) ) END SUBROUTINE CARCHM_KEQUI diff --git a/hamocc/carchm_solve.F90 b/hamocc/carchm_solve.F90 index 7921fdc2..0395f2ed 100644 --- a/hamocc/carchm_solve.F90 +++ b/hamocc/carchm_solve.F90 @@ -3,113 +3,112 @@ ! 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 CARCHM_SOLVE(saln,tc,ta,sit,pt, & - K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p, & - ah1,ac,niter) -!********************************************************************** -! -!**** *CARCHM_SOLVE* - . -! -! J. Schwinger, *BCCR, Bergen* 09.02.16 -! -! Modified -! -------- -! -! Purpose -! ------- -! Solve carbon chemistry. -! -! Method -! ------- -! -! -!**** Parameter list: -! --------------- -! *REAL* *saln* - salinity [psu]. -! *REAL* *tc* - total DIC concentraion [mol/kg]. -! *REAL* *ta* - total alkalinity [eq/kg]. -! *REAL* *sit* - silicate concentration [mol/kg]. -! *REAL* *pt* - phosphate concentration [mol/kg]. -! *REAL* *K1* - equilibrium constant K1 = [H][HCO3]/[H2CO3]. -! *REAL* *K2* - equilibrium constant K2 = [H][CO3]/[HCO3]. -! *REAL* *Kb* - equilibrium constant Kb = [H][BO2]/[HBO2]. -! *REAL* *Kw* - equilibrium constant Kw = [H][OH]. -! *REAL* *Ks1* - equilibrium constant Ks1 = [H][SO4]/[HSO4]. -! *REAL* *Kf* - equilibrium constant Kf = [H][F]/[HF]. -! *REAL* *Ksi* - equilibrium constant Ksi = [H][SiO(OH)3]/[Si(OH)4]. -! *REAL* *K1p* - equilibrium constant K1p = [H][H2PO4]/[H3PO4]. -! *REAL* *K2p* - equilibrium constant K2p = [H][HPO4]/[H2PO4]. -! *REAL* *K3p* - equilibrium constant K3p = [H][PO4]/[HPO4]. -! *REAL* *ah1* - hydrogen ion concentration. -! *REAL* *ac* - carbonate alkalinity. -! *INTEGER* *niter* - maximum number of iteration -! -! Externals -! --------- -! none. -! -!********************************************************************** + K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p, & + ah1,ac,niter) + !********************************************************************** + ! + !**** *CARCHM_SOLVE* - . + ! + ! J. Schwinger, *BCCR, Bergen* 09.02.16 + ! + ! Modified + ! -------- + ! + ! Purpose + ! ------- + ! Solve carbon chemistry. + ! + ! Method + ! ------- + ! + ! + !**** Parameter list: + ! --------------- + ! *REAL* *saln* - salinity [psu]. + ! *REAL* *tc* - total DIC concentraion [mol/kg]. + ! *REAL* *ta* - total alkalinity [eq/kg]. + ! *REAL* *sit* - silicate concentration [mol/kg]. + ! *REAL* *pt* - phosphate concentration [mol/kg]. + ! *REAL* *K1* - equilibrium constant K1 = [H][HCO3]/[H2CO3]. + ! *REAL* *K2* - equilibrium constant K2 = [H][CO3]/[HCO3]. + ! *REAL* *Kb* - equilibrium constant Kb = [H][BO2]/[HBO2]. + ! *REAL* *Kw* - equilibrium constant Kw = [H][OH]. + ! *REAL* *Ks1* - equilibrium constant Ks1 = [H][SO4]/[HSO4]. + ! *REAL* *Kf* - equilibrium constant Kf = [H][F]/[HF]. + ! *REAL* *Ksi* - equilibrium constant Ksi = [H][SiO(OH)3]/[Si(OH)4]. + ! *REAL* *K1p* - equilibrium constant K1p = [H][H2PO4]/[H3PO4]. + ! *REAL* *K2p* - equilibrium constant K2p = [H][HPO4]/[H2PO4]. + ! *REAL* *K3p* - equilibrium constant K3p = [H][PO4]/[HPO4]. + ! *REAL* *ah1* - hydrogen ion concentration. + ! *REAL* *ac* - carbonate alkalinity. + ! *INTEGER* *niter* - maximum number of iteration + ! + ! Externals + ! --------- + ! none. + ! + !********************************************************************** -use mo_chemcon, only: bor1,bor2,salchl + use mo_chemcon, only: bor1,bor2,salchl -IMPLICIT NONE -REAL, INTENT(IN) :: saln,tc,ta,sit,pt -REAL, INTENT(IN) :: K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p -REAL, INTENT(INOUT) :: ah1 -REAL, INTENT(OUT) :: ac -INTEGER, INTENT(IN) :: niter - -! Parameters to set accuracy of iteration -REAL, PARAMETER :: eps=5.e-5 + IMPLICIT NONE + REAL, INTENT(IN) :: saln,tc,ta,sit,pt + REAL, INTENT(IN) :: K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p + REAL, INTENT(INOUT) :: ah1 + REAL, INTENT(OUT) :: ac + INTEGER, INTENT(IN) :: niter -! Local varibles -INTEGER :: jit -REAL :: s,scl,borat,sti,ft -REAL :: hso4,hf,hsi,hpo4,ab,aw,ah2o,ah2,erel + ! Parameters to set accuracy of iteration + REAL, PARAMETER :: eps=5.e-5 + ! Local varibles + INTEGER :: jit + REAL :: s,scl,borat,sti,ft + REAL :: hso4,hf,hsi,hpo4,ab,aw,ah2o,ah2,erel -! Calculate concentrations for borate, sulfate, and fluoride; see Dickson, A.G., -! Sabine, C.L. and Christian, J.R. (Eds.) 2007. Guide to best practices -! for ocean CO2 measurements. PICES Special Publication 3, chapter 5 p. 10 -s = MAX(25.,saln) -scl = s * salchl -borat = bor1 * scl * bor2 ! Uppstrom (1974) -sti = 0.14 * scl / 96.062 ! Morris & Riley (1966) -ft = 0.000067 * scl / 18.9984 ! Riley (1965) + ! Calculate concentrations for borate, sulfate, and fluoride; see Dickson, A.G., + ! Sabine, C.L. and Christian, J.R. (Eds.) 2007. Guide to best practices + ! for ocean CO2 measurements. PICES Special Publication 3, chapter 5 p. 10 + s = MAX(25.,saln) + scl = s * salchl + borat = bor1 * scl * bor2 ! Uppstrom (1974) + sti = 0.14 * scl / 96.062 ! Morris & Riley (1966) + ft = 0.000067 * scl / 18.9984 ! Riley (1965) -iflag: DO jit = 1,niter - hso4 = sti / ( 1. + Ks1 / ( ah1 / ( 1. + sti / Ks1 ) ) ) - hf = 1. / ( 1. + Kf / ah1 ) - hsi = 1./ ( 1. + ah1 / Ksi ) - hpo4 = ( K1p * K2p * ( ah1 + 2. * K3p ) - ah1**3 ) / & - ( ah1**3 + K1p * ah1**2 + K1p * K2p * ah1 + K1p * K2p * K3p ) - ab = borat / ( 1. + ah1 / Kb ) - aw = Kw / ah1 - ah1 / ( 1. + sti / Ks1 ) - ac = ta + hso4 - sit * hsi - ab - aw + ft * hf - pt * hpo4 - ah2o = SQRT( ( tc - ac )**2 + 4. * ( ac * K2 / K1 ) * ( 2. * tc - ac ) ) - ah2 = 0.5 * K1 / ac *( ( tc - ac ) + ah2o ) - erel = ( ah2 - ah1 ) / ah2 - if (abs( erel ).ge.eps) then + + iflag: DO jit = 1,niter + hso4 = sti / ( 1. + Ks1 / ( ah1 / ( 1. + sti / Ks1 ) ) ) + hf = 1. / ( 1. + Kf / ah1 ) + hsi = 1./ ( 1. + ah1 / Ksi ) + hpo4 = ( K1p * K2p * ( ah1 + 2. * K3p ) - ah1**3 ) / & + ( ah1**3 + K1p * ah1**2 + K1p * K2p * ah1 + K1p * K2p * K3p ) + ab = borat / ( 1. + ah1 / Kb ) + aw = Kw / ah1 - ah1 / ( 1. + sti / Ks1 ) + ac = ta + hso4 - sit * hsi - ab - aw + ft * hf - pt * hpo4 + ah2o = SQRT( ( tc - ac )**2 + 4. * ( ac * K2 / K1 ) * ( 2. * tc - ac ) ) + ah2 = 0.5 * K1 / ac *( ( tc - ac ) + ah2o ) + erel = ( ah2 - ah1 ) / ah2 + if (abs( erel ).ge.eps) then ah1 = ah2 - else + else exit iflag - endif -ENDDO iflag + endif + ENDDO iflag END SUBROUTINE CARCHM_SOLVE - diff --git a/hamocc/carchm_solve_DICsat.F90 b/hamocc/carchm_solve_DICsat.F90 index 895017bf..223fe11f 100644 --- a/hamocc/carchm_solve_DICsat.F90 +++ b/hamocc/carchm_solve_DICsat.F90 @@ -3,121 +3,117 @@ ! 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 carchm_solve_DICsat(saln,pco2,ta,sit,pt, & - Kh,K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p, & - tc_sat,niter) -!********************************************************************** -! -!**** *CARCHM_SOLVE_DICsat* - . -! -! J. Tjiputra, *BCCR, Bergen* 25.01.17 -! -! Modified -! -------- -! -! Purpose -! ------- -! Solve DICsat from TALK and pCO2. -! -! Method -! ------- -! -! -!**** Parameter list: -! --------------- -! *REAL* *saln* - salinity [psu]. -! *REAL* *pco2* - partial pressure of CO2 [ppm]. -! *REAL* *ta* - total alkalinity [eq/kg]. -! *REAL* *sit* - silicate concentration [mol/kg]. -! *REAL* *pt* - phosphate concentration [mol/kg]. -! *REAL* *Kh* - equilibrium constant K0 = [H2CO3]/pCO2. -! *REAL* *K1* - equilibrium constant K1 = [H][HCO3]/[H2CO3]. -! *REAL* *K2* - equilibrium constant K2 = [H][CO3]/[HCO3]. -! *REAL* *Kb* - equilibrium constant Kb = [H][BO2]/[HBO2]. -! *REAL* *Kw* - equilibrium constant Kw = [H][OH]. -! *REAL* *Ks1* - equilibrium constant Ks1 = [H][SO4]/[HSO4]. -! *REAL* *Kf* - equilibrium constant Kf = [H][F]/[HF]. -! *REAL* *Ksi* - equilibrium constant Ksi = [H][SiO(OH)3]/[Si(OH)4]. -! *REAL* *K1p* - equilibrium constant K1p = [H][H2PO4]/[H3PO4]. -! *REAL* *K2p* - equilibrium constant K2p = [H][HPO4]/[H2PO4]. -! *REAL* *K3p* - equilibrium constant K3p = [H][PO4]/[HPO4]. -! *REAL* *tc_sat* - saturated total DIC concentration [mol/kg]. -! *INTEGER* *niter* - maximum number of iteration -! -! Externals -! --------- -! none. -! -!********************************************************************** + Kh,K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p, & + tc_sat,niter) + !********************************************************************** + ! + !**** *CARCHM_SOLVE_DICsat* - . + ! + ! J. Tjiputra, *BCCR, Bergen* 25.01.17 + ! + ! Modified + ! -------- + ! + ! Purpose + ! ------- + ! Solve DICsat from TALK and pCO2. + ! + ! Method + ! ------- + ! + ! + !**** Parameter list: + ! --------------- + ! *REAL* *saln* - salinity [psu]. + ! *REAL* *pco2* - partial pressure of CO2 [ppm]. + ! *REAL* *ta* - total alkalinity [eq/kg]. + ! *REAL* *sit* - silicate concentration [mol/kg]. + ! *REAL* *pt* - phosphate concentration [mol/kg]. + ! *REAL* *Kh* - equilibrium constant K0 = [H2CO3]/pCO2. + ! *REAL* *K1* - equilibrium constant K1 = [H][HCO3]/[H2CO3]. + ! *REAL* *K2* - equilibrium constant K2 = [H][CO3]/[HCO3]. + ! *REAL* *Kb* - equilibrium constant Kb = [H][BO2]/[HBO2]. + ! *REAL* *Kw* - equilibrium constant Kw = [H][OH]. + ! *REAL* *Ks1* - equilibrium constant Ks1 = [H][SO4]/[HSO4]. + ! *REAL* *Kf* - equilibrium constant Kf = [H][F]/[HF]. + ! *REAL* *Ksi* - equilibrium constant Ksi = [H][SiO(OH)3]/[Si(OH)4]. + ! *REAL* *K1p* - equilibrium constant K1p = [H][H2PO4]/[H3PO4]. + ! *REAL* *K2p* - equilibrium constant K2p = [H][HPO4]/[H2PO4]. + ! *REAL* *K3p* - equilibrium constant K3p = [H][PO4]/[HPO4]. + ! *REAL* *tc_sat* - saturated total DIC concentration [mol/kg]. + ! *INTEGER* *niter* - maximum number of iteration + ! + ! Externals + ! --------- + ! none. + ! + !********************************************************************** -use mo_chemcon, only: bor1,bor2,salchl + use mo_chemcon, only: bor1,bor2,salchl -IMPLICIT NONE -REAL, INTENT(IN) :: saln,pco2,ta,sit,pt -REAL, INTENT(IN) :: Kh,K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p -REAL, INTENT(OUT) :: tc_sat -INTEGER, INTENT(IN) :: niter - -! Parameters to set accuracy of iteration -REAL, PARAMETER :: eps=5.e-5 + IMPLICIT NONE + REAL, INTENT(IN) :: saln,pco2,ta,sit,pt + REAL, INTENT(IN) :: Kh,K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p + REAL, INTENT(OUT) :: tc_sat + INTEGER, INTENT(IN) :: niter -! Local varibles -INTEGER :: jit -REAL :: s,scl,borat,sti,ft -REAL :: hso4,hf,hsi,hpo4,ab,aw,ah2o,ah2,erel -REAL :: dic_h2co3,dic_hco3,dic_co3,ah1,ac + ! Parameters to set accuracy of iteration + REAL, PARAMETER :: eps=5.e-5 + ! Local varibles + INTEGER :: jit + REAL :: s,scl,borat,sti,ft + REAL :: hso4,hf,hsi,hpo4,ab,aw,ah2o,ah2,erel + REAL :: dic_h2co3,dic_hco3,dic_co3,ah1,ac -! Calculate concentrations for borate, sulfate, and fluoride; see Dickson, A.G., -! Sabine, C.L. and Christian, J.R. (Eds.) 2007. Guide to best practices -! for ocean CO2 measurements. PICES Special Publication 3, chapter 5 p. 10 -s = MAX(25.,saln) -scl = s * salchl -borat = bor1 * scl * bor2 ! Uppstrom (1974) -sti = 0.14 * scl / 96.062 ! Morris & Riley (1966) -ft = 0.000067 * scl / 18.9984 ! Riley (1965) -ah1=1.e-8 -dic_h2co3 = Kh * pco2 * 1e-6 -iflag: DO jit = 1,niter - hso4 = sti / ( 1. + Ks1 / ( ah1 / ( 1. + sti / Ks1 ) ) ) - hf = 1. / ( 1. + Kf / ah1 ) - hsi = 1./ ( 1. + ah1 / Ksi ) - hpo4 = ( K1p * K2p * ( ah1 + 2. * K3p ) - ah1**3 ) / & - ( ah1**3 + K1p * ah1**2 + K1p * K2p * ah1 + K1p * K2p * K3p ) - ab = borat / ( 1. + ah1 / Kb ) - aw = Kw / ah1 - ah1 / ( 1. + sti / Ks1 ) - ac = ta + hso4 - sit * hsi - ab - aw + ft * hf - pt * hpo4 - ah2o = SQRT((K1*dic_h2co3)**2 + 4.*ac*2.*K1*k2*dic_h2co3) - ah2 = (K1*dic_h2co3 + ah2o)/(2.*ac) - erel = ( ah2 - ah1 ) / ah2 - if (abs( erel ).ge.eps) then + ! Calculate concentrations for borate, sulfate, and fluoride; see Dickson, A.G., + ! Sabine, C.L. and Christian, J.R. (Eds.) 2007. Guide to best practices + ! for ocean CO2 measurements. PICES Special Publication 3, chapter 5 p. 10 + s = MAX(25.,saln) + scl = s * salchl + borat = bor1 * scl * bor2 ! Uppstrom (1974) + sti = 0.14 * scl / 96.062 ! Morris & Riley (1966) + ft = 0.000067 * scl / 18.9984 ! Riley (1965) + ah1=1.e-8 + dic_h2co3 = Kh * pco2 * 1e-6 + + iflag: DO jit = 1,niter + hso4 = sti / ( 1. + Ks1 / ( ah1 / ( 1. + sti / Ks1 ) ) ) + hf = 1. / ( 1. + Kf / ah1 ) + hsi = 1./ ( 1. + ah1 / Ksi ) + hpo4 = ( K1p * K2p * ( ah1 + 2. * K3p ) - ah1**3 ) / & + ( ah1**3 + K1p * ah1**2 + K1p * K2p * ah1 + K1p * K2p * K3p ) + ab = borat / ( 1. + ah1 / Kb ) + aw = Kw / ah1 - ah1 / ( 1. + sti / Ks1 ) + ac = ta + hso4 - sit * hsi - ab - aw + ft * hf - pt * hpo4 + ah2o = SQRT((K1*dic_h2co3)**2 + 4.*ac*2.*K1*k2*dic_h2co3) + ah2 = (K1*dic_h2co3 + ah2o)/(2.*ac) + erel = ( ah2 - ah1 ) / ah2 + if (abs( erel ).ge.eps) then ah1 = ah2 - else + else exit iflag - endif -ENDDO iflag + endif + ENDDO iflag -dic_hco3 = Kh * K1 * pco2 * 1e-6 / ah1 -dic_co3 = Kh * K1 * K2 * pco2 * 1e-6 / ah1**2 -tc_sat = dic_h2co3 + dic_hco3 + dic_co3 + dic_hco3 = Kh * K1 * pco2 * 1e-6 / ah1 + dic_co3 = Kh * K1 * K2 * pco2 * 1e-6 / ah1**2 + tc_sat = dic_h2co3 + dic_hco3 + dic_co3 END SUBROUTINE carchm_solve_DICsat - - - - diff --git a/hamocc/cyano.F90 b/hamocc/cyano.F90 index ad2295bc..fc98f98e 100644 --- a/hamocc/cyano.F90 +++ b/hamocc/cyano.F90 @@ -4,62 +4,62 @@ ! 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 CYANO(kpie,kpje,kpke,kbnd,pddpo,omask,ptho) -!********************************************************************** -! -!**** *CYANO* - . -! -! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 -! -! Modified -! -------- -! S.Legutke, *MPI-MaD, HH* 10.04.01 -! - included : surface reduction of gaseous nitrogen -! -! I.Kriest, *GEOMAR, Kiel* 2016-08-11 -! - included T-dependence of cyanobacteria growth -! - modified oxygen stoichiometry for N2-Fixation -! -! J.Schwinger, *Uni Research, Bergen* 2018-04-12 -! - moved accumulation of all output fields to seperate subroutine, -! related code-restructuring -! - added reduction of alkalinity through N-fixation -! -! Purpose -! ------- -! Nitrogen-fixation by cyano bacteria, followed by remineralisation -! and nitrification -! -! Method: -! ------ -! -! -!** Interface to ocean model (parameter list): -! ----------------------------------------- -! -! *INTEGER* *kpie* - 1st dimension of model grid. -! *INTEGER* *kpje* - 2nd dimension of model grid. -! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. -! *INTEGER* *kbnd* - nb of halo grid points -! *REAL* *ptho* - potential temperature. -! -! Externals -! --------- -! . -!********************************************************************** + !********************************************************************** + ! + !**** *CYANO* - . + ! + ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 + ! + ! Modified + ! -------- + ! S.Legutke, *MPI-MaD, HH* 10.04.01 + ! - included : surface reduction of gaseous nitrogen + ! + ! I.Kriest, *GEOMAR, Kiel* 2016-08-11 + ! - included T-dependence of cyanobacteria growth + ! - modified oxygen stoichiometry for N2-Fixation + ! + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - moved accumulation of all output fields to seperate subroutine, + ! related code-restructuring + ! - added reduction of alkalinity through N-fixation + ! + ! Purpose + ! ------- + ! Nitrogen-fixation by cyano bacteria, followed by remineralisation + ! and nitrification + ! + ! Method: + ! ------ + ! + ! + !** Interface to ocean model (parameter list): + ! ----------------------------------------- + ! + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. + ! *INTEGER* *kbnd* - nb of halo grid points + ! *REAL* *ptho* - potential temperature. + ! + ! Externals + ! --------- + ! . + !********************************************************************** use mo_vgrid, only: kmle use mo_carbch, only: ocetra @@ -82,47 +82,47 @@ SUBROUTINE CYANO(kpie,kpje,kpke,kbnd,pddpo,omask,ptho) intnfix(:,:)=0.0 -! -! N-fixation by cyano bacteria (followed by remineralisation and nitrification), -! it is assumed here that this process is limited to the mixed layer -! + ! + ! N-fixation by cyano bacteria (followed by remineralisation and nitrification), + ! it is assumed here that this process is limited to the mixed layer + ! DO j=1,kpje - DO i=1,kpie - IF(omask(i,j).gt.0.5) THEN - DO k=1,kmle(i,j) - IF(ocetra(i,j,k,iano3).LT.(rnit*ocetra(i,j,k,iphosph))) THEN + DO i=1,kpie + IF(omask(i,j).gt.0.5) THEN + DO k=1,kmle(i,j) + IF(ocetra(i,j,k,iano3).LT.(rnit*ocetra(i,j,k,iphosph))) THEN - oldocetra = ocetra(i,j,k,iano3) - ttemp = min(40.,max(-3.,ptho(i,j,k))) + oldocetra = ocetra(i,j,k,iano3) + ttemp = min(40.,max(-3.,ptho(i,j,k))) -! Temperature dependence of nitrogen fixation, Kriest and Oschlies 2015. - nfixtfac = MAX(0.0,tf2*ttemp*ttemp + tf1*ttemp + tf0)/tff + ! Temperature dependence of nitrogen fixation, Kriest and Oschlies 2015. + nfixtfac = MAX(0.0,tf2*ttemp*ttemp + tf1*ttemp + tf0)/tff - ocetra(i,j,k,iano3)=ocetra(i,j,k,iano3)*(1-bluefix*nfixtfac) & - & + bluefix*nfixtfac*rnit*ocetra(i,j,k,iphosph) + ocetra(i,j,k,iano3)=ocetra(i,j,k,iano3)*(1-bluefix*nfixtfac) & + & + bluefix*nfixtfac*rnit*ocetra(i,j,k,iphosph) - dano3=ocetra(i,j,k,iano3)-oldocetra + dano3=ocetra(i,j,k,iano3)-oldocetra - ocetra(i,j,k,igasnit)=ocetra(i,j,k,igasnit)-dano3*(1./2.) + ocetra(i,j,k,igasnit)=ocetra(i,j,k,igasnit)-dano3*(1./2.) -! Note: to fix one mole N2 requires: N2+H2O+y*O2 = 2* HNO3 <-> y=2.5 mole O2. -! I.e., to release one mole HNO3 = H+ + NO3- requires 1.25 mole O2 - ocetra(i,j,k,ioxygen)=ocetra(i,j,k,ioxygen)-dano3*1.25 + ! Note: to fix one mole N2 requires: N2+H2O+y*O2 = 2* HNO3 <-> y=2.5 mole O2. + ! I.e., to release one mole HNO3 = H+ + NO3- requires 1.25 mole O2 + ocetra(i,j,k,ioxygen)=ocetra(i,j,k,ioxygen)-dano3*1.25 -! 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 - if (use_natDIC) then - ocetra(i,j,k,inatalkali)=ocetra(i,j,k,inatalkali)-dano3 - endif + ! 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 + if (use_natDIC) then + ocetra(i,j,k,inatalkali)=ocetra(i,j,k,inatalkali)-dano3 + endif - intnfix(i,j) = intnfix(i,j) + & - & (ocetra(i,j,k,iano3)-oldocetra)*pddpo(i,j,k) + intnfix(i,j) = intnfix(i,j) + & + & (ocetra(i,j,k,iano3)-oldocetra)*pddpo(i,j,k) - ENDIF - ENDDO - ENDIF - ENDDO + ENDIF + ENDDO + ENDIF + ENDDO ENDDO END SUBROUTINE CYANO diff --git a/hamocc/dipowa.F90 b/hamocc/dipowa.F90 index bb2724f1..2a0230fb 100644 --- a/hamocc/dipowa.F90 +++ b/hamocc/dipowa.F90 @@ -4,56 +4,56 @@ ! 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 dipowa(kpie,kpje,kpke,omask,lspin) -!********************************************************************** -! -!**** *DIPOWA* - 'diffusion of pore water' -! vertical diffusion of sediment pore water tracers -! -! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 -! -! Modified -! -------- -! S.Legutke, *MPI-MaD, HH* 10.04.01 -! - all npowtra-1 properties are diffused in 1 go. -! js: not mass conserving check c13/powtra/ocetra -! -! Purpose -! ------- -! calculate vertical diffusion of sediment pore water properties -! and diffusive flux through the ocean/sediment interface. -! integration. -! -! Method -! ------- -! implicit formulation; -! constant diffusion coefficient : 1.e-9 set in ini_sedmnt in mo_sedmnt -! diffusion coefficient : zcoefsu/zcoeflo for upper/lower -! sediment layer boundary. -! -!** Interface. -! ---------- -! -! *CALL* *DIPOWA* -! -! Externals -! --------- -! none. -! -!********************************************************************** + !********************************************************************** + ! + !**** *DIPOWA* - 'diffusion of pore water' + ! vertical diffusion of sediment pore water tracers + ! + ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 + ! + ! Modified + ! -------- + ! S.Legutke, *MPI-MaD, HH* 10.04.01 + ! - all npowtra-1 properties are diffused in 1 go. + ! js: not mass conserving check c13/powtra/ocetra + ! + ! Purpose + ! ------- + ! calculate vertical diffusion of sediment pore water properties + ! and diffusive flux through the ocean/sediment interface. + ! integration. + ! + ! Method + ! ------- + ! implicit formulation; + ! constant diffusion coefficient : 1.e-9 set in ini_sedmnt in mo_sedmnt + ! diffusion coefficient : zcoefsu/zcoeflo for upper/lower + ! sediment layer boundary. + ! + !** Interface. + ! ---------- + ! + ! *CALL* *DIPOWA* + ! + ! Externals + ! --------- + ! none. + ! + !********************************************************************** use mo_carbch, only: ocetra, sedfluxo use mo_sedmnt, only: powtra,porwat,porwah,seddw,zcoefsu,zcoeflo @@ -80,122 +80,122 @@ subroutine dipowa(kpie,kpje,kpke,omask,lspin) real :: aprior ! start value of oceanic tracer in bottom layer -!$OMP PARALLEL DO & -!$OMP&PRIVATE(i,k,iv,l,tredsy,sedb1,aprior,iv_oc) + !$OMP PARALLEL DO & + !$OMP&PRIVATE(i,k,iv,l,tredsy,sedb1,aprior,iv_oc) j_loop: do j=1,kpje - k = 0 - do i = 1,kpie - tredsy(i,k,1) = zcoefsu(i,j,k) - tredsy(i,k,3) = zcoeflo(i,j,k) - tredsy(i,k,2) = bolay(i,j) - tredsy(i,k,1) - tredsy(i,k,3) - ! dz(kbo) - diff upper - diff lower - enddo - - k = 0 - do iv = 1,npowtra ! loop over pore water tracers - iv_oc = map_por2octra(iv) - do i = 1,kpie + k = 0 + do i = 1,kpie + tredsy(i,k,1) = zcoefsu(i,j,k) + tredsy(i,k,3) = zcoeflo(i,j,k) + tredsy(i,k,2) = bolay(i,j) - tredsy(i,k,1) - tredsy(i,k,3) + ! dz(kbo) - diff upper - diff lower + enddo + + k = 0 + do iv = 1,npowtra ! loop over pore water tracers + iv_oc = map_por2octra(iv) + do i = 1,kpie sedb1(i,k,iv) = 0. if (omask(i,j) > 0.5) then - sedb1(i,k,iv) = ocetra(i,j,kbo(i,j),iv_oc) * bolay(i,j) - ! tracer_concentration(kbo) * dz(kbo) + sedb1(i,k,iv) = ocetra(i,j,kbo(i,j),iv_oc) * bolay(i,j) + ! tracer_concentration(kbo) * dz(kbo) endif - enddo - enddo + enddo + enddo - do k = 1,ks - do i = 1,kpie + do k = 1,ks + do i = 1,kpie tredsy(i,k,1) = zcoefsu(i,j,k) tredsy(i,k,3) = zcoeflo(i,j,k) tredsy(i,k,2) = seddw(k)*porwat(i,j,k) -tredsy(i,k,1) -tredsy(i,k,3) - enddo - enddo + enddo + enddo - do iv = 1,npowtra - do k = 1,ks + do iv = 1,npowtra + do k = 1,ks do i = 1,kpie - ! tracer_concentration(k[1:ks]) * porewater fraction(k) * dz(k) - sedb1(i,k,iv) = powtra(i,j,k,iv) * porwat(i,j,k) * seddw(k) + ! tracer_concentration(k[1:ks]) * porewater fraction(k) * dz(k) + sedb1(i,k,iv) = powtra(i,j,k,iv) * porwat(i,j,k) * seddw(k) enddo - enddo - enddo + enddo + enddo - do k = 1,ks - do i = 1,kpie + do k = 1,ks + do i = 1,kpie if (omask(i,j) > 0.5) then - ! this overwrites tredsy(k=0) for k=1 - tredsy(i,k-1,1) = tredsy(i,k,1) / tredsy(i,k-1,2) - ! diff upper / conc (k-1) - tredsy(i,k,2) = tredsy(i,k,2) & - & - tredsy(i,k-1,3) * tredsy(i,k,1) / tredsy(i,k-1,2) - ! concentration - diff lower * diff upper / conc(k-1) + ! this overwrites tredsy(k=0) for k=1 + tredsy(i,k-1,1) = tredsy(i,k,1) / tredsy(i,k-1,2) + ! diff upper / conc (k-1) + tredsy(i,k,2) = tredsy(i,k,2) & + & - tredsy(i,k-1,3) * tredsy(i,k,1) / tredsy(i,k-1,2) + ! concentration - diff lower * diff upper / conc(k-1) endif - enddo - enddo + enddo + enddo -! diffusion from above - do iv = 1,npowtra - do k = 1,ks + ! diffusion from above + do iv = 1,npowtra + do k = 1,ks do i = 1,kpie - sedb1(i,k,iv) = sedb1(i,k,iv) - tredsy(i,k-1,1) * sedb1(i,k-1,iv) + sedb1(i,k,iv) = sedb1(i,k,iv) - tredsy(i,k-1,1) * sedb1(i,k-1,iv) enddo - enddo - enddo + enddo + enddo -! sediment bottom layer - k = ks - do iv = 1,npowtra - do i = 1,kpie + ! sediment bottom layer + k = ks + do iv = 1,npowtra + do i = 1,kpie if (omask(i,j) > 0.5) then - powtra(i,j,k,iv) = sedb1(i,k,iv) / tredsy(i,k,2) + powtra(i,j,k,iv) = sedb1(i,k,iv) / tredsy(i,k,2) endif - enddo - enddo + enddo + enddo -! sediment column - do iv = 1,npowtra - do k = 1,ks-1 + ! sediment column + do iv = 1,npowtra + do k = 1,ks-1 l = ks-k do i = 1,kpie - if (omask(i,j) > 0.5) then - powtra(i,j,l,iv) = ( sedb1(i,l,iv) & - & - tredsy(i,l,3) * powtra(i,j,l+1,iv) ) / tredsy(i,l,2) - endif + if (omask(i,j) > 0.5) then + powtra(i,j,l,iv) = ( sedb1(i,l,iv) & + & - tredsy(i,l,3) * powtra(i,j,l+1,iv) ) / tredsy(i,l,2) + endif enddo - enddo - enddo - - if(.not. lspin) THEN -! sediment ocean interface - do iv = 1, npowtra - iv_oc = map_por2octra(iv) - do i = 1,kpie - l = 0 - if (omask(i,j) > 0.5) then - aprior = ocetra(i,j,kbo(i,j),iv_oc) - ocetra(i,j,kbo(i,j),iv_oc) = & - & ( sedb1(i,l,iv) - tredsy(i,l,3) * powtra(i,j,l+1,iv) ) & - & / tredsy(i,l,2) - - ! diffusive fluxes (positive downward) - sedfluxo(i,j,iv) = sedfluxo(i,j,iv) & - & -(ocetra(i,j,kbo(i,j),iv_oc) - aprior)* bolay(i,j) - if (use_natDIC) then - ! workaround as long as natDIC is not implemented throughout the sediment module + enddo + enddo + + if(.not. lspin) THEN + ! sediment ocean interface + do iv = 1, npowtra + iv_oc = map_por2octra(iv) + do i = 1,kpie + l = 0 + if (omask(i,j) > 0.5) then + aprior = ocetra(i,j,kbo(i,j),iv_oc) + ocetra(i,j,kbo(i,j),iv_oc) = & + & ( sedb1(i,l,iv) - tredsy(i,l,3) * powtra(i,j,l+1,iv) ) & + & / tredsy(i,l,2) + + ! diffusive fluxes (positive downward) + sedfluxo(i,j,iv) = sedfluxo(i,j,iv) & + & -(ocetra(i,j,kbo(i,j),iv_oc) - aprior)* bolay(i,j) + 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 - endif - endif - enddo - enddo + endif + endif + enddo + enddo + + endif ! .not. lspin - endif ! .not. lspin - enddo j_loop end subroutine dipowa diff --git a/hamocc/get_cfc.F90 b/hamocc/get_cfc.F90 index e6747e14..8ed95cb0 100644 --- a/hamocc/get_cfc.F90 +++ b/hamocc/get_cfc.F90 @@ -3,186 +3,186 @@ ! 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 get_cfc(kplyear,atm_cfc11_nh,atm_cfc12_nh,atm_sf6_nh, & +SUBROUTINE get_cfc(kplyear,atm_cfc11_nh,atm_cfc12_nh,atm_sf6_nh, & & atm_cfc11_sh,atm_cfc12_sh,atm_sf6_sh) -! -!********************************************************************** -! -!**** *GET_CFC* - . -! -! Jerry Tjiputra *BCCR* 05.12.2012 -! - use mo_control_bgc, only: io_stdo_bgc - use mod_xc, only: mnproc - - implicit none - - INTEGER :: i,kplyear,start_yr - INTEGER :: yr_dat(105) - REAL :: atm_cfc11_nh,atm_cfc12_nh,atm_sf6_nh, & - & atm_cfc11_sh,atm_cfc12_sh,atm_sf6_sh - REAL :: cfc_11_nh(105),cfc_12_nh(105),sf_6_nh(105), & - & cfc_11_sh(105),cfc_12_sh(105),sf_6_sh(105) - - INTEGER, SAVE :: kplyear_old = 0 - -! ****************************************************************** -! Data from EMil Jeansson (Bullister, 2008; Walker et al. 2000; Maiss and Brenninkmeijer (1998) -! First (last) data represents year 1910.5 (2014.5), Units are all in [ppt] - DATA cfc_11_nh & - & / 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.1, 0.1, 0.1, 0.2, 0.4, 0.7, & - & 1.01, 1.51, 2.21, 3.02, 4.12, 5.33, 6.83, 8.14, 9.45,11.06, & - & 13.27,16.18,19.60,23.72,28.44,33.67,39.40,46.03,53.77,62.41, & - & 72.06, 82.71, 94.87, 108.34, 121.41, & - & 133.97, 145.93, 156.58, 168.34, 176.68, & - & 184.32, 191.46, 199.30, 208.04, 217.99, & - & 229.35, 241.61, 252.86, 259.30, 265.83, & - & 268.24, 268.14, 269.55, 269.65, 268.34, & - & 266.93, 265.73, 264.52, 263.12, 261.71, & - & 260.00, 258.19, 256.18, 253.97, 251.96, & - & 249.55, 247.54, 245.63, 243.61, 241.33, & - & 239.41, 236.60, 235.08, 233.55/ - - DATA cfc_11_sh & - & / 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.1, 0.1, 0.1, 0.2, 0.4, & - & 0.7, 1.01, 1.51, 2.21, 3.02, 4.02, 5.23, 6.53, 7.84, 9.15, & - & 10.85,13.07,15.78,19.20,23.12,27.64,32.66,38.29,44.82,52.26, & - & 60.70, 69.95, 80.40, 92.16, 104.72, & - & 117.09, 129.35, 140.80, 148.74, 159.30, & - & 167.84, 176.08, 184.52, 192.46, 202.01, & - & 211.36, 222.21, 233.27, 242.11, 251.06, & - & 256.68, 260.80, 262.51, 263.72, 263.22, & - & 262.91, 262.01, 261.01, 259.90, 258.29, & - & 256.98, 255.08, 253.27, 251.36, 249.15, & - & 247.34, 245.03, 243.12, 241.07, 239.19, & - & 236.92, 234.60, 233.29, 231.97/ - - DATA cfc_12_nh & - & / 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.1, 0.1, 0.2, 0.3, 0.4, & - & 0.5, 0.7, 0.9, 1.2, 1.7, 2.3, 3.4, 4.8, 6.1, 7.6, & - & 9.2, 11.0, 12.8, 15.0, 17.4, 20.2, 23.4, 26.8, 30.5, 35.0, & - & 40.0, 45.8, 52.5, 60.4, 69.3, 79.2, 90.3,102.8,116.8,132.00, & - & 148.40, 166.10, 185.80, 207.10, 228.20, & - & 248.10, 266.90, 284.30, 306.10, 323.20, & - & 339.60, 353.40, 369.00, 385.70, 403.40, & - & 424.30, 444.00, 465.40, 483.60, 497.70, & - & 506.00, 516.30, 523.20, 528.50, 533.40, & - & 537.30, 540.10, 542.90, 544.40, 545.90, & - & 546.50, 546.70, 546.70, 545.70, 544.90, & - & 543.10, 541.10, 538.60, 536.11, 533.30, & - & 530.67, 527.16, 525.26, 523.36/ - - DATA cfc_12_sh & - & / 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.1, 0.1, 0.2, 0.3, & - & 0.4, 0.5, 0.7, 0.9, 1.2, 1.7, 2.4, 3.4, 4.7, 6.0, & - & 7.4, 9.0, 10.7, 12.6, 14.7, 17.1, 19.9, 23.0, 26.3, 30.1, & - & 34.4, 39.4, 45.1, 51.8, 59.5, 68.2, 77.9, 88.8,101.1,114.7, & - & 129.6,145.7,163.3,182.5,202.9,223.2,242.7,261.2,273.5,292.3, & - & 308.8,325.5,342.6,359.4,378.2,396.5,416.3,435.8,454.4,472.7, & - & 487.3,498.3,507.0,514.8,521.0,526.5,530.8,534.3,537.2,539.0, & - & 540.6, 541.3, 541.6, 541.5, 540.7, & - & 539.8, 538.1, 536.2, 533.53, 530.94, & - & 528.47, 525.88, 523.48, 521.08/ - - DATA sf_6_nh & - & / 0.00, & - & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & - & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & - & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & - & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & - & 0.000, 0.000, 0.042, 0.043, 0.043, & - & 0.044, 0.046, 0.048, 0.051, 0.055, & - & 0.061, 0.068, 0.078, 0.091, 0.109, & - & 0.131, 0.155, 0.181, 0.207, 0.235, & - & 0.266, 0.301, 0.341, 0.386, 0.438, & - & 0.501, 0.579, 0.665, 0.766, 0.887, & - & 1.011, 1.141, 1.273, 1.409, 1.562, & - & 1.722, 1.892, 2.063, 2.237, 2.427, & - & 2.640, 2.868, 3.104, 3.350, 3.600, & - & 3.861, 4.080, 4.262, 4.485, 4.690, & - & 4.909, 5.135, 5.360, 5.580, 5.795, & - & 6.034, 6.324, 6.613, 6.876, 7.191, & - & 7.439, 7.715, 8.066, 8.417/ - - DATA sf_6_sh & - & / 0.00, & - & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & - & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & - & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & - & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & - & 0.000, 0.000, 0.039, 0.039, 0.040, & - & 0.041, 0.042, 0.044, 0.047, 0.051, & - & 0.056, 0.062, 0.071, 0.084, 0.100, & - & 0.120, 0.142, 0.166, 0.190, 0.215, & - & 0.243, 0.276, 0.312, 0.354, 0.401, & - & 0.459, 0.531, 0.610, 0.703, 0.813, & - & 0.927, 1.046, 1.167, 1.292, 1.432, & - & 1.579, 1.735, 1.892, 2.051, 2.225, & - & 2.420, 2.629, 2.846, 3.071, 3.300, & - & 3.560, 3.824, 4.026, 4.262, 4.471, & - & 4.657, 4.887, 5.081, 5.305, 5.513, & - & 5.749, 6.028, 6.286, 6.576, 6.856, & - & 7.159, 7.424, 7.754, 8.084/ - - start_yr=1910 - do i=1,105 - yr_dat(i)=start_yr+i-1 - enddo - -! ****************************************************************** - !if (kplyear.lt.start_yr) then - atm_cfc11_nh=0.0 - atm_cfc11_sh=0.0 - atm_cfc12_nh=0.0 - atm_cfc12_sh=0.0 - atm_sf6_nh=0.0 - atm_sf6_sh=0.0 - - do i=1,105 - if (kplyear.eq.yr_dat(i)) then - atm_cfc11_nh=cfc_11_nh(i) - atm_cfc11_sh=cfc_11_sh(i) - atm_cfc12_nh=cfc_12_nh(i) - atm_cfc12_sh=cfc_12_sh(i) - atm_sf6_nh=sf_6_nh(i) - atm_sf6_sh=sf_6_sh(i) - endif - enddo - - IF (mnproc.EQ.1 .AND. kplyear.GT.kplyear_old) THEN - write(io_stdo_bgc,*) 'ATM NH CFC11, CFC12, SF6=', & - & kplyear,atm_cfc11_nh,atm_cfc12_nh,atm_sf6_nh - write(io_stdo_bgc,*) 'ATM SH CFC11, CFC12, SF6=', & - & kplyear,atm_cfc11_sh,atm_cfc12_sh,atm_sf6_sh - kplyear_old = kplyear - ENDIF - - RETURN - END + ! + !********************************************************************** + ! + !**** *GET_CFC* - . + ! + ! Jerry Tjiputra *BCCR* 05.12.2012 + ! + use mo_control_bgc, only: io_stdo_bgc + use mod_xc, only: mnproc + + implicit none + + INTEGER :: i,kplyear,start_yr + INTEGER :: yr_dat(105) + REAL :: atm_cfc11_nh,atm_cfc12_nh,atm_sf6_nh, & + & atm_cfc11_sh,atm_cfc12_sh,atm_sf6_sh + REAL :: cfc_11_nh(105),cfc_12_nh(105),sf_6_nh(105), & + & cfc_11_sh(105),cfc_12_sh(105),sf_6_sh(105) + + INTEGER, SAVE :: kplyear_old = 0 + + ! ****************************************************************** + ! Data from EMil Jeansson (Bullister, 2008; Walker et al. 2000; Maiss and Brenninkmeijer (1998) + ! First (last) data represents year 1910.5 (2014.5), Units are all in [ppt] + DATA cfc_11_nh & + & / 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.1, 0.1, 0.1, 0.2, 0.4, 0.7, & + & 1.01, 1.51, 2.21, 3.02, 4.12, 5.33, 6.83, 8.14, 9.45,11.06, & + & 13.27,16.18,19.60,23.72,28.44,33.67,39.40,46.03,53.77,62.41, & + & 72.06, 82.71, 94.87, 108.34, 121.41, & + & 133.97, 145.93, 156.58, 168.34, 176.68, & + & 184.32, 191.46, 199.30, 208.04, 217.99, & + & 229.35, 241.61, 252.86, 259.30, 265.83, & + & 268.24, 268.14, 269.55, 269.65, 268.34, & + & 266.93, 265.73, 264.52, 263.12, 261.71, & + & 260.00, 258.19, 256.18, 253.97, 251.96, & + & 249.55, 247.54, 245.63, 243.61, 241.33, & + & 239.41, 236.60, 235.08, 233.55/ + + DATA cfc_11_sh & + & / 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.1, 0.1, 0.1, 0.2, 0.4, & + & 0.7, 1.01, 1.51, 2.21, 3.02, 4.02, 5.23, 6.53, 7.84, 9.15, & + & 10.85,13.07,15.78,19.20,23.12,27.64,32.66,38.29,44.82,52.26, & + & 60.70, 69.95, 80.40, 92.16, 104.72, & + & 117.09, 129.35, 140.80, 148.74, 159.30, & + & 167.84, 176.08, 184.52, 192.46, 202.01, & + & 211.36, 222.21, 233.27, 242.11, 251.06, & + & 256.68, 260.80, 262.51, 263.72, 263.22, & + & 262.91, 262.01, 261.01, 259.90, 258.29, & + & 256.98, 255.08, 253.27, 251.36, 249.15, & + & 247.34, 245.03, 243.12, 241.07, 239.19, & + & 236.92, 234.60, 233.29, 231.97/ + + DATA cfc_12_nh & + & / 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.1, 0.1, 0.2, 0.3, 0.4, & + & 0.5, 0.7, 0.9, 1.2, 1.7, 2.3, 3.4, 4.8, 6.1, 7.6, & + & 9.2, 11.0, 12.8, 15.0, 17.4, 20.2, 23.4, 26.8, 30.5, 35.0, & + & 40.0, 45.8, 52.5, 60.4, 69.3, 79.2, 90.3,102.8,116.8,132.00, & + & 148.40, 166.10, 185.80, 207.10, 228.20, & + & 248.10, 266.90, 284.30, 306.10, 323.20, & + & 339.60, 353.40, 369.00, 385.70, 403.40, & + & 424.30, 444.00, 465.40, 483.60, 497.70, & + & 506.00, 516.30, 523.20, 528.50, 533.40, & + & 537.30, 540.10, 542.90, 544.40, 545.90, & + & 546.50, 546.70, 546.70, 545.70, 544.90, & + & 543.10, 541.10, 538.60, 536.11, 533.30, & + & 530.67, 527.16, 525.26, 523.36/ + + DATA cfc_12_sh & + & / 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.1, 0.1, 0.2, 0.3, & + & 0.4, 0.5, 0.7, 0.9, 1.2, 1.7, 2.4, 3.4, 4.7, 6.0, & + & 7.4, 9.0, 10.7, 12.6, 14.7, 17.1, 19.9, 23.0, 26.3, 30.1, & + & 34.4, 39.4, 45.1, 51.8, 59.5, 68.2, 77.9, 88.8,101.1,114.7, & + & 129.6,145.7,163.3,182.5,202.9,223.2,242.7,261.2,273.5,292.3, & + & 308.8,325.5,342.6,359.4,378.2,396.5,416.3,435.8,454.4,472.7, & + & 487.3,498.3,507.0,514.8,521.0,526.5,530.8,534.3,537.2,539.0, & + & 540.6, 541.3, 541.6, 541.5, 540.7, & + & 539.8, 538.1, 536.2, 533.53, 530.94, & + & 528.47, 525.88, 523.48, 521.08/ + + DATA sf_6_nh & + & / 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & + & 0.000, 0.000, 0.042, 0.043, 0.043, & + & 0.044, 0.046, 0.048, 0.051, 0.055, & + & 0.061, 0.068, 0.078, 0.091, 0.109, & + & 0.131, 0.155, 0.181, 0.207, 0.235, & + & 0.266, 0.301, 0.341, 0.386, 0.438, & + & 0.501, 0.579, 0.665, 0.766, 0.887, & + & 1.011, 1.141, 1.273, 1.409, 1.562, & + & 1.722, 1.892, 2.063, 2.237, 2.427, & + & 2.640, 2.868, 3.104, 3.350, 3.600, & + & 3.861, 4.080, 4.262, 4.485, 4.690, & + & 4.909, 5.135, 5.360, 5.580, 5.795, & + & 6.034, 6.324, 6.613, 6.876, 7.191, & + & 7.439, 7.715, 8.066, 8.417/ + + DATA sf_6_sh & + & / 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & + & 0.000, 0.000, 0.039, 0.039, 0.040, & + & 0.041, 0.042, 0.044, 0.047, 0.051, & + & 0.056, 0.062, 0.071, 0.084, 0.100, & + & 0.120, 0.142, 0.166, 0.190, 0.215, & + & 0.243, 0.276, 0.312, 0.354, 0.401, & + & 0.459, 0.531, 0.610, 0.703, 0.813, & + & 0.927, 1.046, 1.167, 1.292, 1.432, & + & 1.579, 1.735, 1.892, 2.051, 2.225, & + & 2.420, 2.629, 2.846, 3.071, 3.300, & + & 3.560, 3.824, 4.026, 4.262, 4.471, & + & 4.657, 4.887, 5.081, 5.305, 5.513, & + & 5.749, 6.028, 6.286, 6.576, 6.856, & + & 7.159, 7.424, 7.754, 8.084/ + + start_yr=1910 + do i=1,105 + yr_dat(i)=start_yr+i-1 + enddo + + ! ****************************************************************** + !if (kplyear.lt.start_yr) then + atm_cfc11_nh=0.0 + atm_cfc11_sh=0.0 + atm_cfc12_nh=0.0 + atm_cfc12_sh=0.0 + atm_sf6_nh=0.0 + atm_sf6_sh=0.0 + + do i=1,105 + if (kplyear.eq.yr_dat(i)) then + atm_cfc11_nh=cfc_11_nh(i) + atm_cfc11_sh=cfc_11_sh(i) + atm_cfc12_nh=cfc_12_nh(i) + atm_cfc12_sh=cfc_12_sh(i) + atm_sf6_nh=sf_6_nh(i) + atm_sf6_sh=sf_6_sh(i) + endif + enddo + + IF (mnproc.EQ.1 .AND. kplyear.GT.kplyear_old) THEN + write(io_stdo_bgc,*) 'ATM NH CFC11, CFC12, SF6=', & + & kplyear,atm_cfc11_nh,atm_cfc12_nh,atm_sf6_nh + write(io_stdo_bgc,*) 'ATM SH CFC11, CFC12, SF6=', & + & kplyear,atm_cfc11_sh,atm_cfc12_sh,atm_sf6_sh + kplyear_old = kplyear + ENDIF + + RETURN +END SUBROUTINE get_cfc diff --git a/hamocc/hamocc4bcm.F90 b/hamocc/hamocc4bcm.F90 index 32ee073c..d2b7e04d 100644 --- a/hamocc/hamocc4bcm.F90 +++ b/hamocc/hamocc4bcm.F90 @@ -4,419 +4,419 @@ ! 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 HAMOCC4BCM(kpie,kpje,kpke,kbnd,kplyear,kplmon,kplday,kldtday,& - pdlxp,pdlyp,pddpo,prho,pglat,omask, & - dust,rivin,ndep,oafx,pi_ph, & - pfswr,psicomo,ppao,pfu10,ptho,psao, & - patmco2,pflxco2,pflxdms,patmbromo,pflxbromo) -!****************************************************************************** -! -! HAMOCC4BGC - main routine of iHAMOCC. -! -! Modified -! -------- -! J.Schwinger *GFI, Bergen* 2013-10-21 -! - added GNEWS2 option for riverine input of carbon and nutrients -! - code cleanup -! -! J.Schwinger *GFI, Bergen* 2014-05-21 -! - moved copying of tracer field to ocetra to micom2hamocc -! and hamocc2micom -! -! J.Schwinger, *Uni Research, Bergen* 2018-04-12 -! - moved accumulation of all output fields to seperate subroutine, -! related code-restructuring -! - added sediment bypass preprocessor option -! -! J.Schwinger, *NORCE Climate, Bergen* 2020-05-28 -! - restructuring of iHAMOCC code, cleanup parameter list -! - boundary conditions (dust, riverinput, N-deposition) are now passed as -! an argument -! -! Parameter list: -! --------------- -! -! *INTEGER* *kpie* - 1st dimension of model grid. -! *INTEGER* *kpje* - 2nd dimension of model grid. -! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. -! *INTEGER* *kbnd* - nb of halo grid points. -! *INTEGER* *kplyear* - current year. -! *INTEGER* *kplmon* - current month. -! *INTEGER* *kplday* - current day. -! *INTEGER* *kldtday* - number of time step in current day. -! *REAL* *pdlxp* - size of grid cell (longitudinal) [m]. -! *REAL* *pdlyp* - size of grid cell (latitudinal) [m]. -! *REAL* *pddpo* - size of grid cell (depth) [m]. -! *REAL* *prho* - density [kg/m^3]. -! *REAL* *pglat* - latitude of grid cells [deg north]. -! *REAL* *omask* - land/ocean mask. -! *REAL* *dust* - dust deposition flux [kg/m2/month]. -! *REAL* *rivin* - riverine input [kmol m-2 yr-1]. -! *REAL* *ndep* - nitrogen deposition [kmol m-2 yr-1]. -! *REAL* *oaflx* - alkalinity flux from alkalinization [kmol m-2 yr-1] -! *REAL* *pfswr* - solar radiation [W/m**2]. -! *REAL* *psicomo* - sea ice concentration -! *REAL* *ppao* - sea level pressure [Pascal]. -! *REAL* *pfu10* - absolute wind speed at 10m height [m/s] -! *REAL* *ptho* - potential temperature [deg C]. -! *REAL* *psao* - salinity [psu.]. -! *REAL* *patmco2* - atmospheric CO2 concentration [ppm] used in -! fully coupled mode (prognostic/diagnostic CO2). -! *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. -! -!****************************************************************************** - use mod_xc, only: mnproc - 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_BROMO, use_CFC, use_PBGC_CK_TIMESTEP,& - use_BOXATM, use_sedbypass,ocn_co2_type - 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 - use mo_boxatm, only: update_boxatm - - implicit none - - INTEGER, intent(in) :: kpie,kpje,kpke,kbnd - INTEGER, intent(in) :: kplyear,kplmon,kplday,kldtday - REAL, intent(in) :: pdlxp (kpie,kpje) - REAL, intent(in) :: pdlyp (kpie,kpje) - REAL, intent(in) :: pddpo (kpie,kpje,kpke) - REAL, intent(in) :: prho (kpie,kpje,kpke) - REAL, intent(in) :: pglat (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - REAL, intent(in) :: omask (kpie,kpje) - REAL, intent(in) :: dust (kpie,kpje) - REAL, intent(in) :: rivin (kpie,kpje,nriv) - REAL, intent(in) :: ndep (kpie,kpje) - REAL, intent(in) :: oafx (kpie,kpje) - REAL, intent(in) :: pi_ph (kpie,kpje) - REAL, intent(in) :: pfswr (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - REAL, intent(in) :: psicomo(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - REAL, intent(in) :: ppao (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - REAL, intent(in) :: pfu10 (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - REAL, intent(in) :: ptho (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) - 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(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 - LOGICAL :: lspin - - IF (mnproc.eq.1) THEN - write(io_stdo_bgc,*) 'iHAMOCC',KLDTDAY,LDTRUNBGC,NDTDAYBGC - ENDIF - - -!-------------------------------------------------------------------- -! Increment bgc time step counter of run (initialized in HAMOCC_INIT). -! - ldtrunbgc = ldtrunbgc + 1 - - -!-------------------------------------------------------------------- -! Increment bgc time step counter of experiment. -! - ldtbgc = ldtbgc + 1 - - -!-------------------------------------------------------------------- -! Calculate variables related to the vertical grid -! - call set_vgrid(kpie,kpje,kpke,pddpo) - - -!-------------------------------------------------------------------- -! Pass net solar radiation -! -!$OMP PARALLEL DO PRIVATE(i) - DO j=1,kpje +SUBROUTINE HAMOCC4BCM(kpie,kpje,kpke,kbnd,kplyear,kplmon,kplday,kldtday,& + pdlxp,pdlyp,pddpo,prho,pglat,omask, & + dust,rivin,ndep,oafx,pi_ph, & + pfswr,psicomo,ppao,pfu10,ptho,psao, & + patmco2,pflxco2,pflxdms,patmbromo,pflxbromo) + !****************************************************************************** + ! + ! HAMOCC4BGC - main routine of iHAMOCC. + ! + ! Modified + ! -------- + ! J.Schwinger *GFI, Bergen* 2013-10-21 + ! - added GNEWS2 option for riverine input of carbon and nutrients + ! - code cleanup + ! + ! J.Schwinger *GFI, Bergen* 2014-05-21 + ! - moved copying of tracer field to ocetra to micom2hamocc + ! and hamocc2micom + ! + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - moved accumulation of all output fields to seperate subroutine, + ! related code-restructuring + ! - added sediment bypass preprocessor option + ! + ! J.Schwinger, *NORCE Climate, Bergen* 2020-05-28 + ! - restructuring of iHAMOCC code, cleanup parameter list + ! - boundary conditions (dust, riverinput, N-deposition) are now passed as + ! an argument + ! + ! Parameter list: + ! --------------- + ! + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. + ! *INTEGER* *kbnd* - nb of halo grid points. + ! *INTEGER* *kplyear* - current year. + ! *INTEGER* *kplmon* - current month. + ! *INTEGER* *kplday* - current day. + ! *INTEGER* *kldtday* - number of time step in current day. + ! *REAL* *pdlxp* - size of grid cell (longitudinal) [m]. + ! *REAL* *pdlyp* - size of grid cell (latitudinal) [m]. + ! *REAL* *pddpo* - size of grid cell (depth) [m]. + ! *REAL* *prho* - density [kg/m^3]. + ! *REAL* *pglat* - latitude of grid cells [deg north]. + ! *REAL* *omask* - land/ocean mask. + ! *REAL* *dust* - dust deposition flux [kg/m2/month]. + ! *REAL* *rivin* - riverine input [kmol m-2 yr-1]. + ! *REAL* *ndep* - nitrogen deposition [kmol m-2 yr-1]. + ! *REAL* *oaflx* - alkalinity flux from alkalinization [kmol m-2 yr-1] + ! *REAL* *pfswr* - solar radiation [W/m**2]. + ! *REAL* *psicomo* - sea ice concentration + ! *REAL* *ppao* - sea level pressure [Pascal]. + ! *REAL* *pfu10* - absolute wind speed at 10m height [m/s] + ! *REAL* *ptho* - potential temperature [deg C]. + ! *REAL* *psao* - salinity [psu.]. + ! *REAL* *patmco2* - atmospheric CO2 concentration [ppm] used in + ! fully coupled mode (prognostic/diagnostic CO2). + ! *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. + ! + !****************************************************************************** + use mod_xc, only: mnproc + 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_BROMO, use_CFC, use_PBGC_CK_TIMESTEP,& + use_BOXATM, use_sedbypass,ocn_co2_type + 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 + use mo_boxatm, only: update_boxatm + + implicit none + + INTEGER, intent(in) :: kpie,kpje,kpke,kbnd + INTEGER, intent(in) :: kplyear,kplmon,kplday,kldtday + REAL, intent(in) :: pdlxp (kpie,kpje) + REAL, intent(in) :: pdlyp (kpie,kpje) + REAL, intent(in) :: pddpo (kpie,kpje,kpke) + REAL, intent(in) :: prho (kpie,kpje,kpke) + REAL, intent(in) :: pglat (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) + REAL, intent(in) :: omask (kpie,kpje) + REAL, intent(in) :: dust (kpie,kpje) + REAL, intent(in) :: rivin (kpie,kpje,nriv) + REAL, intent(in) :: ndep (kpie,kpje) + REAL, intent(in) :: oafx (kpie,kpje) + REAL, intent(in) :: pi_ph (kpie,kpje) + REAL, intent(in) :: pfswr (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) + REAL, intent(in) :: psicomo(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) + REAL, intent(in) :: ppao (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) + REAL, intent(in) :: pfu10 (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) + REAL, intent(in) :: ptho (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) + 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(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 + LOGICAL :: lspin + + IF (mnproc.eq.1) THEN + write(io_stdo_bgc,*) 'iHAMOCC',KLDTDAY,LDTRUNBGC,NDTDAYBGC + ENDIF + + + !-------------------------------------------------------------------- + ! Increment bgc time step counter of run (initialized in HAMOCC_INIT). + ! + ldtrunbgc = ldtrunbgc + 1 + + + !-------------------------------------------------------------------- + ! Increment bgc time step counter of experiment. + ! + ldtbgc = ldtbgc + 1 + + + !-------------------------------------------------------------------- + ! Calculate variables related to the vertical grid + ! + call set_vgrid(kpie,kpje,kpke,pddpo) + + + !-------------------------------------------------------------------- + ! Pass net solar radiation + ! + !$OMP PARALLEL DO PRIVATE(i) + DO j=1,kpje + DO i=1,kpie + strahl(i,j)=pfswr(i,j) + ENDDO + ENDDO + !$OMP END PARALLEL DO + + + !-------------------------------------------------------------------- + ! Pass atmospheric co2 if coupled to an active atmosphere model + ! + if (trim(ocn_co2_type) == 'diagnostic' .or. trim(ocn_co2_type) == 'prognostic') then + !$OMP PARALLEL DO PRIVATE(i) + DO j=1,kpje DO i=1,kpie - strahl(i,j)=pfswr(i,j) + 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 + + 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 -!$OMP END PARALLEL DO - - -!-------------------------------------------------------------------- -! Pass atmospheric co2 if coupled to an active atmosphere model -! - if (trim(ocn_co2_type) == 'diagnostic' .or. trim(ocn_co2_type) == 'prognostic') 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' - endif - - 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' - endif - -!-------------------------------------------------------------------- -! Read atmospheric cfc concentrations -! - 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) - 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) - endif - - -!--------------------------------------------------------------------- -! Biogeochemistry -! - ! Apply dust (iron) deposition - ! This routine should be moved to the other routines that handle - ! external inputs below for consistency. For now we keep it here - ! to maintain bit-for-bit reproducibility with the CMIP6 version of - ! the model - CALL apply_fedep(kpie,kpje,kpke,pddpo,omask,dust) - - CALL OCPROD(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) - - 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) - endif - - - do l=1,nocetra - do K=1,kpke -!$OMP PARALLEL DO PRIVATE(i) + ENDDO + !$OMP END PARALLEL DO + if (mnproc.eq.1) write (io_stdo_bgc,*) 'iHAMOCC: getting bromoform from atm' + endif + + !-------------------------------------------------------------------- + ! Read atmospheric cfc concentrations + ! + 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) + 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) + endif + + + !--------------------------------------------------------------------- + ! Biogeochemistry + ! + ! Apply dust (iron) deposition + ! This routine should be moved to the other routines that handle + ! external inputs below for consistency. For now we keep it here + ! to maintain bit-for-bit reproducibility with the CMIP6 version of + ! the model + CALL apply_fedep(kpie,kpje,kpke,pddpo,omask,dust) + + CALL OCPROD(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) + + 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) + endif + + + do l=1,nocetra + do K=1,kpke + !$OMP PARALLEL DO PRIVATE(i) do J=1,kpje - do I=1,kpie - if (OMASK(I,J) .gt. 0.5 ) then - OCETRA(I,J,K,L)=MAX(0.,OCETRA(I,J,K,L)) - endif - enddo - enddo -!$OMP END PARALLEL DO + do I=1,kpie + if (OMASK(I,J) .gt. 0.5 ) then + OCETRA(I,J,K,L)=MAX(0.,OCETRA(I,J,K,L)) + endif + enddo enddo - enddo - - 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) - endif - - - CALL CYANO(kpie,kpje,kpke,kbnd,pddpo,omask,ptho) - - 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) - endif - - CALL CARCHM(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,prho,pglat,omask, & - psicomo,ppao,pfu10,ptho,psao) - - 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) - endif - - - ! Apply n-deposition - CALL apply_ndep(kpie,kpje,kpke,pddpo,omask,ndep) - - 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) + !$OMP END PARALLEL DO + enddo + enddo + + 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) + endif + + + CALL CYANO(kpie,kpje,kpke,kbnd,pddpo,omask,ptho) + + 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) + endif + + CALL CARCHM(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,prho,pglat,omask, & + psicomo,ppao,pfu10,ptho,psao) + + 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) + endif + + + ! Apply n-deposition + CALL apply_ndep(kpie,kpje,kpke,pddpo,omask,ndep) + + 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) + endif + + ! Apply riverine input of carbon and nutrients + call apply_rivin(kpie,kpje,kpke,pddpo,omask,rivin) + + 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) + endif + + ! Apply alkalinity flux due to ocean alkalinization + call apply_oafx(kpie,kpje,kpke,pddpo,omask,oafx) + + 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) + endif + + ! Update atmospheric pCO2 [ppm] + if (use_BOXATM) then + CALL update_boxatm(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask) + 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) + endif + + ! update preformed tracers + CALL PREFTRC(kpie,kpje,omask) + + + !-------------------------------------------------------------------- + ! Sediment module + + if (.not. use_sedbypass) then + + ! 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 - ! Apply riverine input of carbon and nutrients - call apply_rivin(kpie,kpje,kpke,pddpo,omask,rivin) + ! Loop for sediment spinup. If deactivated then nspin=1 and lspin=.false. + do it=1,nspin - 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) + 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( itsedspin_yr_e) then - call xchalt('(invalid sediment spinup start/end year)') - stop '(invalid sediment spinup start/end year)' - endif - if(sedspin_ncyc < 2) then - call xchalt('(invalid nb. of sediment spinup subcycles)') - stop '(invalid nb. of sediment spinup subcycles)' - endif - endif + write(io_stdo_bgc,*) + write(io_stdo_bgc,*) 'iHAMOCC: reading namelist BGCNML' + write(io_stdo_bgc,nml=BGCNML) + + if(do_sedspinup) then + if(sedspin_yr_s<0 .or. sedspin_yr_e<0 .or. sedspin_yr_s>sedspin_yr_e) then + call xchalt('(invalid sediment spinup start/end year)') + stop '(invalid sediment spinup start/end year)' + endif + if(sedspin_ncyc < 2) then + call xchalt('(invalid nb. of sediment spinup subcycles)') + stop '(invalid nb. of sediment spinup subcycles)' + endif + endif ENDIF ! init the index-mapping between pore water and ocean tracers @@ -145,23 +145,23 @@ subroutine hamocc_init(read_rest,rstfnm_hamocc) ! --- initialise trc array (two time levels) ! do nt=itrbgc,itrbgc+ntrbgc-1 - do k=1,2*kk - do j=1,jj - do i=1,ii - trc(i,j,k,nt)=0.0 - enddo - enddo - enddo + do k=1,2*kk + do j=1,jj + do i=1,ii + trc(i,j,k,nt)=0.0 + enddo + enddo + enddo enddo ! ! --- initialise HAMOCC land/ocean mask ! do j=1,jj - do l=1,isp(j) - do i=max(1,ifp(j,l)),min(ii,ilp(j,l)) - omask(i,j)=1. - enddo - enddo + do l=1,isp(j) + do i=max(1,ifp(j,l)),min(ii,ilp(j,l)) + omask(i,j)=1. + enddo + enddo enddo ! ! --- BLOM to HAMOCC interface @@ -198,7 +198,7 @@ subroutine hamocc_init(read_rest,rstfnm_hamocc) CALL ini_read_oafx(idm,jdm,bgc_dx,bgc_dy,plat,omask) if (use_BROMO) then - CALL ini_swa_clim(idm,jdm,omask) + CALL ini_swa_clim(idm,jdm,omask) endif call ini_pi_ph(idm,jdm,omask) @@ -209,33 +209,33 @@ subroutine hamocc_init(read_rest,rstfnm_hamocc) ! two-time-level counterpart ! IF(read_rest.eq.1) THEN - CALL AUFR_BGC(idm,jdm,kdm,ntr,ntrbgc,itrbgc,trc, & - & date%year,date%month,date%day,omask,rstfnm_hamocc) + CALL AUFR_BGC(idm,jdm,kdm,ntr,ntrbgc,itrbgc,trc, & + & date%year,date%month,date%day,omask,rstfnm_hamocc) ELSE - trc(1:idm,1:jdm,1:kdm, itrbgc:itrbgc+ntrbgc-1) = & - & ocetra(:,:,:,:) - trc(1:idm,1:jdm,kdm+1:2*kdm,itrbgc:itrbgc+ntrbgc-1) = & - & ocetra(:,:,:,:) - if (.not. use_sedbypass) then - sedlay2(:,:,1:ks,:) = sedlay(:,:,:,:) - sedlay2(:,:,ks+1:2*ks,:) = sedlay(:,:,:,:) - powtra2(:,:,1:ks,:) = powtra(:,:,:,:) - powtra2(:,:,ks+1:2*ks,:) = powtra(:,:,:,:) - burial2(:,:,1,:) = burial(:,:,:) - burial2(:,:,2,:) = burial(:,:,:) - endif - if (use_BOXATM) then - atm2(:,:,1,:) = atm(:,:,:) - atm2(:,:,2,:) = atm(:,:,:) - endif + trc(1:idm,1:jdm,1:kdm, itrbgc:itrbgc+ntrbgc-1) = & + & ocetra(:,:,:,:) + trc(1:idm,1:jdm,kdm+1:2*kdm,itrbgc:itrbgc+ntrbgc-1) = & + & ocetra(:,:,:,:) + if (.not. use_sedbypass) then + sedlay2(:,:,1:ks,:) = sedlay(:,:,:,:) + sedlay2(:,:,ks+1:2*ks,:) = sedlay(:,:,:,:) + powtra2(:,:,1:ks,:) = powtra(:,:,:,:) + powtra2(:,:,ks+1:2*ks,:) = powtra(:,:,:,:) + burial2(:,:,1,:) = burial(:,:,:) + burial2(:,:,2,:) = burial(:,:,:) + endif + if (use_BOXATM) then + atm2(:,:,1,:) = atm(:,:,:) + atm2(:,:,2,:) = atm(:,:,:) + endif ENDIF if (mnproc.eq.1) then - write(io_stdo_bgc,*) - WRITE(io_stdo_bgc,*)'********************************************' - write(io_stdo_bgc,*) 'iHAMOCC: finished initialisation' - write(io_stdo_bgc,*) + write(io_stdo_bgc,*) + WRITE(io_stdo_bgc,*)'********************************************' + write(io_stdo_bgc,*) 'iHAMOCC: finished initialisation' + write(io_stdo_bgc,*) endif -!****************************************************************************** + !****************************************************************************** end subroutine hamocc_init diff --git a/hamocc/hamocc_step.F90 b/hamocc/hamocc_step.F90 index 74e12c8b..465371a1 100644 --- a/hamocc/hamocc_step.F90 +++ b/hamocc/hamocc_step.F90 @@ -17,11 +17,11 @@ subroutine hamocc_step(m,n,mm,nn,k1m,k1n) -! -! --- ------------------------------------------------------------------ -! --- perform one HAMOCC step -! --- ------------------------------------------------------------------ -! + ! + ! --- ------------------------------------------------------------------ + ! --- perform one HAMOCC step + ! --- ------------------------------------------------------------------ + ! use mod_xc, only: idm,jdm,kdm,nbdy use mod_time, only: date,nday_of_year,nstep,nstep_in_day use mod_grid, only: plat @@ -47,7 +47,7 @@ subroutine hamocc_step(m,n,mm,nn,k1m,k1n) integer :: l,ldtday real :: ndep(idm,jdm) real :: dust(idm,jdm) - real :: oafx(idm,jdm) + real :: oafx(idm,jdm) call trc_limitc(nn) @@ -56,12 +56,12 @@ subroutine hamocc_step(m,n,mm,nn,k1m,k1n) ldtday = mod(nstep,nstep_in_day) do l=1,nbgc - bgcwrt(l)=.false. - if (((diagann_bgc(l).and.nday_of_year.eq.1.or.diagmon_bgc(l) & - & .and.date%day.eq.1).and.mod(nstep,nstep_in_day).eq.0).or. & - & .not.(diagann_bgc(l).or.diagmon_bgc(l)).and. & - & mod(nstep+.5,diagfq_bgc(l)).lt.1.) & - & bgcwrt(l)=.true. + bgcwrt(l)=.false. + if (((diagann_bgc(l).and.nday_of_year.eq.1.or.diagmon_bgc(l) & + & .and.date%day.eq.1).and.mod(nstep,nstep_in_day).eq.0).or. & + & .not.(diagann_bgc(l).or.diagmon_bgc(l)).and. & + & mod(nstep+.5,diagfq_bgc(l)).lt.1.) & + & bgcwrt(l)=.true. enddo call get_fedep(idm,jdm,date%month,dust) diff --git a/hamocc/inventory_bgc.F90 b/hamocc/inventory_bgc.F90 index ee0f8b10..4c1b188a 100644 --- a/hamocc/inventory_bgc.F90 +++ b/hamocc/inventory_bgc.F90 @@ -18,56 +18,56 @@ SUBROUTINE INVENTORY_BGC(kpie,kpje,kpke,dlxp,dlyp,ddpo,omask,iogrp) -!******************************************************************* -! -!**** *INVENTORY_BGC* - calculate the BGC inventory. -! -! P.Wetzel, *MPI-Met, HH* 29.07.02 -! -! Modified -! -------- -! T. Torsvik *UiB* 22.02.22 -! Include option for writing inventory to netCDF file. -! -! Purpose -! ------- -! - calculate the BGC inventory. -! -! Method -! ------- -! - -! -!** Interface. -! ---------- -! -! *CALL* *INVENTORY_BGC* -! -! -!** Interface to ocean model (parameter list): -! ----------------------------------------- -! -! -! Externals -! --------- -! none. -! -!********************************************************************** - use mod_xc, only: mnproc,ips,nbdy,xcsum - use mo_carbch, only: atm,atmflx,co3,hi,ndepflx,rivinflx,ocetra,sedfluxo - use mo_sedmnt, only: prcaca,prorca,silpro - use mo_biomod, only: expoor,expoca,exposi - use mo_param_bgc, only: rcar,rnit - use mo_control_bgc, only: do_ndep,do_rivinpt,io_stdo_bgc - use mo_bgcmean, only: bgct2d,jco2flux,jirdin,jn2flux,jn2oflux,jndep,jo2flux,jprcaca,jprorca,jsilpro,nbgcmax,glb_inventory - use mo_param1_bgc, only: ialkali,ian2o,iano3,iatmco2,iatmn2,iatmn2o,iatmo2,icalc,idet,idoc,igasnit,iopal,ioxygen,iphosph, & - & iphy,ipowaic,ipowaox,ipowaph,ipowasi,ipown2,ipowno3,isco212,isilica,isssc12,issso12,issssil,izoo, & - & irdin,irdip,irsi,iralk,irdoc,irdet,nocetra,npowtra,nsedtra,nriv - use mo_vgrid, only: dp_min - - ! NOT sedbypass - use mo_param1_bgc, only: ks - use mo_sedmnt, only: porwat,seddw,sedlay,burial,sedhpl,powtra,porsol - use mo_control_bgc, only: use_PBGC_CK_TIMESTEP,use_BOXATM,use_sedbypass,use_cisonew,use_AGG,use_CFC,use_natDIC,use_BROMO + !******************************************************************* + ! + !**** *INVENTORY_BGC* - calculate the BGC inventory. + ! + ! P.Wetzel, *MPI-Met, HH* 29.07.02 + ! + ! Modified + ! -------- + ! T. Torsvik *UiB* 22.02.22 + ! Include option for writing inventory to netCDF file. + ! + ! Purpose + ! ------- + ! - calculate the BGC inventory. + ! + ! Method + ! ------- + ! - + ! + !** Interface. + ! ---------- + ! + ! *CALL* *INVENTORY_BGC* + ! + ! + !** Interface to ocean model (parameter list): + ! ----------------------------------------- + ! + ! + ! Externals + ! --------- + ! none. + ! + !********************************************************************** + use mod_xc, only: mnproc,ips,nbdy,xcsum + use mo_carbch, only: atm,atmflx,co3,hi,ndepflx,rivinflx,ocetra,sedfluxo + use mo_sedmnt, only: prcaca,prorca,silpro + use mo_biomod, only: expoor,expoca,exposi + use mo_param_bgc, only: rcar,rnit + use mo_control_bgc, only: do_ndep,do_rivinpt,io_stdo_bgc + use mo_bgcmean, only: bgct2d,jco2flux,jirdin,jn2flux,jn2oflux,jndep,jo2flux,jprcaca,jprorca,jsilpro,nbgcmax,glb_inventory + use mo_param1_bgc, only: ialkali,ian2o,iano3,iatmco2,iatmn2,iatmn2o,iatmo2,icalc,idet,idoc,igasnit,iopal,ioxygen,iphosph, & + & iphy,ipowaic,ipowaox,ipowaph,ipowasi,ipown2,ipowno3,isco212,isilica,isssc12,issso12,issssil,izoo, & + & irdin,irdip,irsi,iralk,irdoc,irdet,nocetra,npowtra,nsedtra,nriv + use mo_vgrid, only: dp_min + + ! NOT sedbypass + use mo_param1_bgc, only: ks + use mo_sedmnt, only: porwat,seddw,sedlay,burial,sedhpl,powtra,porsol + use mo_control_bgc, only: use_PBGC_CK_TIMESTEP,use_BOXATM,use_sedbypass,use_cisonew,use_AGG,use_CFC,use_natDIC,use_BROMO implicit none @@ -128,142 +128,142 @@ SUBROUTINE INVENTORY_BGC(kpie,kpje,kpke,dlxp,dlyp,ddpo,omask,iogrp) real :: sum_expoca real :: sum_exposi -!=== aqueous sediment tracer -!---------------------------------------------------------------------- + !=== aqueous sediment tracer + !---------------------------------------------------------------------- if (use_sedbypass) then - zsedtotvol = 0.0 - zpowtratot(:)=0.0 - zpowtratoc(:)=0.0 - zsedlayto(:)=0.0 - zburial(:)=0.0 - zsedhplto=0.0 + zsedtotvol = 0.0 + zpowtratot(:)=0.0 + zpowtratoc(:)=0.0 + zsedlayto(:)=0.0 + zburial(:)=0.0 + zsedhplto=0.0 else - ztmp1(:,:)=0.0 - DO k=1,ks - DO j=1,kpje - DO i=1,kpie - ztmp1(i,j) = ztmp1(i,j) + omask(i,j)*seddw(k) & - & *dlxp(i,j)*dlyp(i,j)*porwat(i,j,k) - ENDDO - ENDDO - ENDDO - - CALL xcsum(zsedtotvol,ztmp1,ips) - - DO l=1,npowtra - ztmp1(:,:)=0.0 - DO k=1,ks - DO j=1,kpje - DO i=1,kpie - vol = seddw(k)*dlxp(i,j)*dlyp(i,j)*porwat(i,j,k) - ztmp1(i,j)= ztmp1(i,j) + omask(i,j)*powtra(i,j,k,l)*vol - ENDDO - ENDDO + ztmp1(:,:)=0.0 + DO k=1,ks + DO j=1,kpje + DO i=1,kpie + ztmp1(i,j) = ztmp1(i,j) + omask(i,j)*seddw(k) & + & *dlxp(i,j)*dlyp(i,j)*porwat(i,j,k) ENDDO + ENDDO + ENDDO + + CALL xcsum(zsedtotvol,ztmp1,ips) - CALL xcsum(zpowtratot(l),ztmp1,ips) - zpowtratoc(l) = zpowtratot(l)/zsedtotvol - ENDDO - - !=== non aqueous sediment tracer - !---------------------------------------------------------------------- - zburial = sum2d_array(burial, nsedtra) - - DO l=1,nsedtra - ztmp1(:,:)=0.0 - DO k=1,ks - DO j=1,kpje - DO i=1,kpie - vol = porsol(i,j,k)*seddw(k)*dlxp(i,j)*dlyp(i,j) - ztmp1(i,j) = ztmp1(i,j) + omask(i,j)*sedlay(i,j,k,l)*vol - ENDDO - ENDDO + DO l=1,npowtra + ztmp1(:,:)=0.0 + DO k=1,ks + DO j=1,kpje + DO i=1,kpie + vol = seddw(k)*dlxp(i,j)*dlyp(i,j)*porwat(i,j,k) + ztmp1(i,j)= ztmp1(i,j) + omask(i,j)*powtra(i,j,k,l)*vol + ENDDO ENDDO + ENDDO - CALL xcsum(zsedlayto(l),ztmp1,ips) - ENDDO + CALL xcsum(zpowtratot(l),ztmp1,ips) + zpowtratoc(l) = zpowtratot(l)/zsedtotvol + ENDDO - ztmp1(:,:)=0.0 - DO k=1,ks + !=== non aqueous sediment tracer + !---------------------------------------------------------------------- + zburial = sum2d_array(burial, nsedtra) + + DO l=1,nsedtra + ztmp1(:,:)=0.0 + DO k=1,ks DO j=1,kpje - DO i=1,kpie - vol = porsol(i,j,k)*seddw(k)*dlxp(i,j)*dlyp(i,j) - ztmp1(i,j) = ztmp1(i,j) + omask(i,j)*sedhpl(i,j,k)*vol - ENDDO + DO i=1,kpie + vol = porsol(i,j,k)*seddw(k)*dlxp(i,j)*dlyp(i,j) + ztmp1(i,j) = ztmp1(i,j) + omask(i,j)*sedlay(i,j,k,l)*vol + ENDDO + ENDDO + ENDDO + + CALL xcsum(zsedlayto(l),ztmp1,ips) + ENDDO + + ztmp1(:,:)=0.0 + DO k=1,ks + DO j=1,kpje + DO i=1,kpie + vol = porsol(i,j,k)*seddw(k)*dlxp(i,j)*dlyp(i,j) + ztmp1(i,j) = ztmp1(i,j) + omask(i,j)*sedhpl(i,j,k)*vol ENDDO - ENDDO + ENDDO + ENDDO - CALL xcsum(zsedhplto,ztmp1,ips) + CALL xcsum(zsedhplto,ztmp1,ips) endif ! not sedbypass -!=== oceanic tracers -!---------------------------------------------------------------------- + !=== oceanic tracers + !---------------------------------------------------------------------- ztotvol = 0. zocetratot = 0. zocetratoc = 0. ztmp1(:,:)=0.0 DO k=1,kpke - DO j=1,kpje - DO i=1,kpie - IF(ddpo(i,j,k).gt.dp_min) THEN - ztmp1(i,j) = ztmp1(i,j) & - & + omask(i,j)*dlxp(i,j)*dlyp(i,j)*ddpo(i,j,k) - ENDIF - ENDDO - ENDDO + DO j=1,kpje + DO i=1,kpie + IF(ddpo(i,j,k).gt.dp_min) THEN + ztmp1(i,j) = ztmp1(i,j) & + & + omask(i,j)*dlxp(i,j)*dlyp(i,j)*ddpo(i,j,k) + ENDIF + ENDDO + ENDDO ENDDO CALL xcsum(ztotvol,ztmp1,ips) DO l=1,nocetra - ztmp1(:,:)=0.0 - DO k=1,kpke - DO j=1,kpje - DO i=1,kpie - IF(ddpo(i,j,k).gt.dp_min) THEN - vol = dlxp(i,j)*dlyp(i,j)*ddpo(i,j,k) - ztmp1(i,j) = ztmp1(i,j) + omask(i,j)*ocetra(i,j,k,l)*vol -! if (ocetra(i,j,k,l).lt.0.0) then -! WRITE(io_stdo_bgc,*) 'ocetra -ve', l,ocetra(i,j,k,l) -! endif - ENDIF - ENDDO + ztmp1(:,:)=0.0 + DO k=1,kpke + DO j=1,kpje + DO i=1,kpie + IF(ddpo(i,j,k).gt.dp_min) THEN + vol = dlxp(i,j)*dlyp(i,j)*ddpo(i,j,k) + ztmp1(i,j) = ztmp1(i,j) + omask(i,j)*ocetra(i,j,k,l)*vol + ! if (ocetra(i,j,k,l).lt.0.0) then + ! WRITE(io_stdo_bgc,*) 'ocetra -ve', l,ocetra(i,j,k,l) + ! endif + ENDIF ENDDO - ENDDO + ENDDO + ENDDO - CALL xcsum(zocetratot(l),ztmp1,ips) - zocetratoc(l) = zocetratot(l)/ztotvol + CALL xcsum(zocetratot(l),ztmp1,ips) + zocetratoc(l) = zocetratot(l)/ztotvol ENDDO -!=== additional ocean tracer -!---------------------------------------------------------------------- + !=== additional ocean tracer + !---------------------------------------------------------------------- zhito = 0. zco3to = 0. ztmp1(:,:)=0.0 ztmp2(:,:)=0.0 DO k=1,kpke - DO j=1,kpje - DO i=1,kpie - IF(ddpo(i,j,k).gt.dp_min) THEN - vol = dlxp(i,j)*dlyp(i,j)*ddpo(i,j,k) - ztmp1(i,j) = ztmp1(i,j) + omask(i,j)*hi(i,j,k) *vol - ztmp2(i,j) = ztmp2(i,j) + omask(i,j)*co3(i,j,k)*vol - ENDIF - ENDDO - ENDDO + DO j=1,kpje + DO i=1,kpie + IF(ddpo(i,j,k).gt.dp_min) THEN + vol = dlxp(i,j)*dlyp(i,j)*ddpo(i,j,k) + ztmp1(i,j) = ztmp1(i,j) + omask(i,j)*hi(i,j,k) *vol + ztmp2(i,j) = ztmp2(i,j) + omask(i,j)*co3(i,j,k)*vol + ENDIF + ENDDO + ENDDO ENDDO CALL xcsum(zhito ,ztmp1,ips) CALL xcsum(zco3to,ztmp2,ips) -!=== alkalinity of the first layer -!-------------------------------------------------------------------- + !=== alkalinity of the first layer + !-------------------------------------------------------------------- zvoltop = 0. zalkali = 0. @@ -271,17 +271,17 @@ SUBROUTINE INVENTORY_BGC(kpie,kpje,kpke,dlxp,dlyp,ddpo,omask,iogrp) ztmp1(:,:)=0.0 ztmp2(:,:)=0.0 DO j=1,kpje - DO i=1,kpie - ztmp1(i,j) = omask(i,j)*dlxp(i,j)*dlyp(i,j)*ddpo(i,j,k) - ztmp2(i,j) = ocetra(i,j,k,ialkali)*ztmp1(i,j) - ENDDO + DO i=1,kpie + ztmp1(i,j) = omask(i,j)*dlxp(i,j)*dlyp(i,j)*ddpo(i,j,k) + ztmp2(i,j) = ocetra(i,j,k,ialkali)*ztmp1(i,j) + ENDDO ENDDO CALL xcsum(zvoltop,ztmp1,ips) CALL xcsum(zalkali,ztmp2,ips) -!=== atmosphere flux and atmospheric CO2 -!-------------------------------------------------------------------- + !=== atmosphere flux and atmospheric CO2 + !-------------------------------------------------------------------- ztotarea =0. co2flux =0. so2flux =0. @@ -295,50 +295,50 @@ SUBROUTINE INVENTORY_BGC(kpie,kpje,kpke,dlxp,dlyp,ddpo,omask,iogrp) ztmp1(:,:)=0.0 DO j=1,kpje - DO i=1,kpie - ztmp1(i,j) = dlxp(i,j)*dlyp(i,j) - ENDDO + DO i=1,kpie + ztmp1(i,j) = dlxp(i,j)*dlyp(i,j) + ENDDO ENDDO CALL xcsum(ztotarea,ztmp1,ips) if (use_PBGC_CK_TIMESTEP) then - ! only consider instantaneous fluxes in debugging mode - co2flux = sum2d(atmflx(:,:,iatmco2)) - so2flux = sum2d(atmflx(:,:,iatmo2)) - sn2flux = sum2d(atmflx(:,:,iatmn2)) - sn2oflux = sum2d(atmflx(:,:,iatmn2o)) - - ! nitrogen deposition - if(do_ndep) then - sndepflux = sum2d(ndepflx) - endif - - ! river fluxes - if(do_rivinpt) then - srivflux = sum2d_array(rivinflx, nriv) - endif + ! only consider instantaneous fluxes in debugging mode + co2flux = sum2d(atmflx(:,:,iatmco2)) + so2flux = sum2d(atmflx(:,:,iatmo2)) + sn2flux = sum2d(atmflx(:,:,iatmn2)) + sn2oflux = sum2d(atmflx(:,:,iatmn2o)) + + ! nitrogen deposition + if(do_ndep) then + sndepflux = sum2d(ndepflx) + endif + + ! river fluxes + if(do_rivinpt) then + srivflux = sum2d_array(rivinflx, nriv) + endif else - ! consider accumulated fluxes in the regular mode - co2flux = sum2d(bgct2d(:,:,jco2flux)) - so2flux = sum2d(bgct2d(:,:,jo2flux)) - sn2flux = sum2d(bgct2d(:,:,jn2flux)) - sn2oflux = sum2d(bgct2d(:,:,jn2oflux)) - - ! nitrogen deposition fluxes - if(do_ndep) then - sndepflux = sum2d(bgct2d(:,:,jndep)) - endif - - ! River fluxes - if(do_rivinpt) then - srivflux = sum2d_array(bgct2d(:,:,jirdin:jirdin+nriv-1), nriv) - endif + ! consider accumulated fluxes in the regular mode + co2flux = sum2d(bgct2d(:,:,jco2flux)) + so2flux = sum2d(bgct2d(:,:,jo2flux)) + sn2flux = sum2d(bgct2d(:,:,jn2flux)) + sn2oflux = sum2d(bgct2d(:,:,jn2oflux)) + + ! nitrogen deposition fluxes + if(do_ndep) then + sndepflux = sum2d(bgct2d(:,:,jndep)) + endif + + ! River fluxes + if(do_rivinpt) then + srivflux = sum2d_array(bgct2d(:,:,jirdin:jirdin+nriv-1), nriv) + endif endif if (use_BOXATM) then - zatmco2 = sum2d(atm(:,:,iatmco2)) - zatmo2 = sum2d(atm(:,:,iatmo2)) - zatmn2 = sum2d(atm(:,:,iatmn2)) + zatmco2 = sum2d(atm(:,:,iatmco2)) + zatmo2 = sum2d(atm(:,:,iatmo2)) + zatmn2 = sum2d(atm(:,:,iatmn2)) endif !--- Complete sum of inventory in between bgc.f90 @@ -346,90 +346,90 @@ SUBROUTINE INVENTORY_BGC(kpie,kpje,kpke,dlxp,dlyp,ddpo,omask,iogrp) zprcaca = sum2d(prcaca) zsilpro = sum2d(silpro) -!=== Sum of inventory -!---------------------------------------------------------------------- -! Units in P have a C:P Ratio of 122:1 + !=== Sum of inventory + !---------------------------------------------------------------------- + ! Units in P have a C:P Ratio of 122:1 -! totalcarbon= & -! & (zocetratot(idet)+zocetratot(idoc)+zocetratot(iphy) & -! & +zocetratot(izoo))*rcar+zocetratot(isco212)+zocetratot(icalc) + ! totalcarbon= & + ! & (zocetratot(idet)+zocetratot(idoc)+zocetratot(iphy) & + ! & +zocetratot(izoo))*rcar+zocetratot(isco212)+zocetratot(icalc) totalcarbon= & - (zocetratot(idet)+zocetratot(idoc)+zocetratot(iphy) & - + zocetratot(izoo))*rcar+zocetratot(isco212)+zocetratot(icalc) & - + zpowtratot(ipowaic)+zsedlayto(isssc12)+zsedlayto(issso12)*rcar & - + zburial(isssc12)+zburial(issso12)*rcar & - + zprorca*rcar+zprcaca + (zocetratot(idet)+zocetratot(idoc)+zocetratot(iphy) & + + zocetratot(izoo))*rcar+zocetratot(isco212)+zocetratot(icalc) & + + zpowtratot(ipowaic)+zsedlayto(isssc12)+zsedlayto(issso12)*rcar & + + zburial(isssc12)+zburial(issso12)*rcar & + + zprorca*rcar+zprcaca if (use_BOXATM) then - totalcarbon = totalcarbon + zatmco2*ppm2con + totalcarbon = totalcarbon + zatmco2*ppm2con else - totalcarbon = totalcarbon + co2flux + totalcarbon = totalcarbon + co2flux endif totalnitr= & - (zocetratot(idet)+zocetratot(idoc)+zocetratot(iphy) & - + zocetratot(izoo))*rnit+zocetratot(iano3)+zocetratot(igasnit)*2 & - + zpowtratot(ipowno3)+zpowtratot(ipown2)*2 & - + zsedlayto(issso12)*rnit+zburial(issso12)*rnit & - + zocetratot(ian2o)*2 & - - sndepflux & - + zprorca*rnit + (zocetratot(idet)+zocetratot(idoc)+zocetratot(iphy) & + + zocetratot(izoo))*rnit+zocetratot(iano3)+zocetratot(igasnit)*2 & + + zpowtratot(ipowno3)+zpowtratot(ipown2)*2 & + + zsedlayto(issso12)*rnit+zburial(issso12)*rnit & + + zocetratot(ian2o)*2 & + - sndepflux & + + zprorca*rnit if (use_BOXATM) then - totalnitr = totalnitr + zatmn2*ppm2con*2 + totalnitr = totalnitr + zatmn2*ppm2con*2 else - totalnitr = totalnitr + sn2flux*2+sn2oflux*2 + totalnitr = totalnitr + sn2flux*2+sn2oflux*2 endif totalphos= & - zocetratot(idet)+zocetratot(idoc)+zocetratot(iphy) & + zocetratot(idet)+zocetratot(idoc)+zocetratot(iphy) & + zocetratot(izoo)+zocetratot(iphosph) & + zpowtratot(ipowaph)+zsedlayto(issso12) & + zburial(issso12) & + zprorca totalsil= & - zocetratot(isilica)+zocetratot(iopal) & + zocetratot(isilica)+zocetratot(iopal) & + zpowtratot(ipowasi)+zsedlayto(issssil)+zburial(issssil) & + zsilpro totaloxy= & - (zocetratot(idet)+zocetratot(idoc)+zocetratot(iphy) & + (zocetratot(idet)+zocetratot(idoc)+zocetratot(iphy) & + zocetratot(izoo))*(-24.)+zocetratot(ioxygen) & + zocetratot(iphosph)*2 +zocetratot(isco212)+zocetratot(icalc) & + zocetratot(iano3)*1.5+zocetratot(ian2o)*0.5 & + zsedlayto(issso12)*(-24.) + zsedlayto(isssc12) & - !+ zburial(issso12)*(-24.) + zburial(isssc12) & + !+ zburial(issso12)*(-24.) + zburial(isssc12) & + zpowtratot(ipowno3)*1.5+zpowtratot(ipowaic) & + zpowtratot(ipowaox)+zpowtratot(ipowaph)*2 & - sndepflux*1.5 & + zprorca*(-24.)+zprcaca if (use_BOXATM) then - totaloxy = totaloxy + zatmo2*ppm2con+zatmco2*ppm2con + totaloxy = totaloxy + zatmo2*ppm2con+zatmco2*ppm2con else - totaloxy = totaloxy + so2flux+sn2oflux*0.5+co2flux + totaloxy = totaloxy + so2flux+sn2oflux*0.5+co2flux endif IF (do_rivinpt) THEN - totalcarbon = totalcarbon & - - (srivflux(irdoc)+srivflux(irdet))*rcar -(srivflux(iralk)+srivflux(irdin)+srivflux(irdip)) ! =sco212 - totalnitr = totalnitr & - - (srivflux(irdoc)+srivflux(irdet))*rnit - srivflux(irdin) - totalphos = totalphos & - -(srivflux(irdoc)+srivflux(irdet)+srivflux(irdip)) - totalsil = totalsil & - - srivflux(irsi) - totaloxy = totaloxy & - - (srivflux(irdoc)+srivflux(irdet))*(-24.) & - - srivflux(irdin)*1.5 - srivflux(irdip)*2. & - - (srivflux(iralk)+srivflux(irdin)+srivflux(irdip)) ! =sco212 + totalcarbon = totalcarbon & + - (srivflux(irdoc)+srivflux(irdet))*rcar -(srivflux(iralk)+srivflux(irdin)+srivflux(irdip)) ! =sco212 + totalnitr = totalnitr & + - (srivflux(irdoc)+srivflux(irdet))*rnit - srivflux(irdin) + totalphos = totalphos & + -(srivflux(irdoc)+srivflux(irdet)+srivflux(irdip)) + totalsil = totalsil & + - srivflux(irsi) + totaloxy = totaloxy & + - (srivflux(irdoc)+srivflux(irdet))*(-24.) & + - srivflux(irdin)*1.5 - srivflux(irdip)*2. & + - (srivflux(iralk)+srivflux(irdin)+srivflux(irdip)) ! =sco212 ENDIF -!=== Compute sediment fluxes -!---------------------------------------------------------------------- + !=== Compute sediment fluxes + !---------------------------------------------------------------------- sum_zprorca = sum2d(bgct2d(:,:,jprorca)) sum_zprcaca = sum2d(bgct2d(:,:,jprcaca)) sum_zsilpro = sum2d(bgct2d(:,:,jsilpro)) @@ -440,16 +440,16 @@ SUBROUTINE INVENTORY_BGC(kpie,kpje,kpke,dlxp,dlyp,ddpo,omask,iogrp) sum_expoca = sum2d(expoca) sum_exposi = sum2d(exposi) -!=== Write output to netCDF file or stdout -!---------------------------------------------------------------------- + !=== Write output to netCDF file or stdout + !---------------------------------------------------------------------- if (mnproc == 1) then - if (iogrp == 0) then ! debug mode - call write_stdout - else if (GLB_INVENTORY(iogrp) == 2) then ! netcdf output - call write_netcdf(iogrp) - else ! default - call write_stdout - endif + if (iogrp == 0) then ! debug mode + call write_stdout + else if (GLB_INVENTORY(iogrp) == 2) then ! netcdf output + call write_netcdf(iogrp) + else ! default + call write_stdout + endif endif return @@ -457,392 +457,392 @@ SUBROUTINE INVENTORY_BGC(kpie,kpje,kpke,dlxp,dlyp,ddpo,omask,iogrp) contains -function sum2d(var2d) result(total) -!********************************************************************** -!**** Sum 2D scalar fields -!********************************************************************** - implicit none - real, dimension(kpie,kpje), intent(in) :: var2d - real :: total + function sum2d(var2d) result(total) + !********************************************************************** + !**** Sum 2D scalar fields + !********************************************************************** + implicit none + real, dimension(kpie,kpje), intent(in) :: var2d + real :: total - ! Local variables - integer :: i,j - !--- input to xcsum require halo indices - real, dimension(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy) :: ztmp + ! Local variables + integer :: i,j + !--- input to xcsum require halo indices + real, dimension(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy) :: ztmp - ztmp(:,:)=0.0 - do j=1,kpje - do i=1,kpie + ztmp(:,:)=0.0 + do j=1,kpje + do i=1,kpie ztmp(i,j) = var2d(i,j)*dlxp(i,j)*dlyp(i,j)*omask(i,j) - enddo - enddo - call xcsum(total,ztmp,ips) -end function sum2d - - -function sum2d_array(var3d, narr) result(total) -!********************************************************************** -!**** Sum 2D array fields -!********************************************************************** - implicit none - integer, intent(in) :: narr - real, dimension(kpie,kpje,narr), intent(in) :: var3d - real, dimension(narr) :: total - - ! Local variables - integer :: i,j,k - !--- input to xcsum require halo indices - real, dimension(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy) :: ztmp - - ztmp(:,:)=0.0 - do k=1,narr - do j=1,kpje + enddo + enddo + call xcsum(total,ztmp,ips) + end function sum2d + + + function sum2d_array(var3d, narr) result(total) + !********************************************************************** + !**** Sum 2D array fields + !********************************************************************** + implicit none + integer, intent(in) :: narr + real, dimension(kpie,kpje,narr), intent(in) :: var3d + real, dimension(narr) :: total + + ! Local variables + integer :: i,j,k + !--- input to xcsum require halo indices + real, dimension(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy) :: ztmp + + ztmp(:,:)=0.0 + do k=1,narr + do j=1,kpje do i=1,kpie - ztmp(i,j) = var3d(i,j,k)*dlxp(i,j)*dlyp(i,j)*omask(i,j) + ztmp(i,j) = var3d(i,j,k)*dlxp(i,j)*dlyp(i,j)*omask(i,j) enddo - enddo - call xcsum(total(k),ztmp,ips) - enddo -end function sum2d_array - - -subroutine write_stdout -!********************************************************************** -!**** Write inventory to log file. -!********************************************************************** - implicit none - - integer :: l - - if (.not. use_sedbypass) then - !=== aqueous sediment tracer - !------------------------------------------------------------------ - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*)'Global inventory of aqueous sediment tracer' - WRITE(io_stdo_bgc,*)'-------------------------------------------' - WRITE(io_stdo_bgc,*) ' total[kmol] concentration[mol/L]' - DO l=1,npowtra + enddo + call xcsum(total(k),ztmp,ips) + enddo + end function sum2d_array + + + subroutine write_stdout + !********************************************************************** + !**** Write inventory to log file. + !********************************************************************** + implicit none + + integer :: l + + if (.not. use_sedbypass) then + !=== aqueous sediment tracer + !------------------------------------------------------------------ + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*)'Global inventory of aqueous sediment tracer' + WRITE(io_stdo_bgc,*)'-------------------------------------------' + WRITE(io_stdo_bgc,*) ' total[kmol] concentration[mol/L]' + DO l=1,npowtra WRITE(io_stdo_bgc,*)'No. ',l,' ',zpowtratot(l), & & ' ',zpowtratoc(l),' ',zsedtotvol - ENDDO - WRITE(io_stdo_bgc,*) ' ' - - !=== non aqueous sediment tracer - !------------------------------------------------------------------ - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) & - & 'Global inventory of solid sediment constituents' - WRITE(io_stdo_bgc,*) & - & '----------------------------------------------------' - WRITE(io_stdo_bgc,*) ' [kmol]' - - DO l=1,nsedtra + ENDDO + WRITE(io_stdo_bgc,*) ' ' + + !=== non aqueous sediment tracer + !------------------------------------------------------------------ + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) & + & 'Global inventory of solid sediment constituents' + WRITE(io_stdo_bgc,*) & + & '----------------------------------------------------' + WRITE(io_stdo_bgc,*) ' [kmol]' + + DO l=1,nsedtra WRITE(io_stdo_bgc,*) 'Sediment No. ',l,' ', zsedlayto(l) WRITE(io_stdo_bgc,*) 'Burial No. ',l,' ', zburial(l) - ENDDO - WRITE(io_stdo_bgc,*) 'hpl ', zsedhplto - WRITE(io_stdo_bgc,*) ' ' - endif - - !=== oceanic tracers - !------------------------------------------------------------------ - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Global inventory of advected ocean tracers' - WRITE(io_stdo_bgc,*) '------------------------------------------' - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) ' total[kmol] concentration[kmol/m^3]' - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'ztotvol',ztotvol - DO l=1,nocetra - WRITE(io_stdo_bgc,*) 'No. ',l, zocetratot(l), zocetratoc(l) - ENDDO - - !=== additional ocean tracer - !------------------------------------------------------------------ - ! WRITE(io_stdo_bgc,*) ' ' - ! WRITE(io_stdo_bgc,*) 'Glob. inventory of additional ocean tracer' - ! WRITE(io_stdo_bgc,*) '------------------------------------------' - ! WRITE(io_stdo_bgc,*) ' total[kmol] concentration[kmol/m^3]' - ! WRITE(io_stdo_bgc,*) ' ' - ! WRITE(io_stdo_bgc,*) ' hi', zhito, zhito/ztotvol - ! WRITE(io_stdo_bgc,*) ' co3', zco3to, zco3to/ztotvol - ! WRITE(io_stdo_bgc,*) ' ' - - !=== alkalinity of the first layer - !------------------------------------------------------------------ - ! WRITE(io_stdo_bgc,*) ' ' - ! WRITE(io_stdo_bgc,*) 'Global inventory of first layer alkalinity' - ! WRITE(io_stdo_bgc,*) '------------------------------------------' - ! WRITE(io_stdo_bgc,*) ' ' - ! WRITE(io_stdo_bgc,*) ' total[kmol] concentration[kmol/m^3]' - ! WRITE(io_stdo_bgc,*) ' ' - ! WRITE(io_stdo_bgc,*) zalkali, zalkali/zvoltop - - !=== atmosphere flux and atmospheric CO2 - !------------------------------------------------------------------ - ! WRITE(io_stdo_bgc,*) ' ' - ! WRITE(io_stdo_bgc,*) 'Global fluxes into atmosphere' - ! WRITE(io_stdo_bgc,*) '-----------------------------' - ! WRITE(io_stdo_bgc,*) ' [kmol]' - ! WRITE(io_stdo_bgc,*) ' ' - ! WRITE(io_stdo_bgc,*) 'CO2Flux :',co2flux - ! WRITE(io_stdo_bgc,*) 'O2 Flux :',so2flux - ! WRITE(io_stdo_bgc,*) 'N2 Flux :',sn2flux - ! WRITE(io_stdo_bgc,*) 'N2O Flux :',sn2oflux - ! WRITE(io_stdo_bgc,*) ' ' - if (use_BOXATM) then - ! WRITE(io_stdo_bgc,*) 'global atm. CO2[ppm] / kmol: ', & - ! & zatmco2/ztotarea,zatmco2*ppm2con - ! WRITE(io_stdo_bgc,*) 'global atm. O2[ppm] / kmol : ', & - ! & zatmo2/ztotarea,zatmo2*ppm2con - ! WRITE(io_stdo_bgc,*) 'global atm. N2[ppm] / kmol : ', & - ! & zatmn2/ztotarea,zatmn2*ppm2con - endif - ! WRITE(io_stdo_bgc,*) ' ' - ! WRITE(io_stdo_bgc,*) 'Should be zero at the end: ' - ! WRITE(io_stdo_bgc,*) 'prorca, prcaca, silpro ', & - ! & zprorca, zprcaca, zsilpro - ! WRITE(io_stdo_bgc,*) ' ' - - IF(do_ndep) WRITE(io_stdo_bgc,*) 'NdepFlux :',sndepflux - - ! riverine fluxes - !------------------------------------------------------------------ - IF(do_rivinpt)THEN - WRITE(io_stdo_bgc,*) 'Riverine fluxes:' - DO l=1,nriv + ENDDO + WRITE(io_stdo_bgc,*) 'hpl ', zsedhplto + WRITE(io_stdo_bgc,*) ' ' + endif + + !=== oceanic tracers + !------------------------------------------------------------------ + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) 'Global inventory of advected ocean tracers' + WRITE(io_stdo_bgc,*) '------------------------------------------' + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) ' total[kmol] concentration[kmol/m^3]' + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) 'ztotvol',ztotvol + DO l=1,nocetra + WRITE(io_stdo_bgc,*) 'No. ',l, zocetratot(l), zocetratoc(l) + ENDDO + + !=== additional ocean tracer + !------------------------------------------------------------------ + ! WRITE(io_stdo_bgc,*) ' ' + ! WRITE(io_stdo_bgc,*) 'Glob. inventory of additional ocean tracer' + ! WRITE(io_stdo_bgc,*) '------------------------------------------' + ! WRITE(io_stdo_bgc,*) ' total[kmol] concentration[kmol/m^3]' + ! WRITE(io_stdo_bgc,*) ' ' + ! WRITE(io_stdo_bgc,*) ' hi', zhito, zhito/ztotvol + ! WRITE(io_stdo_bgc,*) ' co3', zco3to, zco3to/ztotvol + ! WRITE(io_stdo_bgc,*) ' ' + + !=== alkalinity of the first layer + !------------------------------------------------------------------ + ! WRITE(io_stdo_bgc,*) ' ' + ! WRITE(io_stdo_bgc,*) 'Global inventory of first layer alkalinity' + ! WRITE(io_stdo_bgc,*) '------------------------------------------' + ! WRITE(io_stdo_bgc,*) ' ' + ! WRITE(io_stdo_bgc,*) ' total[kmol] concentration[kmol/m^3]' + ! WRITE(io_stdo_bgc,*) ' ' + ! WRITE(io_stdo_bgc,*) zalkali, zalkali/zvoltop + + !=== atmosphere flux and atmospheric CO2 + !------------------------------------------------------------------ + ! WRITE(io_stdo_bgc,*) ' ' + ! WRITE(io_stdo_bgc,*) 'Global fluxes into atmosphere' + ! WRITE(io_stdo_bgc,*) '-----------------------------' + ! WRITE(io_stdo_bgc,*) ' [kmol]' + ! WRITE(io_stdo_bgc,*) ' ' + ! WRITE(io_stdo_bgc,*) 'CO2Flux :',co2flux + ! WRITE(io_stdo_bgc,*) 'O2 Flux :',so2flux + ! WRITE(io_stdo_bgc,*) 'N2 Flux :',sn2flux + ! WRITE(io_stdo_bgc,*) 'N2O Flux :',sn2oflux + ! WRITE(io_stdo_bgc,*) ' ' + if (use_BOXATM) then + ! WRITE(io_stdo_bgc,*) 'global atm. CO2[ppm] / kmol: ', & + ! & zatmco2/ztotarea,zatmco2*ppm2con + ! WRITE(io_stdo_bgc,*) 'global atm. O2[ppm] / kmol : ', & + ! & zatmo2/ztotarea,zatmo2*ppm2con + ! WRITE(io_stdo_bgc,*) 'global atm. N2[ppm] / kmol : ', & + ! & zatmn2/ztotarea,zatmn2*ppm2con + endif + ! WRITE(io_stdo_bgc,*) ' ' + ! WRITE(io_stdo_bgc,*) 'Should be zero at the end: ' + ! WRITE(io_stdo_bgc,*) 'prorca, prcaca, silpro ', & + ! & zprorca, zprcaca, zsilpro + ! WRITE(io_stdo_bgc,*) ' ' + + IF(do_ndep) WRITE(io_stdo_bgc,*) 'NdepFlux :',sndepflux + + ! riverine fluxes + !------------------------------------------------------------------ + IF(do_rivinpt)THEN + WRITE(io_stdo_bgc,*) 'Riverine fluxes:' + DO l=1,nriv WRITE(io_stdo_bgc,*) 'No. ',l,srivflux(l) - ENDDO - ENDIF - - !=== Sum of inventory - !------------------------------------------------------------------ - ! Units in P have a C:P Ratio of 122:1 - WRITE(io_stdo_bgc,*) 'Global total[kmol] of carbon : ', totalcarbon - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Global total[kmol] of phosph. : ', totalphos - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Global total[kmol] of silicate : ', totalsil - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Global total[kmol] of nitrogen. : ', totalnitr - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Global total[kmol] of oxygen. : ', totaloxy - - !=== Write sediment fluxes - !------------------------------------------------------------------ - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Global fluxes into and out of the sediment' - WRITE(io_stdo_bgc,*) '------------------------------------------' - WRITE(io_stdo_bgc,*) ' [kmol]' - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Detritus, Calcium Carbonate, Silicate ', & - & sum_zprorca, sum_zprcaca, sum_zsilpro - WRITE(io_stdo_bgc,*) ' ' - DO l=1,npowtra - WRITE(io_stdo_bgc,*) 'No. ',l,' ',sum_sedfluxo(l) - ENDDO - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Global total export production' - WRITE(io_stdo_bgc,*) '------------------------------' - WRITE(io_stdo_bgc,*) ' [kmol]' - WRITE(io_stdo_bgc,*) 'carbon : ',sum_expoor - WRITE(io_stdo_bgc,*) 'carbonate: ',sum_expoca - WRITE(io_stdo_bgc,*) 'silicate : ',sum_exposi - WRITE(io_stdo_bgc,*) ' ' - -end subroutine write_stdout - - -subroutine write_netcdf(iogrp) -!********************************************************************** -!**** Write inventory to netCDF file. -!********************************************************************** - use netcdf, only: nf90_clobber, nf90_close, nf90_create, nf90_def_dim, & - & nf90_def_var, nf90_double, nf90_enddef, nf90_global, & - & nf90_inq_dimid, nf90_inq_varid, nf90_open, & - & nf90_put_att, nf90_put_var, nf90_unlimited, nf90_write - use mod_types, only: r8 - use mod_config, only: expcnf, runid, inst_suffix - use mod_time, only: date0, time0, date, time, nstep, nday_of_year, & - & nstep_in_day - use mo_bgcmean, only: filefq_bgc, fileann_bgc, filemon_bgc,glb_fnametag - use mo_param1_bgc, only: idicsat,idms,ifdust,iiron,iprefalk,iprefdic,iprefo2, & - & iprefpo4 - ! AGG - use mo_param1_bgc, only: iadust,inos - ! BROMO - use mo_param1_bgc, only: ibromo - ! CFC - use mo_param1_bgc, only: icfc11,icfc12,isf6 - ! cisonew - use mo_param1_bgc, only: icalc13,icalc14,idet13,idet14,idoc13,idoc14, & - & iphy13,iphy14,isco213,isco214,izoo13,izoo14 - ! natDIC - use mo_param1_bgc, only: inatalkali,inatcalc,inatsco212 - use mo_control_bgc, only: use_PBGC_CK_TIMESTEP,use_BOXATM,use_sedbypass,use_cisonew,use_AGG,use_CFC,use_natDIC,use_BROMO - - implicit none - - integer, intent(in) :: iogrp - - !=== Save filename and counter variables - !--- netCDF output file names - character(len=256), dimension(nbgcmax), save :: fname_inv - integer, dimension(nbgcmax), save :: ncrec = 0 - logical, dimension(nbgcmax), save :: append2file_inv - data append2file_inv /nbgcmax*.false./ - - !=== Local variables - character(len=:), allocatable :: prefix, sep1, sep2 - character(len=20) :: tstamp - character(len=30) :: timeunits - integer :: l - real(r8) :: datenum - - !=== Variables for netcdf - integer :: ncid, ncvarid, ncstat - integer :: wrstart(1) - !--- time: dimension and variable id - integer :: time_dimid - integer :: time_varid - - ! NOT sedbypass - !--- aqueous sediment tracers - integer :: npowtra_dimid ! id: aqueous sediments - integer :: zpowtra_dimids(2) ! aqueous sediment dimensions - integer :: zpowtra_wrstart(2) ! record start point - integer :: zpowtra_count(2) ! record count - integer :: zsedtotvol_varid ! id: Total sediment volume - integer :: zpowtratot_varid ! id: Total aqueous sediment tracer [kmol] - integer :: zpowtratoc_varid ! id: Sediment tracer concentration [kmol/L] - !--- non-aqueous sediment tracers - integer :: nsedtra_dimid ! id: solid sediments - integer :: zsedtra_dimids(2) ! solid sediments dimensions - integer :: zsedtra_wrstart(2) ! record start point - integer :: zsedtra_count(2) ! record count - integer :: zsedlayto_varid ! id: sediment layer tracers - integer :: zburial_varid ! id: sediment burial tracers - integer :: zsedhplto_varid ! id: accumulated hydrogen ions - - !--- oceanic tracers - !--- Write total sum zt__varid, and mean concentration zc__varid - integer :: ztotvol_varid ! Total ocean volume - integer :: zt_sco212_varid, zc_sco212_varid ! Dissolved CO2 - integer :: zt_alkali_varid, zc_alkali_varid ! Alkalinity - integer :: zt_phosph_varid, zc_phosph_varid ! Dissolved phosphate - integer :: zt_oxygen_varid, zc_oxygen_varid ! Dissolved oxygen - integer :: zt_gasnit_varid, zc_gasnit_varid ! Gaseous nitrogen (N2) - integer :: zt_ano3_varid, zc_ano3_varid ! Dissolved nitrate - integer :: zt_silica_varid, zc_silica_varid ! Silicid acid (Si(OH)4) - integer :: zt_doc_varid, zc_doc_varid ! Dissolved organic carbon - integer :: zt_poc_varid, zc_poc_varid ! Particulate organic carbon - integer :: zt_phyto_varid, zc_phyto_varid ! Phytoplankton concentration - integer :: zt_grazer_varid, zc_grazer_varid ! Zooplankton concentration - integer :: zt_calciu_varid, zc_calciu_varid ! Calcium carbonate - integer :: zt_opal_varid, zc_opal_varid ! Biogenic silica - integer :: zt_n2o_varid, zc_n2o_varid ! Laughing gas (N2O) - integer :: zt_dms_varid, zc_dms_varid ! DiMethylSulfide - integer :: zt_fdust_varid, zc_fdust_varid ! Non-aggregated dust - integer :: zt_iron_varid, zc_iron_varid ! Dissolved iron - integer :: zt_prefo2_varid, zc_prefo2_varid ! Preformed oxygen - integer :: zt_prefpo4_varid, zc_prefpo4_varid ! Preformed phosphate - 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 - - ! 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 - integer :: zt_doc14_varid, zc_doc14_varid ! Dissolved organic carbon-C14 - integer :: zt_poc13_varid, zc_poc13_varid ! Particulate organic carbon-C13 - integer :: zt_poc14_varid, zc_poc14_varid ! Particulate organic carbon-C14 - integer :: zt_phyto13_varid, zc_phyto13_varid ! Phytoplankton concentration-C13 - integer :: zt_phyto14_varid, zc_phyto14_varid ! Phytoplankton concentration-C14 - integer :: zt_grazer13_varid, zc_grazer13_varid ! Zooplankton concentration-C13 - 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 - - ! AGG - integer :: zt_snos_varid, zc_snos_varid ! Marine snow aggregates per g sea water - integer :: zt_adust_varid, zc_adust_varid ! Aggregated dust - - ! 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 - - ! 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 - - ! BROMO - integer :: zt_bromo_varid, zc_bromo_varid ! Bromoform - - !--- sum of inventory - integer :: totcarb_varid, totphos_varid, totsili_varid, totnitr_varid - integer :: totoxyg_varid - !--- sediment fluxes - integer :: sum_zprorca_varid, sum_zprcaca_varid, sum_zsilpro_varid - integer :: sum_sedfluxo_varid - integer :: sum_expoor_varid, sum_expoca_varid, sum_exposi_varid - - - !=== Create new or open existing netCDF file - if (.not.append2file_inv(iogrp)) then - !--- file name : fname_inv(iogrp) - if (expcnf.eq.'cesm') then + ENDDO + ENDIF + + !=== Sum of inventory + !------------------------------------------------------------------ + ! Units in P have a C:P Ratio of 122:1 + WRITE(io_stdo_bgc,*) 'Global total[kmol] of carbon : ', totalcarbon + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) 'Global total[kmol] of phosph. : ', totalphos + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) 'Global total[kmol] of silicate : ', totalsil + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) 'Global total[kmol] of nitrogen. : ', totalnitr + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) 'Global total[kmol] of oxygen. : ', totaloxy + + !=== Write sediment fluxes + !------------------------------------------------------------------ + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) 'Global fluxes into and out of the sediment' + WRITE(io_stdo_bgc,*) '------------------------------------------' + WRITE(io_stdo_bgc,*) ' [kmol]' + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) 'Detritus, Calcium Carbonate, Silicate ', & + & sum_zprorca, sum_zprcaca, sum_zsilpro + WRITE(io_stdo_bgc,*) ' ' + DO l=1,npowtra + WRITE(io_stdo_bgc,*) 'No. ',l,' ',sum_sedfluxo(l) + ENDDO + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) 'Global total export production' + WRITE(io_stdo_bgc,*) '------------------------------' + WRITE(io_stdo_bgc,*) ' [kmol]' + WRITE(io_stdo_bgc,*) 'carbon : ',sum_expoor + WRITE(io_stdo_bgc,*) 'carbonate: ',sum_expoca + WRITE(io_stdo_bgc,*) 'silicate : ',sum_exposi + WRITE(io_stdo_bgc,*) ' ' + + end subroutine write_stdout + + + subroutine write_netcdf(iogrp) + !********************************************************************** + !**** Write inventory to netCDF file. + !********************************************************************** + use netcdf, only: nf90_clobber, nf90_close, nf90_create, nf90_def_dim, & + & nf90_def_var, nf90_double, nf90_enddef, nf90_global, & + & nf90_inq_dimid, nf90_inq_varid, nf90_open, & + & nf90_put_att, nf90_put_var, nf90_unlimited, nf90_write + use mod_types, only: r8 + use mod_config, only: expcnf, runid, inst_suffix + use mod_time, only: date0, time0, date, time, nstep, nday_of_year, & + & nstep_in_day + use mo_bgcmean, only: filefq_bgc, fileann_bgc, filemon_bgc,glb_fnametag + use mo_param1_bgc, only: idicsat,idms,ifdust,iiron,iprefalk,iprefdic,iprefo2, & + & iprefpo4 + ! AGG + use mo_param1_bgc, only: iadust,inos + ! BROMO + use mo_param1_bgc, only: ibromo + ! CFC + use mo_param1_bgc, only: icfc11,icfc12,isf6 + ! cisonew + use mo_param1_bgc, only: icalc13,icalc14,idet13,idet14,idoc13,idoc14, & + & iphy13,iphy14,isco213,isco214,izoo13,izoo14 + ! natDIC + use mo_param1_bgc, only: inatalkali,inatcalc,inatsco212 + use mo_control_bgc, only: use_PBGC_CK_TIMESTEP,use_BOXATM,use_sedbypass,use_cisonew,use_AGG,use_CFC,use_natDIC,use_BROMO + + implicit none + + integer, intent(in) :: iogrp + + !=== Save filename and counter variables + !--- netCDF output file names + character(len=256), dimension(nbgcmax), save :: fname_inv + integer, dimension(nbgcmax), save :: ncrec = 0 + logical, dimension(nbgcmax), save :: append2file_inv + data append2file_inv /nbgcmax*.false./ + + !=== Local variables + character(len=:), allocatable :: prefix, sep1, sep2 + character(len=20) :: tstamp + character(len=30) :: timeunits + integer :: l + real(r8) :: datenum + + !=== Variables for netcdf + integer :: ncid, ncvarid, ncstat + integer :: wrstart(1) + !--- time: dimension and variable id + integer :: time_dimid + integer :: time_varid + + ! NOT sedbypass + !--- aqueous sediment tracers + integer :: npowtra_dimid ! id: aqueous sediments + integer :: zpowtra_dimids(2) ! aqueous sediment dimensions + integer :: zpowtra_wrstart(2) ! record start point + integer :: zpowtra_count(2) ! record count + integer :: zsedtotvol_varid ! id: Total sediment volume + integer :: zpowtratot_varid ! id: Total aqueous sediment tracer [kmol] + integer :: zpowtratoc_varid ! id: Sediment tracer concentration [kmol/L] + !--- non-aqueous sediment tracers + integer :: nsedtra_dimid ! id: solid sediments + integer :: zsedtra_dimids(2) ! solid sediments dimensions + integer :: zsedtra_wrstart(2) ! record start point + integer :: zsedtra_count(2) ! record count + integer :: zsedlayto_varid ! id: sediment layer tracers + integer :: zburial_varid ! id: sediment burial tracers + integer :: zsedhplto_varid ! id: accumulated hydrogen ions + + !--- oceanic tracers + !--- Write total sum zt__varid, and mean concentration zc__varid + integer :: ztotvol_varid ! Total ocean volume + integer :: zt_sco212_varid, zc_sco212_varid ! Dissolved CO2 + integer :: zt_alkali_varid, zc_alkali_varid ! Alkalinity + integer :: zt_phosph_varid, zc_phosph_varid ! Dissolved phosphate + integer :: zt_oxygen_varid, zc_oxygen_varid ! Dissolved oxygen + integer :: zt_gasnit_varid, zc_gasnit_varid ! Gaseous nitrogen (N2) + integer :: zt_ano3_varid, zc_ano3_varid ! Dissolved nitrate + integer :: zt_silica_varid, zc_silica_varid ! Silicid acid (Si(OH)4) + integer :: zt_doc_varid, zc_doc_varid ! Dissolved organic carbon + integer :: zt_poc_varid, zc_poc_varid ! Particulate organic carbon + integer :: zt_phyto_varid, zc_phyto_varid ! Phytoplankton concentration + integer :: zt_grazer_varid, zc_grazer_varid ! Zooplankton concentration + integer :: zt_calciu_varid, zc_calciu_varid ! Calcium carbonate + integer :: zt_opal_varid, zc_opal_varid ! Biogenic silica + integer :: zt_n2o_varid, zc_n2o_varid ! Laughing gas (N2O) + integer :: zt_dms_varid, zc_dms_varid ! DiMethylSulfide + integer :: zt_fdust_varid, zc_fdust_varid ! Non-aggregated dust + integer :: zt_iron_varid, zc_iron_varid ! Dissolved iron + integer :: zt_prefo2_varid, zc_prefo2_varid ! Preformed oxygen + integer :: zt_prefpo4_varid, zc_prefpo4_varid ! Preformed phosphate + 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 + + ! 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 + integer :: zt_doc14_varid, zc_doc14_varid ! Dissolved organic carbon-C14 + integer :: zt_poc13_varid, zc_poc13_varid ! Particulate organic carbon-C13 + integer :: zt_poc14_varid, zc_poc14_varid ! Particulate organic carbon-C14 + integer :: zt_phyto13_varid, zc_phyto13_varid ! Phytoplankton concentration-C13 + integer :: zt_phyto14_varid, zc_phyto14_varid ! Phytoplankton concentration-C14 + integer :: zt_grazer13_varid, zc_grazer13_varid ! Zooplankton concentration-C13 + 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 + + ! AGG + integer :: zt_snos_varid, zc_snos_varid ! Marine snow aggregates per g sea water + integer :: zt_adust_varid, zc_adust_varid ! Aggregated dust + + ! 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 + + ! 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 + + ! BROMO + integer :: zt_bromo_varid, zc_bromo_varid ! Bromoform + + !--- sum of inventory + integer :: totcarb_varid, totphos_varid, totsili_varid, totnitr_varid + integer :: totoxyg_varid + !--- sediment fluxes + integer :: sum_zprorca_varid, sum_zprcaca_varid, sum_zsilpro_varid + integer :: sum_sedfluxo_varid + integer :: sum_expoor_varid, sum_expoca_varid, sum_exposi_varid + + + !=== Create new or open existing netCDF file + if (.not.append2file_inv(iogrp)) then + !--- file name : fname_inv(iogrp) + if (expcnf.eq.'cesm') then prefix=trim(runid)//'.blom'//trim(inst_suffix) sep1='.' sep2='-' - else + else prefix=trim(runid) sep1='_' sep2='.' - endif - write(tstamp,'(i4.4,a1,i2.2,a1,i2.2)') & - & date%year,sep2,date%month,sep2,date%day - fname_inv(iogrp) = prefix//sep1//trim(glb_fnametag(iogrp))//sep1// & - & 'i'//sep1//trim(tstamp)//'.nc' - - !--- create a new netCDF file - write(io_stdo_bgc,*) 'Create BGC inventory file : ',trim(fname_inv(iogrp)) - call nccheck( NF90_CREATE(trim(fname_inv(iogrp)), NF90_CLOBBER, ncid) ) - - !--- set time information - timeunits=' ' - write(timeunits,'(a11,i4.4,a1,i2.2,a1,i2.2,a6)') & - & 'days since ',date0%year,'-',date0%month,'-',date0%day,' 00:00' - - !--- Define global attributes - call nccheck( NF90_PUT_ATT(ncid, NF90_GLOBAL, 'title', & - & 'Global inventory for marine bgc') ) - call nccheck( NF90_PUT_ATT(ncid, NF90_GLOBAL, 'history', & - & 'Global inventory for marine bgc') ) - call nccheck( NF90_PUT_ATT(ncid, NF90_GLOBAL, 'date', timeunits) ) - - !--- Define dimensions - if (.not. use_sedbypass) then + endif + write(tstamp,'(i4.4,a1,i2.2,a1,i2.2)') & + & date%year,sep2,date%month,sep2,date%day + fname_inv(iogrp) = prefix//sep1//trim(glb_fnametag(iogrp))//sep1// & + & 'i'//sep1//trim(tstamp)//'.nc' + + !--- create a new netCDF file + write(io_stdo_bgc,*) 'Create BGC inventory file : ',trim(fname_inv(iogrp)) + call nccheck( NF90_CREATE(trim(fname_inv(iogrp)), NF90_CLOBBER, ncid) ) + + !--- set time information + timeunits=' ' + write(timeunits,'(a11,i4.4,a1,i2.2,a1,i2.2,a6)') & + & 'days since ',date0%year,'-',date0%month,'-',date0%day,' 00:00' + + !--- Define global attributes + call nccheck( NF90_PUT_ATT(ncid, NF90_GLOBAL, 'title', & + & 'Global inventory for marine bgc') ) + call nccheck( NF90_PUT_ATT(ncid, NF90_GLOBAL, 'history', & + & 'Global inventory for marine bgc') ) + call nccheck( NF90_PUT_ATT(ncid, NF90_GLOBAL, 'date', timeunits) ) + + !--- Define dimensions + 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) ) - endif - call nccheck( NF90_DEF_DIM(ncid, 'time', NF90_UNLIMITED, time_dimid) ) + endif + 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. - if (.not. use_sedbypass) then + !--- Dimensions for arrays. + !--- The unlimited "time" dimension must come last in the list of dimensions. + if (.not. use_sedbypass) then zpowtra_dimids = (/ npowtra_dimid, time_dimid /) zsedtra_dimids = (/ nsedtra_dimid, time_dimid /) - endif + endif - !--- 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') ) + !--- 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') ) - if (.not. use_sedbypass) then + if (.not. use_sedbypass) then !--- aqueous sediment tracers call nccheck( NF90_DEF_VAR(ncid, 'zsedtotvol', NF90_DOUBLE, time_dimid, & & zsedtotvol_varid) ) @@ -880,280 +880,280 @@ subroutine write_netcdf(iogrp) 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 - - !--- Define variables : oceanic tracers - call nccheck( NF90_DEF_VAR(ncid, 'ztotvol', NF90_DOUBLE, time_dimid, & - & ztotvol_varid) ) - call nccheck( NF90_PUT_ATT(ncid, ztotvol_varid, 'long_name', & - & 'Total ocean volume') ) - call nccheck( NF90_PUT_ATT(ncid, ztotvol_varid, 'units', 'm^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_sco212', NF90_DOUBLE, & - & time_dimid, zt_sco212_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_sco212_varid, 'long_name', & - & 'Total dissolved CO2 tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_sco212_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_sco212', NF90_DOUBLE, & - & time_dimid, zc_sco212_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_sco212_varid, 'long_name', & - & 'Mean dissolved CO2 concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_sco212_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_alkali', NF90_DOUBLE, & - & time_dimid, zt_alkali_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_alkali_varid, 'long_name', & - & 'Total alkalinity tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_alkali_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_alkali', NF90_DOUBLE, & - & time_dimid, zc_alkali_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_alkali_varid, 'long_name', & - & 'Mean alkalinity concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_alkali_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_phosph', NF90_DOUBLE, & - & time_dimid, zt_phosph_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_phosph_varid, 'long_name', & - & 'Total dissolved phosphate tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_phosph_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_phosph', NF90_DOUBLE, & - & time_dimid, zc_phosph_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_phosph_varid, 'long_name', & - & 'Mean dissolved phosphate concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_phosph_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_oxygen', NF90_DOUBLE, & - & time_dimid, zt_oxygen_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_oxygen_varid, 'long_name', & - & 'Total dissolved oxygen tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_oxygen_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_oxygen', NF90_DOUBLE, & - & time_dimid, zc_oxygen_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_oxygen_varid, 'long_name', & - & 'Mean dissolved oxygen concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_oxygen_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_gasnit', NF90_DOUBLE, & - & time_dimid, zt_gasnit_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_gasnit_varid, 'long_name', & - & 'Total gaseous nitrogen (N2) tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_gasnit_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_gasnit', NF90_DOUBLE, & - & time_dimid, zc_gasnit_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_gasnit_varid, 'long_name', & - & 'Mean gaseous nitrogen (N2) concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_gasnit_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_ano3', NF90_DOUBLE, & - & time_dimid, zt_ano3_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_ano3_varid, 'long_name', & - & 'Total dissolved nitrate tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_ano3_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_ano3', NF90_DOUBLE, & - & time_dimid, zc_ano3_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_ano3_varid, 'long_name', & - & 'Mean dissolved nitrate concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_ano3_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_silica', NF90_DOUBLE, & - & time_dimid, zt_silica_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_silica_varid, 'long_name', & - & 'Total silicid acid (Si(OH)4) tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_silica_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_silica', NF90_DOUBLE, & - & time_dimid, zc_silica_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_silica_varid, 'long_name', & - & 'Mean silicid acid (Si(OH)4) concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_silica_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_doc', NF90_DOUBLE, & - & time_dimid, zt_doc_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_doc_varid, 'long_name', & - & 'Total dissolved organic carbon tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_doc_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_doc', NF90_DOUBLE, & - & time_dimid, zc_doc_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_doc_varid, 'long_name', & - & 'Mean dissolved organic carbon concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_doc_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_poc', NF90_DOUBLE, & - & time_dimid, zt_poc_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_poc_varid, 'long_name', & - & 'Total particulate organic carbon tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_poc_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_poc', NF90_DOUBLE, & - & time_dimid, zc_poc_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_poc_varid, 'long_name', & - & 'Mean particulate organic carbon concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_poc_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_phyto', NF90_DOUBLE, & - & time_dimid, zt_phyto_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_phyto_varid, 'long_name', & - & 'Total phytoplankton tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_phyto_varid, 'units', 'kmolP') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_phyto', NF90_DOUBLE, & - & time_dimid, zc_phyto_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_phyto_varid, 'long_name', & - & 'Mean phytoplankton concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_phyto_varid, 'units', 'kmolP/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_grazer', NF90_DOUBLE, & - & time_dimid, zt_grazer_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_grazer_varid, 'long_name', & - & 'Total zooplankton tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_grazer_varid, 'units', 'kmolP') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_grazer', NF90_DOUBLE, & - & time_dimid, zc_grazer_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_grazer_varid, 'long_name', & - & 'Mean zooplankton concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_grazer_varid, 'units', 'kmolP/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_calciu', NF90_DOUBLE, & - & time_dimid, zt_calciu_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_calciu_varid, 'long_name', & - & 'Total calcium carbonate tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_calciu_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_calciu', NF90_DOUBLE, & - & time_dimid, zc_calciu_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_calciu_varid, 'long_name', & - & 'Mean calcium carbonate concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_calciu_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_opal', NF90_DOUBLE, & - & time_dimid, zt_opal_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_opal_varid, 'long_name', & - & 'Total biogenic silica tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_opal_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_opal', NF90_DOUBLE, & - & time_dimid, zc_opal_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_opal_varid, 'long_name', & - & 'Mean biogenic silica concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_opal_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_n2o', NF90_DOUBLE, & - & time_dimid, zt_n2o_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_n2o_varid, 'long_name', & - & 'Total laughing gas (N2O) tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_n2o_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_n2o', NF90_DOUBLE, & - & time_dimid, zc_n2o_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_n2o_varid, 'long_name', & - & 'Mean laughing gas (N2O) concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_n2o_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_dms', NF90_DOUBLE, & - & time_dimid, zt_dms_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_dms_varid, 'long_name', & - & 'Total DiMethylSulfide tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_dms_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_dms', NF90_DOUBLE, & - & time_dimid, zc_dms_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_dms_varid, 'long_name', & - & 'Mean DiMethylSulfide concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_dms_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_fdust', NF90_DOUBLE, & - & time_dimid, zt_fdust_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_fdust_varid, 'long_name', & - & 'Total non-aggregated dust tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_fdust_varid, 'units', 'Mg') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_fdust', NF90_DOUBLE, & - & time_dimid, zc_fdust_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_fdust_varid, 'long_name', & - & 'Mean non-aggregate dust concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_fdust_varid, 'units', 'Mg/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_iron', NF90_DOUBLE, & - & time_dimid, zt_iron_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_iron_varid, 'long_name', & - & 'Total dissolved iron tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_iron_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_iron', NF90_DOUBLE, & - & time_dimid, zc_iron_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_iron_varid, 'long_name', & - & 'Mean dissolved iron concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_iron_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_prefo2', NF90_DOUBLE, & - & time_dimid, zt_prefo2_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_prefo2_varid, 'long_name', & - & 'Total preformed oxygen tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_prefo2_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_prefo2', NF90_DOUBLE, & - & time_dimid, zc_prefo2_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_prefo2_varid, 'long_name', & - & 'Mean preformed oxygen concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_prefo2_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_prefpo4', NF90_DOUBLE, & - & time_dimid, zt_prefpo4_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_prefpo4_varid, 'long_name', & - & 'Total preformed phosphate tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_prefpo4_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_prefpo4', NF90_DOUBLE, & - & time_dimid, zc_prefpo4_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_prefpo4_varid, 'long_name', & - & 'Mean preformed phosphate concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_prefpo4_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_prefalk', NF90_DOUBLE, & - & time_dimid, zt_prefalk_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_prefalk_varid, 'long_name', & - & 'Total preformed alkalinity tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_prefalk_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_prefalk', NF90_DOUBLE, & - & time_dimid, zc_prefalk_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_prefalk_varid, 'long_name', & - & 'Mean preformed alkalinity concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_prefalk_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_prefdic', NF90_DOUBLE, & - & time_dimid, zt_prefdic_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_prefdic_varid, 'long_name', & - & 'Total preformed DIC tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_prefdic_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_prefdic', NF90_DOUBLE, & - & time_dimid, zc_prefdic_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_prefdic_varid, 'long_name', & - & 'Mean preformed DIC concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_prefdic_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_dicsat', NF90_DOUBLE, & - & time_dimid, zt_dicsat_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_dicsat_varid, 'long_name', & - & 'Total saturated DIC tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_dicsat_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_dicsat', NF90_DOUBLE, & - & time_dimid, zc_dicsat_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_dicsat_varid, 'long_name', & - & 'Mean saturated DIC concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_dicsat_varid, 'units', 'kmol/m^3') ) - - if (use_cisonew) then + endif + + !--- Define variables : oceanic tracers + call nccheck( NF90_DEF_VAR(ncid, 'ztotvol', NF90_DOUBLE, time_dimid, & + & ztotvol_varid) ) + call nccheck( NF90_PUT_ATT(ncid, ztotvol_varid, 'long_name', & + & 'Total ocean volume') ) + call nccheck( NF90_PUT_ATT(ncid, ztotvol_varid, 'units', 'm^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_sco212', NF90_DOUBLE, & + & time_dimid, zt_sco212_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_sco212_varid, 'long_name', & + & 'Total dissolved CO2 tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_sco212_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_sco212', NF90_DOUBLE, & + & time_dimid, zc_sco212_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_sco212_varid, 'long_name', & + & 'Mean dissolved CO2 concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_sco212_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_alkali', NF90_DOUBLE, & + & time_dimid, zt_alkali_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_alkali_varid, 'long_name', & + & 'Total alkalinity tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_alkali_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_alkali', NF90_DOUBLE, & + & time_dimid, zc_alkali_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_alkali_varid, 'long_name', & + & 'Mean alkalinity concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_alkali_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_phosph', NF90_DOUBLE, & + & time_dimid, zt_phosph_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_phosph_varid, 'long_name', & + & 'Total dissolved phosphate tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_phosph_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_phosph', NF90_DOUBLE, & + & time_dimid, zc_phosph_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_phosph_varid, 'long_name', & + & 'Mean dissolved phosphate concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_phosph_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_oxygen', NF90_DOUBLE, & + & time_dimid, zt_oxygen_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_oxygen_varid, 'long_name', & + & 'Total dissolved oxygen tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_oxygen_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_oxygen', NF90_DOUBLE, & + & time_dimid, zc_oxygen_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_oxygen_varid, 'long_name', & + & 'Mean dissolved oxygen concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_oxygen_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_gasnit', NF90_DOUBLE, & + & time_dimid, zt_gasnit_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_gasnit_varid, 'long_name', & + & 'Total gaseous nitrogen (N2) tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_gasnit_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_gasnit', NF90_DOUBLE, & + & time_dimid, zc_gasnit_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_gasnit_varid, 'long_name', & + & 'Mean gaseous nitrogen (N2) concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_gasnit_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_ano3', NF90_DOUBLE, & + & time_dimid, zt_ano3_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_ano3_varid, 'long_name', & + & 'Total dissolved nitrate tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_ano3_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_ano3', NF90_DOUBLE, & + & time_dimid, zc_ano3_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_ano3_varid, 'long_name', & + & 'Mean dissolved nitrate concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_ano3_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_silica', NF90_DOUBLE, & + & time_dimid, zt_silica_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_silica_varid, 'long_name', & + & 'Total silicid acid (Si(OH)4) tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_silica_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_silica', NF90_DOUBLE, & + & time_dimid, zc_silica_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_silica_varid, 'long_name', & + & 'Mean silicid acid (Si(OH)4) concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_silica_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_doc', NF90_DOUBLE, & + & time_dimid, zt_doc_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_doc_varid, 'long_name', & + & 'Total dissolved organic carbon tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_doc_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_doc', NF90_DOUBLE, & + & time_dimid, zc_doc_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_doc_varid, 'long_name', & + & 'Mean dissolved organic carbon concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_doc_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_poc', NF90_DOUBLE, & + & time_dimid, zt_poc_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_poc_varid, 'long_name', & + & 'Total particulate organic carbon tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_poc_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_poc', NF90_DOUBLE, & + & time_dimid, zc_poc_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_poc_varid, 'long_name', & + & 'Mean particulate organic carbon concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_poc_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_phyto', NF90_DOUBLE, & + & time_dimid, zt_phyto_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_phyto_varid, 'long_name', & + & 'Total phytoplankton tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_phyto_varid, 'units', 'kmolP') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_phyto', NF90_DOUBLE, & + & time_dimid, zc_phyto_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_phyto_varid, 'long_name', & + & 'Mean phytoplankton concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_phyto_varid, 'units', 'kmolP/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_grazer', NF90_DOUBLE, & + & time_dimid, zt_grazer_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_grazer_varid, 'long_name', & + & 'Total zooplankton tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_grazer_varid, 'units', 'kmolP') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_grazer', NF90_DOUBLE, & + & time_dimid, zc_grazer_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_grazer_varid, 'long_name', & + & 'Mean zooplankton concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_grazer_varid, 'units', 'kmolP/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_calciu', NF90_DOUBLE, & + & time_dimid, zt_calciu_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_calciu_varid, 'long_name', & + & 'Total calcium carbonate tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_calciu_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_calciu', NF90_DOUBLE, & + & time_dimid, zc_calciu_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_calciu_varid, 'long_name', & + & 'Mean calcium carbonate concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_calciu_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_opal', NF90_DOUBLE, & + & time_dimid, zt_opal_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_opal_varid, 'long_name', & + & 'Total biogenic silica tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_opal_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_opal', NF90_DOUBLE, & + & time_dimid, zc_opal_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_opal_varid, 'long_name', & + & 'Mean biogenic silica concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_opal_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_n2o', NF90_DOUBLE, & + & time_dimid, zt_n2o_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_n2o_varid, 'long_name', & + & 'Total laughing gas (N2O) tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_n2o_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_n2o', NF90_DOUBLE, & + & time_dimid, zc_n2o_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_n2o_varid, 'long_name', & + & 'Mean laughing gas (N2O) concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_n2o_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_dms', NF90_DOUBLE, & + & time_dimid, zt_dms_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_dms_varid, 'long_name', & + & 'Total DiMethylSulfide tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_dms_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_dms', NF90_DOUBLE, & + & time_dimid, zc_dms_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_dms_varid, 'long_name', & + & 'Mean DiMethylSulfide concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_dms_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_fdust', NF90_DOUBLE, & + & time_dimid, zt_fdust_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_fdust_varid, 'long_name', & + & 'Total non-aggregated dust tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_fdust_varid, 'units', 'Mg') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_fdust', NF90_DOUBLE, & + & time_dimid, zc_fdust_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_fdust_varid, 'long_name', & + & 'Mean non-aggregate dust concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_fdust_varid, 'units', 'Mg/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_iron', NF90_DOUBLE, & + & time_dimid, zt_iron_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_iron_varid, 'long_name', & + & 'Total dissolved iron tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_iron_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_iron', NF90_DOUBLE, & + & time_dimid, zc_iron_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_iron_varid, 'long_name', & + & 'Mean dissolved iron concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_iron_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_prefo2', NF90_DOUBLE, & + & time_dimid, zt_prefo2_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_prefo2_varid, 'long_name', & + & 'Total preformed oxygen tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_prefo2_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_prefo2', NF90_DOUBLE, & + & time_dimid, zc_prefo2_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_prefo2_varid, 'long_name', & + & 'Mean preformed oxygen concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_prefo2_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_prefpo4', NF90_DOUBLE, & + & time_dimid, zt_prefpo4_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_prefpo4_varid, 'long_name', & + & 'Total preformed phosphate tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_prefpo4_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_prefpo4', NF90_DOUBLE, & + & time_dimid, zc_prefpo4_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_prefpo4_varid, 'long_name', & + & 'Mean preformed phosphate concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_prefpo4_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_prefalk', NF90_DOUBLE, & + & time_dimid, zt_prefalk_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_prefalk_varid, 'long_name', & + & 'Total preformed alkalinity tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_prefalk_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_prefalk', NF90_DOUBLE, & + & time_dimid, zc_prefalk_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_prefalk_varid, 'long_name', & + & 'Mean preformed alkalinity concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_prefalk_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_prefdic', NF90_DOUBLE, & + & time_dimid, zt_prefdic_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_prefdic_varid, 'long_name', & + & 'Total preformed DIC tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_prefdic_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_prefdic', NF90_DOUBLE, & + & time_dimid, zc_prefdic_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_prefdic_varid, 'long_name', & + & 'Mean preformed DIC concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_prefdic_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_dicsat', NF90_DOUBLE, & + & time_dimid, zt_dicsat_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_dicsat_varid, 'long_name', & + & 'Total saturated DIC tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_dicsat_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_dicsat', NF90_DOUBLE, & + & time_dimid, zc_dicsat_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_dicsat_varid, 'long_name', & + & 'Mean saturated DIC concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_dicsat_varid, 'units', 'kmol/m^3') ) + + 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', & @@ -1299,9 +1299,9 @@ subroutine write_netcdf(iogrp) 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 + endif - if (use_AGG) then + 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', & @@ -1325,9 +1325,9 @@ subroutine write_netcdf(iogrp) 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 + endif - if (use_CFC) then + 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', & @@ -1363,9 +1363,9 @@ subroutine write_netcdf(iogrp) 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 + endif - if (use_natDIC) then + 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', & @@ -1404,9 +1404,9 @@ subroutine write_netcdf(iogrp) & 'Mean natural calcium carbonate concentration') ) call nccheck( NF90_PUT_ATT(ncid, zc_natcalciu_varid, 'units', & & 'kmol/m^3') ) - endif + endif - if (use_BROMO) then + 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', & @@ -1418,94 +1418,94 @@ subroutine write_netcdf(iogrp) 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 - - !--- Define variables : sum of inventory - call nccheck( NF90_DEF_VAR(ncid, 'totcarb', NF90_DOUBLE, time_dimid, & - & totcarb_varid) ) - call nccheck( NF90_PUT_ATT(ncid, totcarb_varid, 'long_name', & - & 'Global total of carbon') ) - call nccheck( NF90_PUT_ATT(ncid, totcarb_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'totphos', NF90_DOUBLE, time_dimid, & - & totphos_varid) ) - call nccheck( NF90_PUT_ATT(ncid, totphos_varid, 'long_name', & - & 'Global total of phosphorous') ) - call nccheck( NF90_PUT_ATT(ncid, totphos_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'totsili', NF90_DOUBLE, time_dimid, & - & totsili_varid) ) - call nccheck( NF90_PUT_ATT(ncid, totsili_varid, 'long_name', & - & 'Global total of silicate') ) - call nccheck( NF90_PUT_ATT(ncid, totsili_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'totnitr', NF90_DOUBLE, time_dimid, & - & totnitr_varid) ) - call nccheck( NF90_PUT_ATT(ncid, totnitr_varid, 'long_name', & - & 'Global total of nitrogen') ) - call nccheck( NF90_PUT_ATT(ncid, totnitr_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'totoxyg', NF90_DOUBLE, time_dimid, & - & totoxyg_varid) ) - call nccheck( NF90_PUT_ATT(ncid, totoxyg_varid, 'long_name', & - & 'Global total of oxygen') ) - call nccheck( NF90_PUT_ATT(ncid, totoxyg_varid, 'units', 'kmol') ) - - !--- Define variables : sediment fluxes - call nccheck( NF90_DEF_VAR(ncid, 'sum_zprorca', NF90_DOUBLE, & - & time_dimid, sum_zprorca_varid) ) - call nccheck( NF90_PUT_ATT(ncid, sum_zprorca_varid, 'long_name', & - & 'Global flux of detritus into sediments') ) - call nccheck( NF90_PUT_ATT(ncid, sum_zprorca_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'sum_zprcaca', NF90_DOUBLE, & - & time_dimid, sum_zprcaca_varid) ) - call nccheck( NF90_PUT_ATT(ncid, sum_zprcaca_varid, 'long_name', & - & 'Global flux of calcium carbonate into sediments') ) - call nccheck( NF90_PUT_ATT(ncid, sum_zprcaca_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'sum_zsilpro', NF90_DOUBLE, & - & time_dimid, sum_zsilpro_varid) ) - call nccheck( NF90_PUT_ATT(ncid, sum_zsilpro_varid, 'long_name', & - & 'Global flux of silicate into sediments') ) - call nccheck( NF90_PUT_ATT(ncid, sum_zsilpro_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'sum_expoor', NF90_DOUBLE, & - & time_dimid, sum_expoor_varid) ) - call nccheck( NF90_PUT_ATT(ncid, sum_expoor_varid, 'long_name', & - & 'Global total export production of carbon') ) - call nccheck( NF90_PUT_ATT(ncid, sum_expoor_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'sum_expoca', NF90_DOUBLE, & - & time_dimid, sum_expoca_varid) ) - call nccheck( NF90_PUT_ATT(ncid, sum_expoca_varid, 'long_name', & - & 'Global total export production of carbonate') ) - call nccheck( NF90_PUT_ATT(ncid, sum_expoca_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'sum_exposi', NF90_DOUBLE, & - & time_dimid, sum_exposi_varid) ) - call nccheck( NF90_PUT_ATT(ncid, sum_exposi_varid, 'long_name', & - & 'Global total export production of silicate') ) - call nccheck( NF90_PUT_ATT(ncid, sum_exposi_varid, 'units', 'kmol') ) - - !--- End define mode. - call nccheck( NF90_ENDDEF(ncid) ) - - else - !=== Open existing netCDF file - write(io_stdo_bgc,*) 'Write BGC inventory to file : ', & - & trim(fname_inv(iogrp)) - call nccheck( NF90_OPEN(trim(fname_inv(iogrp)), NF90_WRITE, ncid) ) - !--- Inquire dimid - call nccheck( NF90_INQ_DIMID(ncid, "time", time_dimid) ) - if (.not. use_sedbypass) then + endif + + !--- Define variables : sum of inventory + call nccheck( NF90_DEF_VAR(ncid, 'totcarb', NF90_DOUBLE, time_dimid, & + & totcarb_varid) ) + call nccheck( NF90_PUT_ATT(ncid, totcarb_varid, 'long_name', & + & 'Global total of carbon') ) + call nccheck( NF90_PUT_ATT(ncid, totcarb_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'totphos', NF90_DOUBLE, time_dimid, & + & totphos_varid) ) + call nccheck( NF90_PUT_ATT(ncid, totphos_varid, 'long_name', & + & 'Global total of phosphorous') ) + call nccheck( NF90_PUT_ATT(ncid, totphos_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'totsili', NF90_DOUBLE, time_dimid, & + & totsili_varid) ) + call nccheck( NF90_PUT_ATT(ncid, totsili_varid, 'long_name', & + & 'Global total of silicate') ) + call nccheck( NF90_PUT_ATT(ncid, totsili_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'totnitr', NF90_DOUBLE, time_dimid, & + & totnitr_varid) ) + call nccheck( NF90_PUT_ATT(ncid, totnitr_varid, 'long_name', & + & 'Global total of nitrogen') ) + call nccheck( NF90_PUT_ATT(ncid, totnitr_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'totoxyg', NF90_DOUBLE, time_dimid, & + & totoxyg_varid) ) + call nccheck( NF90_PUT_ATT(ncid, totoxyg_varid, 'long_name', & + & 'Global total of oxygen') ) + call nccheck( NF90_PUT_ATT(ncid, totoxyg_varid, 'units', 'kmol') ) + + !--- Define variables : sediment fluxes + call nccheck( NF90_DEF_VAR(ncid, 'sum_zprorca', NF90_DOUBLE, & + & time_dimid, sum_zprorca_varid) ) + call nccheck( NF90_PUT_ATT(ncid, sum_zprorca_varid, 'long_name', & + & 'Global flux of detritus into sediments') ) + call nccheck( NF90_PUT_ATT(ncid, sum_zprorca_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'sum_zprcaca', NF90_DOUBLE, & + & time_dimid, sum_zprcaca_varid) ) + call nccheck( NF90_PUT_ATT(ncid, sum_zprcaca_varid, 'long_name', & + & 'Global flux of calcium carbonate into sediments') ) + call nccheck( NF90_PUT_ATT(ncid, sum_zprcaca_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'sum_zsilpro', NF90_DOUBLE, & + & time_dimid, sum_zsilpro_varid) ) + call nccheck( NF90_PUT_ATT(ncid, sum_zsilpro_varid, 'long_name', & + & 'Global flux of silicate into sediments') ) + call nccheck( NF90_PUT_ATT(ncid, sum_zsilpro_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'sum_expoor', NF90_DOUBLE, & + & time_dimid, sum_expoor_varid) ) + call nccheck( NF90_PUT_ATT(ncid, sum_expoor_varid, 'long_name', & + & 'Global total export production of carbon') ) + call nccheck( NF90_PUT_ATT(ncid, sum_expoor_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'sum_expoca', NF90_DOUBLE, & + & time_dimid, sum_expoca_varid) ) + call nccheck( NF90_PUT_ATT(ncid, sum_expoca_varid, 'long_name', & + & 'Global total export production of carbonate') ) + call nccheck( NF90_PUT_ATT(ncid, sum_expoca_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'sum_exposi', NF90_DOUBLE, & + & time_dimid, sum_exposi_varid) ) + call nccheck( NF90_PUT_ATT(ncid, sum_exposi_varid, 'long_name', & + & 'Global total export production of silicate') ) + call nccheck( NF90_PUT_ATT(ncid, sum_exposi_varid, 'units', 'kmol') ) + + !--- End define mode. + call nccheck( NF90_ENDDEF(ncid) ) + + else + !=== Open existing netCDF file + write(io_stdo_bgc,*) 'Write BGC inventory to file : ', & + & trim(fname_inv(iogrp)) + call nccheck( NF90_OPEN(trim(fname_inv(iogrp)), NF90_WRITE, ncid) ) + !--- Inquire dimid + call nccheck( NF90_INQ_DIMID(ncid, "time", time_dimid) ) + if (.not. use_sedbypass) then call nccheck( NF90_INQ_DIMID(ncid, 'npowtra', npowtra_dimid) ) call nccheck( NF90_INQ_DIMID(ncid, 'nsedtra', nsedtra_dimid) ) - endif - !--- Inquire varid : time - call nccheck( NF90_INQ_VARID(ncid, "time", time_varid) ) + endif + !--- Inquire varid : time + call nccheck( NF90_INQ_VARID(ncid, "time", time_varid) ) - if (.not. use_sedbypass) then + 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) ) @@ -1514,55 +1514,55 @@ subroutine write_netcdf(iogrp) 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 - - !--- Inquire varid : ocean tracers - call nccheck( NF90_INQ_VARID(ncid, "ztotvol", ztotvol_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_sco212", zt_sco212_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_sco212", zc_sco212_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_alkali", zt_alkali_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_alkali", zc_alkali_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_phosph", zt_phosph_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_phosph", zc_phosph_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_oxygen", zt_oxygen_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_oxygen", zc_oxygen_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_gasnit", zt_gasnit_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_gasnit", zc_gasnit_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_ano3", zt_ano3_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_ano3", zc_ano3_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_silica", zt_silica_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_silica", zc_silica_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_doc", zt_doc_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_doc", zc_doc_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_poc", zt_poc_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_poc", zc_poc_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_phyto", zt_phyto_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_phyto", zc_phyto_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_grazer", zt_grazer_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_grazer", zc_grazer_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_calciu", zt_calciu_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_calciu", zc_calciu_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_opal", zt_opal_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_opal", zc_opal_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_n2o", zt_n2o_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_n2o", zc_n2o_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_dms", zt_dms_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_dms", zc_dms_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_fdust", zt_fdust_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_fdust", zc_fdust_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_iron", zt_iron_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_iron", zc_iron_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_prefo2", zt_prefo2_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_prefo2", zc_prefo2_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_prefpo4", zt_prefpo4_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_prefpo4", zc_prefpo4_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_prefalk", zt_prefalk_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_prefalk", zc_prefalk_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_prefdic", zt_prefdic_varid) ) - 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) ) - if (use_cisonew) then + endif + + !--- Inquire varid : ocean tracers + call nccheck( NF90_INQ_VARID(ncid, "ztotvol", ztotvol_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_sco212", zt_sco212_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_sco212", zc_sco212_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_alkali", zt_alkali_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_alkali", zc_alkali_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_phosph", zt_phosph_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_phosph", zc_phosph_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_oxygen", zt_oxygen_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_oxygen", zc_oxygen_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_gasnit", zt_gasnit_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_gasnit", zc_gasnit_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_ano3", zt_ano3_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_ano3", zc_ano3_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_silica", zt_silica_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_silica", zc_silica_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_doc", zt_doc_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_doc", zc_doc_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_poc", zt_poc_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_poc", zc_poc_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_phyto", zt_phyto_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_phyto", zc_phyto_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_grazer", zt_grazer_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_grazer", zc_grazer_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_calciu", zt_calciu_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_calciu", zc_calciu_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_opal", zt_opal_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_opal", zc_opal_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_n2o", zt_n2o_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_n2o", zc_n2o_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_dms", zt_dms_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_dms", zc_dms_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_fdust", zt_fdust_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_fdust", zc_fdust_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_iron", zt_iron_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_iron", zc_iron_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_prefo2", zt_prefo2_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_prefo2", zc_prefo2_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_prefpo4", zt_prefpo4_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_prefpo4", zc_prefpo4_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_prefalk", zt_prefalk_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_prefalk", zc_prefalk_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_prefdic", zt_prefdic_varid) ) + 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) ) + 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) ) @@ -1587,318 +1587,318 @@ subroutine write_netcdf(iogrp) 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 - if (use_AGG) then + endif + 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) ) - endif - if (use_CFC) then + endif + 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) ) - endif - if (use_natDIC) then + endif + 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) ) - endif - if (use_BROMO) then + endif + 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) ) - endif - !--- Inquire varid : sum of inventory - call nccheck( NF90_INQ_VARID(ncid, "totcarb", totcarb_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "totphos", totphos_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "totsili", totsili_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "totnitr", totnitr_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "totoxyg", totoxyg_varid) ) - !--- Inquire varid : sediment fluxes - call nccheck( NF90_INQ_VARID(ncid, "sum_zprorca", sum_zprorca_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "sum_zprcaca", sum_zprcaca_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "sum_zsilpro", sum_zsilpro_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "sum_expoor", sum_expoor_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "sum_expoca", sum_expoca_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "sum_exposi", sum_exposi_varid) ) - endif - - !=== Increment record by 1, reset start and count arrays - ncrec(iogrp) = ncrec(iogrp) + 1 - wrstart = (/ ncrec(iogrp) /) - if (.not. use_sedbypass) then - zpowtra_wrstart = (/ 1, ncrec(iogrp) /) - zpowtra_count = (/ npowtra, 1 /) - zsedtra_wrstart = (/ 1, ncrec(iogrp) /) - zsedtra_count = (/ nsedtra, 1 /) - endif - - !=== Write output data to netCDF file - !--- Write data : time - datenum = time - time0 - call nccheck( NF90_PUT_VAR(ncid, time_varid, datenum, start = wrstart) ) - 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) ) - endif - !--- Write data : ocean tracers - call nccheck( NF90_PUT_VAR(ncid, ztotvol_varid, ztotvol, start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_sco212_varid, & - & zocetratot(isco212), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_sco212_varid, & - & zocetratoc(isco212), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_alkali_varid, & - & zocetratot(ialkali), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_alkali_varid, & - & zocetratoc(ialkali), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_phosph_varid, & - & zocetratot(iphosph), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_phosph_varid, & - & zocetratoc(iphosph), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_oxygen_varid, & - & zocetratot(ioxygen), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_oxygen_varid, & - & zocetratoc(ioxygen), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_gasnit_varid, & - & zocetratot(igasnit), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_gasnit_varid, & - & zocetratoc(igasnit), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_ano3_varid, & - & zocetratot(iano3), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_ano3_varid, & - & zocetratoc(iano3), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_silica_varid, & - & zocetratot(isilica), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_silica_varid, & - & zocetratoc(isilica), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_doc_varid, & - & zocetratot(idoc), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_doc_varid, & - & zocetratoc(idoc), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_poc_varid, & - & zocetratot(idet), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_poc_varid, & - & zocetratoc(idet), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_phyto_varid, & - & zocetratot(iphy), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_phyto_varid, & - & zocetratoc(iphy), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_grazer_varid, & - & zocetratot(izoo), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_grazer_varid, & - & zocetratoc(izoo), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_calciu_varid, & - & zocetratot(icalc), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_calciu_varid, & - & zocetratoc(icalc), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_opal_varid, & - & zocetratot(iopal), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_opal_varid, & - & zocetratoc(iopal), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_n2o_varid, & - & zocetratot(ian2o), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_n2o_varid, & - & zocetratoc(ian2o), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_dms_varid, & - & zocetratot(idms), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_dms_varid, & - & zocetratoc(idms), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_fdust_varid, & - & zocetratot(ifdust), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_fdust_varid, & - & zocetratoc(ifdust), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_iron_varid, & - & zocetratot(iiron), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_iron_varid, & - & zocetratoc(iiron), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_prefo2_varid, & - & zocetratot(iprefo2), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_prefo2_varid, & - & zocetratoc(iprefo2), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_prefpo4_varid, & - & zocetratot(iprefpo4), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_prefpo4_varid, & - & zocetratoc(iprefpo4), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_prefalk_varid, & - & zocetratot(iprefalk), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_prefalk_varid, & - & zocetratoc(iprefalk), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_prefdic_varid, & - & zocetratot(iprefdic), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_prefdic_varid, & - & zocetratoc(iprefdic), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_dicsat_varid, & - & zocetratot(idicsat), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_dicsat_varid, & - & zocetratoc(idicsat), start = wrstart) ) - 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) ) - endif - 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) ) - endif - 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) ) - endif - 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) ) - endif - 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) ) - endif - !--- Write data : sum of inventory - call nccheck( NF90_PUT_VAR(ncid, totcarb_varid, totalcarbon, & - & start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, totphos_varid, totalphos, & - & start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, totsili_varid, totalsil, & - & start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, totnitr_varid, totalnitr, & - & start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, totoxyg_varid, totaloxy, & - & start = wrstart) ) - !--- Write data : fluxes into sediments - call nccheck( NF90_PUT_VAR(ncid, sum_zprorca_varid, sum_zprorca, & - & start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, sum_zprcaca_varid, sum_zprcaca, & - & start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, sum_zsilpro_varid, sum_zsilpro, & - & start = wrstart) ) - !--- Write data : global total export production - call nccheck( NF90_PUT_VAR(ncid, sum_expoor_varid, sum_expoor, & - & start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, sum_expoca_varid, sum_expoca, & - & start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, sum_exposi_varid, sum_exposi, & - & start = wrstart) ) - - !--- Close netCDF file - call nccheck( NF90_CLOSE(ncid) ) - - !=== Check if file should be appended next time inventory routine is called - if (( (fileann_bgc(iogrp) .and. nday_of_year == 1 .or. & - & filemon_bgc(iogrp) .and. date%day == 1) .and. & - & mod(nstep, nstep_in_day) == 0) .or. & - & .not.(fileann_bgc(iogrp) .or. filemon_bgc(iogrp)) .and. & - & mod(nstep + .5, filefq_bgc(iogrp)) < 1.) then - append2file_inv(iogrp) = .false. - ncrec(iogrp) = 0 - else - append2file_inv(iogrp) = .true. - endif - -end subroutine write_netcdf - - -subroutine nccheck(status) - use netcdf, only: nf90_noerr - use mod_xc, only: xchalt - implicit none - - integer, intent(in) :: status - - if (status /= nf90_noerr) then - call xchalt('(inventory_bgc: Problem with netCDF)') - stop '(inventory_bgc: Problem with netCDF)' - endif -end subroutine nccheck + endif + !--- Inquire varid : sum of inventory + call nccheck( NF90_INQ_VARID(ncid, "totcarb", totcarb_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "totphos", totphos_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "totsili", totsili_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "totnitr", totnitr_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "totoxyg", totoxyg_varid) ) + !--- Inquire varid : sediment fluxes + call nccheck( NF90_INQ_VARID(ncid, "sum_zprorca", sum_zprorca_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "sum_zprcaca", sum_zprcaca_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "sum_zsilpro", sum_zsilpro_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "sum_expoor", sum_expoor_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "sum_expoca", sum_expoca_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "sum_exposi", sum_exposi_varid) ) + endif + + !=== Increment record by 1, reset start and count arrays + ncrec(iogrp) = ncrec(iogrp) + 1 + wrstart = (/ ncrec(iogrp) /) + if (.not. use_sedbypass) then + zpowtra_wrstart = (/ 1, ncrec(iogrp) /) + zpowtra_count = (/ npowtra, 1 /) + zsedtra_wrstart = (/ 1, ncrec(iogrp) /) + zsedtra_count = (/ nsedtra, 1 /) + endif + + !=== Write output data to netCDF file + !--- Write data : time + datenum = time - time0 + call nccheck( NF90_PUT_VAR(ncid, time_varid, datenum, start = wrstart) ) + 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) ) + endif + !--- Write data : ocean tracers + call nccheck( NF90_PUT_VAR(ncid, ztotvol_varid, ztotvol, start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_sco212_varid, & + & zocetratot(isco212), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_sco212_varid, & + & zocetratoc(isco212), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_alkali_varid, & + & zocetratot(ialkali), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_alkali_varid, & + & zocetratoc(ialkali), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_phosph_varid, & + & zocetratot(iphosph), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_phosph_varid, & + & zocetratoc(iphosph), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_oxygen_varid, & + & zocetratot(ioxygen), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_oxygen_varid, & + & zocetratoc(ioxygen), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_gasnit_varid, & + & zocetratot(igasnit), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_gasnit_varid, & + & zocetratoc(igasnit), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_ano3_varid, & + & zocetratot(iano3), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_ano3_varid, & + & zocetratoc(iano3), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_silica_varid, & + & zocetratot(isilica), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_silica_varid, & + & zocetratoc(isilica), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_doc_varid, & + & zocetratot(idoc), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_doc_varid, & + & zocetratoc(idoc), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_poc_varid, & + & zocetratot(idet), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_poc_varid, & + & zocetratoc(idet), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_phyto_varid, & + & zocetratot(iphy), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_phyto_varid, & + & zocetratoc(iphy), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_grazer_varid, & + & zocetratot(izoo), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_grazer_varid, & + & zocetratoc(izoo), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_calciu_varid, & + & zocetratot(icalc), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_calciu_varid, & + & zocetratoc(icalc), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_opal_varid, & + & zocetratot(iopal), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_opal_varid, & + & zocetratoc(iopal), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_n2o_varid, & + & zocetratot(ian2o), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_n2o_varid, & + & zocetratoc(ian2o), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_dms_varid, & + & zocetratot(idms), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_dms_varid, & + & zocetratoc(idms), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_fdust_varid, & + & zocetratot(ifdust), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_fdust_varid, & + & zocetratoc(ifdust), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_iron_varid, & + & zocetratot(iiron), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_iron_varid, & + & zocetratoc(iiron), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_prefo2_varid, & + & zocetratot(iprefo2), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_prefo2_varid, & + & zocetratoc(iprefo2), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_prefpo4_varid, & + & zocetratot(iprefpo4), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_prefpo4_varid, & + & zocetratoc(iprefpo4), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_prefalk_varid, & + & zocetratot(iprefalk), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_prefalk_varid, & + & zocetratoc(iprefalk), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_prefdic_varid, & + & zocetratot(iprefdic), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_prefdic_varid, & + & zocetratoc(iprefdic), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_dicsat_varid, & + & zocetratot(idicsat), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_dicsat_varid, & + & zocetratoc(idicsat), start = wrstart) ) + 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) ) + endif + 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) ) + endif + 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) ) + endif + 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) ) + endif + 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) ) + endif + !--- Write data : sum of inventory + call nccheck( NF90_PUT_VAR(ncid, totcarb_varid, totalcarbon, & + & start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, totphos_varid, totalphos, & + & start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, totsili_varid, totalsil, & + & start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, totnitr_varid, totalnitr, & + & start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, totoxyg_varid, totaloxy, & + & start = wrstart) ) + !--- Write data : fluxes into sediments + call nccheck( NF90_PUT_VAR(ncid, sum_zprorca_varid, sum_zprorca, & + & start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, sum_zprcaca_varid, sum_zprcaca, & + & start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, sum_zsilpro_varid, sum_zsilpro, & + & start = wrstart) ) + !--- Write data : global total export production + call nccheck( NF90_PUT_VAR(ncid, sum_expoor_varid, sum_expoor, & + & start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, sum_expoca_varid, sum_expoca, & + & start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, sum_exposi_varid, sum_exposi, & + & start = wrstart) ) + + !--- Close netCDF file + call nccheck( NF90_CLOSE(ncid) ) + + !=== Check if file should be appended next time inventory routine is called + if (( (fileann_bgc(iogrp) .and. nday_of_year == 1 .or. & + & filemon_bgc(iogrp) .and. date%day == 1) .and. & + & mod(nstep, nstep_in_day) == 0) .or. & + & .not.(fileann_bgc(iogrp) .or. filemon_bgc(iogrp)) .and. & + & mod(nstep + .5, filefq_bgc(iogrp)) < 1.) then + append2file_inv(iogrp) = .false. + ncrec(iogrp) = 0 + else + append2file_inv(iogrp) = .true. + endif + + end subroutine write_netcdf + + + subroutine nccheck(status) + use netcdf, only: nf90_noerr + use mod_xc, only: xchalt + implicit none + + integer, intent(in) :: status + + if (status /= nf90_noerr) then + call xchalt('(inventory_bgc: Problem with netCDF)') + stop '(inventory_bgc: Problem with netCDF)' + endif + end subroutine nccheck END SUBROUTINE INVENTORY_BGC diff --git a/hamocc/mo_Gdata_read.F90 b/hamocc/mo_Gdata_read.F90 index f885c056..d977d985 100644 --- a/hamocc/mo_Gdata_read.F90 +++ b/hamocc/mo_Gdata_read.F90 @@ -3,857 +3,857 @@ ! 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_Gdata_read -!******************************************************************************** -! J.Schwinger, *Gfi, Bergen* 2011-05-19 -! -! Modified -! -------- -! J.Schwinger, *Uni Climate, BCCR* 2017-07-07 -! - adapted this module to read the initial conditions for OMIP-BGC. -! -! J.Schwinger, *Uni Research, Bergen* 2018-04-12 -! - adaptions for reading c-isotope initial values as d13C and d14C -! -! Purpose -! ------- -! - Routines for reading initial condition files for OMIP-BGC, which are based -! on WOA 2013 and GLODAPv2 gridded data netCDF files -! -! Description: -! ------------ -! Public routines and variable of this module: -! -! -subroutine set_Gdata -! Initialise global varibles and read in one data set. Must be -! called before the processing of one data set starts. -! -! -subroutine clean_Gdata -! Deallocate global fields of this module and reset all global variables. -! Should be called each time, the processing of one data set is finished. -! -! -subroutine get_profile -! Returns one profile from the currently open data set (opened by a -! previous call to set_Gdata). See header of get profile for details. -! -! -function get_region -! Returns the index of the region a given point belongs to. If no region -! is found get_region returns 0, which is the index of the 'global region'. -! Note that the regions are defined below in the module header. -! -! -nz_woa -! Number of z-levels in the WOA data files. -! -! -nz_glo -! Number of z-levels in the GLODAP data files. -! -! -nzmax -! Max nuber of z-levels (=nzwoa) -! -! -zlev -! Depth of each z-level [m] in the current data file. -! -! -!******************************************************************************** - -use netcdf, only: nf90_noerr,nf90_nowrite,nf90_strerror,nf90_inq_dimid,nf90_inquire_dimension,nf90_inq_varid,nf90_get_var, & - & nf90_inquire_variable,nf90_get_att,nf90_close,nf90_open -use mod_xc, only: mnproc,xchalt -use mo_control_bgc, only: io_stdo_bgc - -implicit none - -private - -public :: set_Gdata,clean_Gdata,get_profile,get_region,nzmax,nz,zlev,zlev_bnds,fillval -public :: inidic,inialk,inipo4,inioxy,inino3,inisil,inid13c,inid14c - -! Number of latitudes, longitudes, and z-levels in the WOA and GLODAP data -integer, parameter :: nlon = 360 -integer, parameter :: nlat = 180 -integer, parameter :: nz_woa = 102 -integer, parameter :: nz_glo = 33 -integer, parameter :: nzmax = nz_woa -! Resolution of data in degree -real, parameter :: dres = 1.0 - - -! Max number of gridpoints to select around the center for averaging in -! longitude direction -integer, parameter :: dnmax = 100.0 - - -! Fill value used in this module, original fill values of data files are -! replaced by this fill value during read -real, parameter :: fillval = -1.e+32 - -! Input file names (incl. full path) set through namelist -character(len=256), save :: inidic = '' -character(len=256), save :: inialk = '' -character(len=256), save :: inipo4 = '' -character(len=256), save :: inioxy = '' -character(len=256), save :: inino3 = '' -character(len=256), save :: inisil = '' -character(len=256), save :: inid13c = '' -character(len=256), save :: inid14c = '' -character(len=256), save :: inic13 = '' ! currently not used -character(len=256), save :: inic14 = '' ! currently not used - -! Variables set by call to Gdata_set -integer, save :: nz -real, save :: cfac, ddeg -real, save, dimension(:), allocatable :: lon,lat,zlev -real, save, dimension(:,:), allocatable :: zlev_bnds -real, save, dimension(:, :, :), allocatable :: rvar,gdata -character(len=16), save :: var,ncname -character(len=3) , save :: dsrc -character(len=256), save :: infile - -logical, save :: lset = .false. - - -!----------------------------------------- -! Definitions for regional mean profiles: -!----------------------------------------- -type region - character(len=64) :: name ! Region name - integer :: idx ! Region index - integer :: npts(nzmax) ! nb of valid data points at each level - real :: clon, clat ! center longitude and latitude - real :: dlon, dlat ! latitude and longitude extent - real :: mprf(nzmax) ! mean profile for region - logical :: global ! global extent T/F -end type region - -integer, parameter :: nreg=10 -type(region) :: rg(0:nreg) - - -! Set regions for fall-back profiles - -! Global profile; -data rg(0)%idx, rg(0)%name / 0, 'global' / -data rg(0)%clon, rg(0)%clat / 0.0, 0.0 / -data rg(0)%dlon, rg(0)%dlat / 360.0, 180.0 / -data rg(0)%global / .true. / - -! Indian Ocean -data rg(1)%idx, rg(1)%name / 1, 'Indian Ocean' / -data rg(1)%clon, rg(1)%clat / 65.0,-10.0 / -data rg(1)%dlon, rg(1)%dlat / 90.0, 80.0 / -data rg(1)%global / .false. / - -! North Atlantic -data rg(2)%idx, rg(2)%name / 2, 'North Atlantic' / -data rg(2)%clon, rg(2)%clat / 0.0, 70.0 / -data rg(2)%dlon, rg(2)%dlat / 180.0, 40.0 / -data rg(2)%global / .false. / - -! northern subtropical Atlantic -data rg(3)%idx, rg(3)%name / 3, 'Northern subtropical Atlantic' / -data rg(3)%clon, rg(3)%clat / 330.0, 35.0 / -data rg(3)%dlon, rg(3)%dlat / 140.0, 30.0 / -data rg(3)%global / .false. / - -! Tropical Atlantic -data rg(4)%idx, rg(4)%name / 4, 'Tropical Atlantic' / -data rg(4)%clon, rg(4)%clat / 335.0, 0.0 / -data rg(4)%dlon, rg(4)%dlat / 90.0, 40.0 / -data rg(4)%global / .false. / - -! Southern subtropical Atlantic -data rg(5)%idx, rg(5)%name / 5, 'Southern subtropical Atlantic' / -data rg(5)%clon, rg(5)%clat / 335.0, -35.0 / -data rg(5)%dlon, rg(5)%dlat / 90.0, 30.0 / -data rg(5)%global / .false. / - -! North Pacific -data rg(6)%idx, rg(6)%name / 6, 'North Pacific' / -data rg(6)%clon, rg(6)%clat / 180.0, 70.0 / -data rg(6)%dlon, rg(6)%dlat / 180.0, 40.0 / -data rg(6)%global / .false. / - -! northern subtropical Pacific -data rg(7)%idx, rg(7)%name / 7, 'Northern subtropical Pacific' / -data rg(7)%clon, rg(7)%clat / 185.0, 35.0 / -data rg(7)%dlon, rg(7)%dlat / 150.0, 30.0 / -data rg(7)%global / .false. / - -! Tropical Pacific -data rg(8)%idx, rg(8)%name / 8, 'Tropical Pacific' / -data rg(8)%clon, rg(8)%clat / 200.0, 0.0 / -data rg(8)%dlon, rg(8)%dlat / 180.0, 40.0 / -data rg(8)%global / .false. / - -! Southern subtropical Pacific -data rg(9)%idx, rg(9)%name / 9, 'Southern subtropical Pacific' / -data rg(9)%clon, rg(9)%clat / 200.0, -35.0 / -data rg(9)%dlon, rg(9)%dlat / 180.0, 30.0 / -data rg(9)%global / .false. / - - -! Southern Ocean -data rg(10)%idx, rg(10)%name / 10, 'Southern Ocean' / -data rg(10)%clon, rg(10)%clat / 180.0, -70.0 / -data rg(10)%dlon, rg(10)%dlat / 360.0, 40.0 / -data rg(10)%global / .false. / - - -!******************************************************************************** + !******************************************************************************** + ! J.Schwinger, *Gfi, Bergen* 2011-05-19 + ! + ! Modified + ! -------- + ! J.Schwinger, *Uni Climate, BCCR* 2017-07-07 + ! - adapted this module to read the initial conditions for OMIP-BGC. + ! + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - adaptions for reading c-isotope initial values as d13C and d14C + ! + ! Purpose + ! ------- + ! - Routines for reading initial condition files for OMIP-BGC, which are based + ! on WOA 2013 and GLODAPv2 gridded data netCDF files + ! + ! Description: + ! ------------ + ! Public routines and variable of this module: + ! + ! -subroutine set_Gdata + ! Initialise global varibles and read in one data set. Must be + ! called before the processing of one data set starts. + ! + ! -subroutine clean_Gdata + ! Deallocate global fields of this module and reset all global variables. + ! Should be called each time, the processing of one data set is finished. + ! + ! -subroutine get_profile + ! Returns one profile from the currently open data set (opened by a + ! previous call to set_Gdata). See header of get profile for details. + ! + ! -function get_region + ! Returns the index of the region a given point belongs to. If no region + ! is found get_region returns 0, which is the index of the 'global region'. + ! Note that the regions are defined below in the module header. + ! + ! -nz_woa + ! Number of z-levels in the WOA data files. + ! + ! -nz_glo + ! Number of z-levels in the GLODAP data files. + ! + ! -nzmax + ! Max nuber of z-levels (=nzwoa) + ! + ! -zlev + ! Depth of each z-level [m] in the current data file. + ! + ! + !******************************************************************************** + + use netcdf, only: nf90_noerr,nf90_nowrite,nf90_strerror,nf90_inq_dimid,nf90_inquire_dimension,nf90_inq_varid,nf90_get_var, & + & nf90_inquire_variable,nf90_get_att,nf90_close,nf90_open + use mod_xc, only: mnproc,xchalt + use mo_control_bgc, only: io_stdo_bgc + + implicit none + + private + + public :: set_Gdata,clean_Gdata,get_profile,get_region,nzmax,nz,zlev,zlev_bnds,fillval + public :: inidic,inialk,inipo4,inioxy,inino3,inisil,inid13c,inid14c + + ! Number of latitudes, longitudes, and z-levels in the WOA and GLODAP data + integer, parameter :: nlon = 360 + integer, parameter :: nlat = 180 + integer, parameter :: nz_woa = 102 + integer, parameter :: nz_glo = 33 + integer, parameter :: nzmax = nz_woa + ! Resolution of data in degree + real, parameter :: dres = 1.0 + + + ! Max number of gridpoints to select around the center for averaging in + ! longitude direction + integer, parameter :: dnmax = 100.0 + + + ! Fill value used in this module, original fill values of data files are + ! replaced by this fill value during read + real, parameter :: fillval = -1.e+32 + + ! Input file names (incl. full path) set through namelist + character(len=256), save :: inidic = '' + character(len=256), save :: inialk = '' + character(len=256), save :: inipo4 = '' + character(len=256), save :: inioxy = '' + character(len=256), save :: inino3 = '' + character(len=256), save :: inisil = '' + character(len=256), save :: inid13c = '' + character(len=256), save :: inid14c = '' + character(len=256), save :: inic13 = '' ! currently not used + character(len=256), save :: inic14 = '' ! currently not used + + ! Variables set by call to Gdata_set + integer, save :: nz + real, save :: cfac, ddeg + real, save, dimension(:), allocatable :: lon,lat,zlev + real, save, dimension(:,:), allocatable :: zlev_bnds + real, save, dimension(:, :, :), allocatable :: rvar,gdata + character(len=16), save :: var,ncname + character(len=3) , save :: dsrc + character(len=256), save :: infile + + logical, save :: lset = .false. + + + !----------------------------------------- + ! Definitions for regional mean profiles: + !----------------------------------------- + type region + character(len=64) :: name ! Region name + integer :: idx ! Region index + integer :: npts(nzmax) ! nb of valid data points at each level + real :: clon, clat ! center longitude and latitude + real :: dlon, dlat ! latitude and longitude extent + real :: mprf(nzmax) ! mean profile for region + logical :: global ! global extent T/F + end type region + + integer, parameter :: nreg=10 + type(region) :: rg(0:nreg) + + + ! Set regions for fall-back profiles + + ! Global profile; + data rg(0)%idx, rg(0)%name / 0, 'global' / + data rg(0)%clon, rg(0)%clat / 0.0, 0.0 / + data rg(0)%dlon, rg(0)%dlat / 360.0, 180.0 / + data rg(0)%global / .true. / + + ! Indian Ocean + data rg(1)%idx, rg(1)%name / 1, 'Indian Ocean' / + data rg(1)%clon, rg(1)%clat / 65.0,-10.0 / + data rg(1)%dlon, rg(1)%dlat / 90.0, 80.0 / + data rg(1)%global / .false. / + + ! North Atlantic + data rg(2)%idx, rg(2)%name / 2, 'North Atlantic' / + data rg(2)%clon, rg(2)%clat / 0.0, 70.0 / + data rg(2)%dlon, rg(2)%dlat / 180.0, 40.0 / + data rg(2)%global / .false. / + + ! northern subtropical Atlantic + data rg(3)%idx, rg(3)%name / 3, 'Northern subtropical Atlantic' / + data rg(3)%clon, rg(3)%clat / 330.0, 35.0 / + data rg(3)%dlon, rg(3)%dlat / 140.0, 30.0 / + data rg(3)%global / .false. / + + ! Tropical Atlantic + data rg(4)%idx, rg(4)%name / 4, 'Tropical Atlantic' / + data rg(4)%clon, rg(4)%clat / 335.0, 0.0 / + data rg(4)%dlon, rg(4)%dlat / 90.0, 40.0 / + data rg(4)%global / .false. / + + ! Southern subtropical Atlantic + data rg(5)%idx, rg(5)%name / 5, 'Southern subtropical Atlantic' / + data rg(5)%clon, rg(5)%clat / 335.0, -35.0 / + data rg(5)%dlon, rg(5)%dlat / 90.0, 30.0 / + data rg(5)%global / .false. / + + ! North Pacific + data rg(6)%idx, rg(6)%name / 6, 'North Pacific' / + data rg(6)%clon, rg(6)%clat / 180.0, 70.0 / + data rg(6)%dlon, rg(6)%dlat / 180.0, 40.0 / + data rg(6)%global / .false. / + + ! northern subtropical Pacific + data rg(7)%idx, rg(7)%name / 7, 'Northern subtropical Pacific' / + data rg(7)%clon, rg(7)%clat / 185.0, 35.0 / + data rg(7)%dlon, rg(7)%dlat / 150.0, 30.0 / + data rg(7)%global / .false. / + + ! Tropical Pacific + data rg(8)%idx, rg(8)%name / 8, 'Tropical Pacific' / + data rg(8)%clon, rg(8)%clat / 200.0, 0.0 / + data rg(8)%dlon, rg(8)%dlat / 180.0, 40.0 / + data rg(8)%global / .false. / + + ! Southern subtropical Pacific + data rg(9)%idx, rg(9)%name / 9, 'Southern subtropical Pacific' / + data rg(9)%clon, rg(9)%clat / 200.0, -35.0 / + data rg(9)%dlon, rg(9)%dlat / 180.0, 30.0 / + data rg(9)%global / .false. / + + + ! Southern Ocean + data rg(10)%idx, rg(10)%name / 10, 'Southern Ocean' / + data rg(10)%clon, rg(10)%clat / 180.0, -70.0 / + data rg(10)%dlon, rg(10)%dlat / 360.0, 40.0 / + data rg(10)%global / .false. / + + + !******************************************************************************** contains -subroutine set_Gdata(vname,inddeg) -!-------------------------------------------------------------------------------- -! -! Purpose: -! -------- -! Initialise global varibles and read data set specified by vname. Must be -! called before the first call to any routine of this module. -! -! Description: -! ------------ -! -! -! Arguments: -! ---------- -! vname: data set name to read in; valid names are -! 'pho' - WOA phosphate -! 'nit' - WOA nitrate -! 'sil' - WOA silicate -! 'oxy' - WOA dissolved oxygen -! 'alk' - GLODAP alkalinity -! 'dic' - GLODAP dissolved inorganic carbon -! 'C13' - Dissolved inorganic 13C carbon isotope -! 'd13' - delta13C of dissolved inorganic carbon -! 'C14' - Dissolved inorganic 14C carbon isotope -! 'd14' - delta14C of dissolved inorganic carbon -! inddeg: extent (in degrees) of region used for averaging -! -!-------------------------------------------------------------------------------- -character(len=*), intent(in) :: vname -real, intent(in) :: inddeg - -! Local variables -character(len=*), parameter :: routinestr = 'set_Gdata' + subroutine set_Gdata(vname,inddeg) + !-------------------------------------------------------------------------------- + ! + ! Purpose: + ! -------- + ! Initialise global varibles and read data set specified by vname. Must be + ! called before the first call to any routine of this module. + ! + ! Description: + ! ------------ + ! + ! + ! Arguments: + ! ---------- + ! vname: data set name to read in; valid names are + ! 'pho' - WOA phosphate + ! 'nit' - WOA nitrate + ! 'sil' - WOA silicate + ! 'oxy' - WOA dissolved oxygen + ! 'alk' - GLODAP alkalinity + ! 'dic' - GLODAP dissolved inorganic carbon + ! 'C13' - Dissolved inorganic 13C carbon isotope + ! 'd13' - delta13C of dissolved inorganic carbon + ! 'C14' - Dissolved inorganic 14C carbon isotope + ! 'd14' - delta14C of dissolved inorganic carbon + ! inddeg: extent (in degrees) of region used for averaging + ! + !-------------------------------------------------------------------------------- + character(len=*), intent(in) :: vname + real, intent(in) :: inddeg + + ! Local variables + character(len=*), parameter :: routinestr = 'set_Gdata' + + + if( allocated(lon) ) deallocate( lon ) + if( allocated(lat) ) deallocate( lat ) + if( allocated(zlev) ) deallocate( zlev ) + if( allocated(zlev_bnds) ) deallocate( zlev_bnds ) + if( allocated(rvar) ) deallocate( rvar ) + if( allocated(gdata) ) deallocate( gdata ) + + ! Select settings specific to each variable + select case (vname) + + case ('pho') ! phosphate + infile = inipo4 + ncname = 'po4' + dsrc = 'WOA' + cfac = 1.0e-6 ! data in mumol/L -> kmol/m3 + + case ('nit') ! nitrate + infile = inino3 + ncname = 'no3' + dsrc = 'WOA' + cfac = 1.0e-6 ! data in mumol/L -> kmol/m3 + + case ('sil') ! silicate + infile = inisil + ncname = 'si' + dsrc = 'WOA' + cfac = 1.0e-6 ! data in mumol/L -> kmol/m3 + + case ('oxy') ! oxygen + infile = inioxy + ncname = 'o2' + dsrc = 'WOA' + cfac = 44.661*1.0e-6 ! conversion ml/L -> mumol/L -> kmol/m3 + + case ('alk') ! alkalinity + infile = inialk + ncname = 'At' + dsrc = 'GLO' + cfac = 1.0e-6 ! data in mumol/kg -> mol/kg + + case ('dic') ! DIC + infile = inidic + ncname = 'Ct_preind' + dsrc = 'GLO' + cfac = 1.0e-6 ! data in mumol/kg -> mol/kg + + case ('C13') ! natural 13C [micromoles/kg] + infile = inic13 + ncname = 'C13' + dsrc = 'ISO' + cfac = 1.0e-6 ! data in mumol/kg -> mol/kg + + case ('d13') ! natural delta13C [permil] + infile = inid13c + ncname = 'd13C' + dsrc = 'ISO' + cfac = 1.0 + + case ('C14') ! natural 14C [micromoles/kg] + infile = inic14 + ncname = 'C14' + dsrc = 'ISO' + cfac = 1.0e-6 ! data in mumol/kg -> mol/kg + + case ('d14') ! natural delta14C [permil] + infile = inid14c + ncname = 'd14C' + dsrc = 'ISO' + cfac = 1.0 + + case default + call moderr(routinestr,'Invalid vname') + + end select + + var = vname + ddeg = inddeg + + if(mnproc == 1) write(io_stdo_bgc,*) 'iHAMOCC: initialising ', trim(vname) + + call read_Gdata() + + ! extend data array by +/-dnmax data points in longitude + allocate( gdata(-dnmax:nlon+dnmax,nlat,nz) ) + gdata(:,:,:) = 0.0 + gdata( 1:nlon, :,:) = rvar(:,:,:) + gdata(-dnmax:0, :,:) = rvar(nlon-dnmax:nlon,:,:) + gdata(nlon+1:nlon+dnmax,:,:) = rvar(1:dnmax,:,:) + + lset = .true. + + call set_regional_profiles() + + + !-------------------------------------------------------------------------------- + end subroutine set_Gdata + + + + subroutine get_profile(clon,clat,prf) + !-------------------------------------------------------------------------------- + ! + ! Purpose: + ! -------- + ! Return a profile suitable for initialisation of HAMCC at point clon/clat. + ! + ! Description: + ! ------------ + ! A mean profile is calculated by calling calc_mean_profile with the settings + ! defined by a previous call to set_Gdata. If no valid data is found for the + ! point clon/clat, it is tried to obtain a mean regional profile (e.g. for the + ! north atlantic area). These mean profiles are initialised as part of + ! set_Gdata. + ! + ! + ! Arguments: + ! ---------- + ! clon, clat: center lon/lat of mean profile + ! prf: mean profile for initialisation + ! + !-------------------------------------------------------------------------------- + real, intent(in) :: clon, clat + real, intent(out) :: prf(nzmax) + ! Local variables + integer :: idx, npts(nzmax) + real :: clon_tmp,clat_tmp + character(len=*), parameter :: routinestr = 'mo_Gdata_read, get_profile' -if( allocated(lon) ) deallocate( lon ) -if( allocated(lat) ) deallocate( lat ) -if( allocated(zlev) ) deallocate( zlev ) -if( allocated(zlev_bnds) ) deallocate( zlev_bnds ) -if( allocated(rvar) ) deallocate( rvar ) -if( allocated(gdata) ) deallocate( gdata ) -! Select settings specific to each variable -select case (vname) + if( .not. lset ) call moderr(routinestr, ' Module not initialised yet') -case ('pho') ! phosphate - infile = inipo4 - ncname = 'po4' - dsrc = 'WOA' - cfac = 1.0e-6 ! data in mumol/L -> kmol/m3 -case ('nit') ! nitrate - infile = inino3 - ncname = 'no3' - dsrc = 'WOA' - cfac = 1.0e-6 ! data in mumol/L -> kmol/m3 + if( clon < 0 ) then + clon_tmp=clon+360.0 + clat_tmp=clat + else + clon_tmp=clon + clat_tmp=clat + endif -case ('sil') ! silicate - infile = inisil - ncname = 'si' - dsrc = 'WOA' - cfac = 1.0e-6 ! data in mumol/L -> kmol/m3 + ! Try to obtain a mean profile for a region centered at clon/clat + call calc_mean_profile(clon_tmp,clat_tmp,ddeg,ddeg,prf,npts) -case ('oxy') ! oxygen - infile = inioxy - ncname = 'o2' - dsrc = 'WOA' - cfac = 44.661*1.0e-6 ! conversion ml/L -> mumol/L -> kmol/m3 -case ('alk') ! alkalinity - infile = inialk - ncname = 'At' - dsrc = 'GLO' - cfac = 1.0e-6 ! data in mumol/kg -> mol/kg + ! Fall back to regional profile if number of valid data points is smaller + ! than 3 for the surface layer. A global mean profile is used if + ! get_region returns 0. + if( npts(1) < 3 ) then -case ('dic') ! DIC - infile = inidic - ncname = 'Ct_preind' - dsrc = 'GLO' - cfac = 1.0e-6 ! data in mumol/kg -> mol/kg + idx = get_region(clon_tmp,clat_tmp) + prf = rg(idx)%mprf + !write(*,*) 'Region is ', rg(idx)%name, clon, clat -case ('C13') ! natural 13C [micromoles/kg] - infile = inic13 - ncname = 'C13' - dsrc = 'ISO' - cfac = 1.0e-6 ! data in mumol/kg -> mol/kg + endif -case ('d13') ! natural delta13C [permil] - infile = inid13c - ncname = 'd13C' - dsrc = 'ISO' - cfac = 1.0 -case ('C14') ! natural 14C [micromoles/kg] - infile = inic14 - ncname = 'C14' - dsrc = 'ISO' - cfac = 1.0e-6 ! data in mumol/kg -> mol/kg + !-------------------------------------------------------------------------------- + end subroutine get_profile -case ('d14') ! natural delta14C [permil] - infile = inid14c - ncname = 'd14C' - dsrc = 'ISO' - cfac = 1.0 -case default - call moderr(routinestr,'Invalid vname') -end select + function get_region(clon,clat) + !-------------------------------------------------------------------------------- + ! + ! Purpose: + ! -------- + ! Return index of region the point clon/clat belongs to + ! + ! Description: + ! ------------ + ! The rectangular regions as defined in the module header (and stored in the + ! data type 'rg') are searched. If point clon/clat belongs to region i, the + ! index i is the result of this function. If no region is found, get_region + ! returns 0, which is the index of the 'global' region defined in the header. + ! + ! Arguments: + ! ---------- + ! clon, clat: lon/lat of point + ! + !-------------------------------------------------------------------------------- + real, intent(in) :: clon,clat + integer :: get_region -var = vname -ddeg = inddeg + ! Local variables + integer :: i + real :: ll_lon, ur_lon + real :: ll_lat, ur_lat + logical :: boundwithin, found + character(len=*), parameter :: routinestr = 'mo_Gdata_read, get_region' -if(mnproc == 1) write(io_stdo_bgc,*) 'iHAMOCC: initialising ', trim(vname) -call read_Gdata() + if( clon < 0 ) call moderr(routinestr, ' clon must be in the range [0,360]') + if( clon > 360.0 ) call moderr(routinestr, ' clon must be in the range [0,360]') -! extend data array by +/-dnmax data points in longitude -allocate( gdata(-dnmax:nlon+dnmax,nlat,nz) ) -gdata(:,:,:) = 0.0 -gdata( 1:nlon, :,:) = rvar(:,:,:) -gdata(-dnmax:0, :,:) = rvar(nlon-dnmax:nlon,:,:) -gdata(nlon+1:nlon+dnmax,:,:) = rvar(1:dnmax,:,:) + found = .false. -lset = .true. + do i=1,nreg -call set_regional_profiles() + boundwithin = .false. + ll_lon = rg(i)%clon-rg(i)%dlon/2.0 + ur_lon = rg(i)%clon+rg(i)%dlon/2.0 + ll_lat = rg(i)%clat-rg(i)%dlat/2.0 + ur_lat = rg(i)%clat+rg(i)%dlat/2.0 -!-------------------------------------------------------------------------------- -end subroutine set_Gdata + if( ll_lon < 0.0 ) ll_lon = ll_lon+360.0 + if( ur_lon > 360.0 ) ur_lon = ur_lon-360.0 + if( ll_lon > ur_lon ) boundwithin = .true. + if( clat < ll_lat .or. clat > ur_lat ) cycle -subroutine get_profile(clon,clat,prf) -!-------------------------------------------------------------------------------- -! -! Purpose: -! -------- -! Return a profile suitable for initialisation of HAMCC at point clon/clat. -! -! Description: -! ------------ -! A mean profile is calculated by calling calc_mean_profile with the settings -! defined by a previous call to set_Gdata. If no valid data is found for the -! point clon/clat, it is tried to obtain a mean regional profile (e.g. for the -! north atlantic area). These mean profiles are initialised as part of -! set_Gdata. -! -! -! Arguments: -! ---------- -! clon, clat: center lon/lat of mean profile -! prf: mean profile for initialisation -! -!-------------------------------------------------------------------------------- -real, intent(in) :: clon, clat -real, intent(out) :: prf(nzmax) + if( boundwithin ) then -! Local variables -integer :: idx, npts(nzmax) -real :: clon_tmp,clat_tmp -character(len=*), parameter :: routinestr = 'mo_Gdata_read, get_profile' + if( clon < ll_lon .and. clon > ur_lon ) cycle + else -if( .not. lset ) call moderr(routinestr, ' Module not initialised yet') + if( clon < ll_lon .or. clon > ur_lon ) cycle + endif -if( clon < 0 ) then - clon_tmp=clon+360.0 - clat_tmp=clat -else - clon_tmp=clon - clat_tmp=clat -endif + found = .true. + exit -! Try to obtain a mean profile for a region centered at clon/clat -call calc_mean_profile(clon_tmp,clat_tmp,ddeg,ddeg,prf,npts) + enddo + if( found ) then + get_region = rg(i)%idx + else + get_region = 0 + endif -! Fall back to regional profile if number of valid data points is smaller -! than 3 for the surface layer. A global mean profile is used if -! get_region returns 0. -if( npts(1) < 3 ) then - idx = get_region(clon_tmp,clat_tmp) - prf = rg(idx)%mprf - !write(*,*) 'Region is ', rg(idx)%name, clon, clat + !-------------------------------------------------------------------------------- + end function get_region -endif -!-------------------------------------------------------------------------------- -end subroutine get_profile + subroutine set_regional_profiles() + !-------------------------------------------------------------------------------- + ! + ! Calculate the mean profiles in regions as defined in the module header + ! + !-------------------------------------------------------------------------------- + ! Local variables + integer :: i + character(len=*), parameter :: routinestr = 'mo_Gdata_read, set_regional_profiles' + if( .not. lset ) call moderr(routinestr, ' Module not initialised yet') -function get_region(clon,clat) -!-------------------------------------------------------------------------------- -! -! Purpose: -! -------- -! Return index of region the point clon/clat belongs to -! -! Description: -! ------------ -! The rectangular regions as defined in the module header (and stored in the -! data type 'rg') are searched. If point clon/clat belongs to region i, the -! index i is the result of this function. If no region is found, get_region -! returns 0, which is the index of the 'global' region defined in the header. -! -! Arguments: -! ---------- -! clon, clat: lon/lat of point -! -!-------------------------------------------------------------------------------- -real, intent(in) :: clon,clat -integer :: get_region + do i=0,nreg -! Local variables -integer :: i -real :: ll_lon, ur_lon -real :: ll_lat, ur_lat -logical :: boundwithin, found -character(len=*), parameter :: routinestr = 'mo_Gdata_read, get_region' + call calc_mean_profile(rg(i)%clon,rg(i)%clat,rg(i)%dlon,rg(i)%dlat, & + rg(i)%mprf,rg(i)%npts,rg(i)%global) -if( clon < 0 ) call moderr(routinestr, ' clon must be in the range [0,360]') -if( clon > 360.0 ) call moderr(routinestr, ' clon must be in the range [0,360]') + !write(*,*) 'Calculated mean profile for ', rg(i)%name + !write(*,*) '===============' + !write(*,*) rg(i)%mprf + !write(*,*) '===============' -found = .false. + enddo -do i=1,nreg + !-------------------------------------------------------------------------------- + end subroutine set_regional_profiles - boundwithin = .false. - ll_lon = rg(i)%clon-rg(i)%dlon/2.0 - ur_lon = rg(i)%clon+rg(i)%dlon/2.0 - ll_lat = rg(i)%clat-rg(i)%dlat/2.0 - ur_lat = rg(i)%clat+rg(i)%dlat/2.0 - if( ll_lon < 0.0 ) ll_lon = ll_lon+360.0 - if( ur_lon > 360.0 ) ur_lon = ur_lon-360.0 + subroutine read_Gdata() + !-------------------------------------------------------------------------------- + ! + ! Read the WOA or GLODAP data into variables lon/lat/zlev and rvar + ! + !-------------------------------------------------------------------------------- - if( ll_lon > ur_lon ) boundwithin = .true. + ! Local variables + integer :: ncId, vId, dId + integer :: numlon, numlat, numlev + integer :: i, ndim, natts + integer :: dimid(7) + integer :: status + real :: fval + character(len=16) :: lonstr,latstr,depthstr,depthbndsstr,fvalstr + character(len=*), parameter :: routinestr = 'mo_Gdata_read, read_Gdata' - if( clat < ll_lat .or. clat > ur_lat ) cycle - if( boundwithin ) then - - if( clon < ll_lon .and. clon > ur_lon ) cycle + lonstr = 'lon' + latstr = 'lat' + fvalstr = '_FillValue' - else + select case (dsrc) - if( clon < ll_lon .or. clon > ur_lon ) cycle + case ('WOA') + nz = nz_woa + depthstr='depth' + depthbndsstr='depth_bnds' + case ('GLO') + nz = nz_glo + depthstr='depthz' + depthbndsstr='depthz_bnds' + case ('ISO') + nz = nz_glo + depthstr='depthz' + depthbndsstr='depthz_bnds' + case default + call moderr(routinestr,'Invalid dsrc') - endif + end select - found = .true. - exit -enddo + ! Open file + if(mnproc == 1) write(io_stdo_bgc,*) 'Reading ', trim(infile) + status = nf90_open(infile,nf90_nowrite,ncid); call ncerr(status) -if( found ) then - get_region = rg(i)%idx -else - get_region = 0 -endif + ! Get dimensions + status = nf90_inq_dimid(ncid, trim(lonstr), dId) + call ncerr(status) + status = nf90_inquire_dimension(ncid, dID, len=numlon) + call ncerr(status) -!-------------------------------------------------------------------------------- -end function get_region + status = nf90_inq_dimid(ncid, trim(latstr), dId) + call ncerr(status) + status = nf90_inquire_dimension(ncid, dID, len=numlat) + call ncerr(status) + + status = nf90_inq_dimid(ncid, trim(depthstr), dId) + call ncerr(status) + status = nf90_inquire_dimension(ncid, dId, len=numlev) + call ncerr(status) + + if( numlon /= nlon .or. numlat /= nlat .or. numlev /= nz ) & + call moderr(routinestr,'Unexpected nb of elements in data file') + + allocate( lon(nlon), lat(nlat), zlev(nz), zlev_bnds(2,nz) ) + allocate( rvar(nlon,nlat,nz) ) + + ! Get lon, lat, and lev + status = nf90_inq_varid(ncid, trim(lonstr), vId) + call ncerr(status) + status = nf90_get_var(ncid, vId, lon) + call ncerr(status) + + status = nf90_inq_varid(ncid, trim(latstr), vId) + call ncerr(status) + status = nf90_get_var(ncid, vId, lat) + call ncerr(status) + + status = nf90_inq_varid(ncid, trim(depthstr), vId) + call ncerr(status) + status = nf90_get_var(ncid, vId, zlev) + call ncerr(status) + + status = nf90_inq_varid(ncid, trim(depthbndsstr), vId) + call ncerr(status) + status = nf90_get_var(ncid, vId, zlev_bnds) + call ncerr(status) + + ! Get varid and fill value + status = nf90_inq_varid(ncid, ncname, vId) + call ncerr(status) + status = nf90_inquire_variable(ncid, vId, ndims=ndim, dimids=dimid, nAtts=natts) + call ncerr(status) + status = nf90_get_att(ncid, vid, trim(fvalstr), fval) + call ncerr(status) + + ! GetRead the data + status = nf90_get_var(ncid, vId, rvar) + call ncerr(status) + + ! arrange data to correspond to [0,360] in longitude + select case (dsrc) + + case ('WOA') + lon = cshift(lon, -180) + rvar = cshift(rvar,-180,1) + case ('GLO') + lon = cshift(lon, -20) + rvar = cshift(rvar,-20,1) + case ('ISO') + lon = cshift(lon, -180) + rvar = cshift(rvar,-180,1) + end select + + do i=1,nlon + if(lon(i)< 0.0) lon(i)=lon(i)+360.0 + if(lon(i)>360.0) lon(i)=lon(i)-360.0 + enddo + + ! Fillvalues are assumed to be < 0 currently, otherwise the below code would fail + if(fval > 0.0) call moderr(routinestr,'FillValue > 0 found in data') + + where( rvar < fval*0.1 ) + ! Replace fill values: + rvar = fillval + elsewhere + ! unit conversion + rvar = rvar*cfac + end where + + + ! Close data file + status = nf90_close(ncid) + call ncerr(status) + + + !-------------------------------------------------------------------------------- + end subroutine read_Gdata + + + + subroutine calc_mean_profile(clon,clat,dlon,dlat,prf,npts,global) + !-------------------------------------------------------------------------------- + ! + ! Purpose: + ! -------- + ! Return mean profile around the center point clon/clat. + ! + ! Description: + ! ------------ + ! The mean profile is calculated from valid data points in the square defined + ! by clon+/-dlon/2 clat+/-dlat/2. The number of valid data points per depth + ! level is returned in npts. By setting the optional argument global to true, + ! all valid data points are used to calculate a global mean profile. clon, clat, + ! dlon, and dlat are ignored in this case. + ! + ! Arguments: + ! ---------- + ! clon, clat: center lon/lat of mean profile + ! dlon, dlat: lon/lat extent of region to select for averaging + ! prf: mean profile calculated from all data in selected region + ! npts: nb of valid data points found for each depth level + ! global: if set to true, calculate mean over the whole data set + ! + !-------------------------------------------------------------------------------- + real, intent(in) :: clon, clat + real, intent(in) :: dlon, dlat + real, intent(out) :: prf(nzmax) + integer, intent(out) :: npts(nzmax) + logical, optional, intent(in) :: global + + ! Local variables + integer :: ilonc, ilons, ilone, dnlon + integer :: ilatc, ilats, ilate, dnlat + integer :: l, nelmlon,nelmlat + logical :: gl = .false. + character(len=*), parameter :: routinestr = 'mo_Gdata_read, calc_mean_profile' + + + if( .not. lset ) call moderr(routinestr, ' Module not initialised yet') + if( clon < 0 ) call moderr(routinestr, ' clon must be in the range [0,360]') + if( clon > 360.0 ) call moderr(routinestr, ' clon must be in the range [0,360]') + + prf(:) = fillval + npts(:) = 0.0 + + if( present(global) ) gl=global + + if( gl ) then + + ilons=1 + ilone=nlon + ilats=1 + ilate=nlat + + else + + ! Find index of nearest gridpoint (not exact but okay for this purpose) + do ilonc=1,nlon + if( clon < lon(ilonc) ) exit + enddo + if( ilonc > nlon ) ilonc = nlon + if( lon(ilonc)-clon > dres/2.0 ) ilonc=ilonc-1 + if( ilonc < 1 ) ilonc = 1 + + do ilatc=1,nlat + if( clat < lat(ilatc) ) exit + enddo + if( ilatc > nlat ) ilatc = nlat + if( lat(ilatc)-clat > dres/2.0 ) ilatc=ilatc-1 + if( ilatc < 1 ) ilatc = 1 + + dnlon = int(dlon/2.0*dres) ! Nb of gridpoints to select around the center lon + dnlat = int(dlat/2.0*dres) ! Nb of gridpoints to select around the center lat + + nelmlon = 2*dnlon+1 + nelmlat = 2*dnlat+1 + + ! Start idices of rectangle: + ilons = ilonc-dnlon + ilats = ilatc-dnlat + + ! There is no "wrap-around" if southern/northen boundary of rectangle + ! goes beyond the pole. Instead rectangle is adjusted such that boundaries + ! are aligned with northernmost/sothernmost data gridpoint + if(ilats <= 0 ) ilats=1 + if(ilats > nlat-nelmlat+1) ilats= nlat-nelmlat+1 + ! End indices of rectangle: + ilone = ilons+nelmlon-1 + ilate = ilats+nelmlat-1 + if( ilons < -dnmax ) call moderr(routinestr,'error: data array too small') + if( ilone > dnmax+nlon ) call moderr(routinestr,'error: data array too small') -subroutine set_regional_profiles() -!-------------------------------------------------------------------------------- -! -! Calculate the mean profiles in regions as defined in the module header -! -!-------------------------------------------------------------------------------- + endif -! Local variables -integer :: i -character(len=*), parameter :: routinestr = 'mo_Gdata_read, set_regional_profiles' -if( .not. lset ) call moderr(routinestr, ' Module not initialised yet') + ! Calculate mean profile: + do l=1,nz + + npts(l) = count(gdata(ilons:ilone,ilats:ilate,l) > fillval*0.1) + prf(l) = sum(gdata(ilons:ilone,ilats:ilate,l), mask=gdata(ilons:ilone,ilats:ilate,l) > fillval*0.1) + if( npts(l) > 0) then + prf(l) = prf(l)/npts(l) + else + prf(l) = fillval + endif -do i=0,nreg + enddo - call calc_mean_profile(rg(i)%clon,rg(i)%clat,rg(i)%dlon,rg(i)%dlat, & - rg(i)%mprf,rg(i)%npts,rg(i)%global) + !write(*,*) '================' + !if( gl ) then + ! write(*,*) 'global' + !else + ! write(*,*) dnlon,dnlat + ! write(*,*) ilonc,ilons,ilone,lon(ilonc) + ! write(*,*) ilatc,ilats,ilate,lat(ilatc) + !endif + !write(*,*) '================' - !write(*,*) 'Calculated mean profile for ', rg(i)%name - !write(*,*) '===============' - !write(*,*) rg(i)%mprf - !write(*,*) '===============' + !-------------------------------------------------------------------------------- + end subroutine calc_mean_profile -enddo -!-------------------------------------------------------------------------------- -end subroutine set_regional_profiles + subroutine clean_Gdata() + !-------------------------------------------------------------------------------- + ! Deallocate fields and reset global variables + !-------------------------------------------------------------------------------- + if( allocated(lon) ) deallocate( lon ) + if( allocated(lat) ) deallocate( lat ) + if( allocated(zlev) ) deallocate( zlev ) + if( allocated(zlev_bnds) ) deallocate( zlev_bnds ) + if( allocated(rvar) ) deallocate( rvar ) + if( allocated(gdata) ) deallocate( gdata ) -subroutine read_Gdata() -!-------------------------------------------------------------------------------- -! -! Read the WOA or GLODAP data into variables lon/lat/zlev and rvar -! -!-------------------------------------------------------------------------------- - -! Local variables -integer :: ncId, vId, dId -integer :: numlon, numlat, numlev -integer :: i, ndim, natts -integer :: dimid(7) -integer :: status -real :: fval -character(len=16) :: lonstr,latstr,depthstr,depthbndsstr,fvalstr -character(len=*), parameter :: routinestr = 'mo_Gdata_read, read_Gdata' - - -lonstr = 'lon' -latstr = 'lat' -fvalstr = '_FillValue' - -select case (dsrc) - -case ('WOA') - nz = nz_woa - depthstr='depth' - depthbndsstr='depth_bnds' -case ('GLO') - nz = nz_glo - depthstr='depthz' - depthbndsstr='depthz_bnds' -case ('ISO') - nz = nz_glo - depthstr='depthz' - depthbndsstr='depthz_bnds' -case default - call moderr(routinestr,'Invalid dsrc') - -end select - - -! Open file -if(mnproc == 1) write(io_stdo_bgc,*) 'Reading ', trim(infile) -status = nf90_open(infile,nf90_nowrite,ncid); call ncerr(status) - - -! Get dimensions -status = nf90_inq_dimid(ncid, trim(lonstr), dId) -call ncerr(status) -status = nf90_inquire_dimension(ncid, dID, len=numlon) -call ncerr(status) - -status = nf90_inq_dimid(ncid, trim(latstr), dId) -call ncerr(status) -status = nf90_inquire_dimension(ncid, dID, len=numlat) -call ncerr(status) - -status = nf90_inq_dimid(ncid, trim(depthstr), dId) -call ncerr(status) -status = nf90_inquire_dimension(ncid, dId, len=numlev) -call ncerr(status) - -if( numlon /= nlon .or. numlat /= nlat .or. numlev /= nz ) & - call moderr(routinestr,'Unexpected nb of elements in data file') - -allocate( lon(nlon), lat(nlat), zlev(nz), zlev_bnds(2,nz) ) -allocate( rvar(nlon,nlat,nz) ) - -! Get lon, lat, and lev -status = nf90_inq_varid(ncid, trim(lonstr), vId) -call ncerr(status) -status = nf90_get_var(ncid, vId, lon) -call ncerr(status) - -status = nf90_inq_varid(ncid, trim(latstr), vId) -call ncerr(status) -status = nf90_get_var(ncid, vId, lat) -call ncerr(status) - -status = nf90_inq_varid(ncid, trim(depthstr), vId) -call ncerr(status) -status = nf90_get_var(ncid, vId, zlev) -call ncerr(status) - -status = nf90_inq_varid(ncid, trim(depthbndsstr), vId) -call ncerr(status) -status = nf90_get_var(ncid, vId, zlev_bnds) -call ncerr(status) - -! Get varid and fill value -status = nf90_inq_varid(ncid, ncname, vId) -call ncerr(status) -status = nf90_inquire_variable(ncid, vId, ndims=ndim, dimids=dimid, nAtts=natts) -call ncerr(status) -status = nf90_get_att(ncid, vid, trim(fvalstr), fval) -call ncerr(status) - -! GetRead the data -status = nf90_get_var(ncid, vId, rvar) -call ncerr(status) - -! arrange data to correspond to [0,360] in longitude -select case (dsrc) - -case ('WOA') - lon = cshift(lon, -180) - rvar = cshift(rvar,-180,1) -case ('GLO') - lon = cshift(lon, -20) - rvar = cshift(rvar,-20,1) -case ('ISO') - lon = cshift(lon, -180) - rvar = cshift(rvar,-180,1) -end select - -do i=1,nlon - if(lon(i)< 0.0) lon(i)=lon(i)+360.0 - if(lon(i)>360.0) lon(i)=lon(i)-360.0 -enddo - -! Fillvalues are assumed to be < 0 currently, otherwise the below code would fail -if(fval > 0.0) call moderr(routinestr,'FillValue > 0 found in data') - -where( rvar < fval*0.1 ) - ! Replace fill values: - rvar = fillval -elsewhere - ! unit conversion - rvar = rvar*cfac -end where - - -! Close data file -status = nf90_close(ncid) -call ncerr(status) + infile = '' + ncname = '' + var = '' + dsrc = '' + cfac = 1.0 + ddeg = 0.0 + nz = 0 + lset = .false. + !-------------------------------------------------------------------------------- + end subroutine clean_Gdata -!-------------------------------------------------------------------------------- -end subroutine read_Gdata + subroutine ncerr(status) + !-------------------------------------------------------------------------------- + ! Handle netCDF-errors + !-------------------------------------------------------------------------------- + integer, intent(in) :: status + + if(status == nf90_NoErr) return + + write(io_stdo_bgc,*) 'NetCDF error: ',nf90_strerror(status) + write(io_stdo_bgc,*) 'Abort... ' + call flush(io_stdo_bgc) + call xchalt('(Module mo_Gdata_read, ncerr)') + stop '(Module mo_Gdata_read, ncerr)' + + + !-------------------------------------------------------------------------------- + end subroutine ncerr + -subroutine calc_mean_profile(clon,clat,dlon,dlat,prf,npts,global) -!-------------------------------------------------------------------------------- -! -! Purpose: -! -------- -! Return mean profile around the center point clon/clat. -! -! Description: -! ------------ -! The mean profile is calculated from valid data points in the square defined -! by clon+/-dlon/2 clat+/-dlat/2. The number of valid data points per depth -! level is returned in npts. By setting the optional argument global to true, -! all valid data points are used to calculate a global mean profile. clon, clat, -! dlon, and dlat are ignored in this case. -! -! Arguments: -! ---------- -! clon, clat: center lon/lat of mean profile -! dlon, dlat: lon/lat extent of region to select for averaging -! prf: mean profile calculated from all data in selected region -! npts: nb of valid data points found for each depth level -! global: if set to true, calculate mean over the whole data set -! -!-------------------------------------------------------------------------------- -real, intent(in) :: clon, clat -real, intent(in) :: dlon, dlat -real, intent(out) :: prf(nzmax) -integer, intent(out) :: npts(nzmax) -logical, optional, intent(in) :: global - -! Local variables -integer :: ilonc, ilons, ilone, dnlon -integer :: ilatc, ilats, ilate, dnlat -integer :: l, nelmlon,nelmlat -logical :: gl = .false. -character(len=*), parameter :: routinestr = 'mo_Gdata_read, calc_mean_profile' - - -if( .not. lset ) call moderr(routinestr, ' Module not initialised yet') -if( clon < 0 ) call moderr(routinestr, ' clon must be in the range [0,360]') -if( clon > 360.0 ) call moderr(routinestr, ' clon must be in the range [0,360]') - -prf(:) = fillval -npts(:) = 0.0 - -if( present(global) ) gl=global - -if( gl ) then - - ilons=1 - ilone=nlon - ilats=1 - ilate=nlat - -else - - ! Find index of nearest gridpoint (not exact but okay for this purpose) - do ilonc=1,nlon - if( clon < lon(ilonc) ) exit - enddo - if( ilonc > nlon ) ilonc = nlon - if( lon(ilonc)-clon > dres/2.0 ) ilonc=ilonc-1 - if( ilonc < 1 ) ilonc = 1 - - do ilatc=1,nlat - if( clat < lat(ilatc) ) exit - enddo - if( ilatc > nlat ) ilatc = nlat - if( lat(ilatc)-clat > dres/2.0 ) ilatc=ilatc-1 - if( ilatc < 1 ) ilatc = 1 - - dnlon = int(dlon/2.0*dres) ! Nb of gridpoints to select around the center lon - dnlat = int(dlat/2.0*dres) ! Nb of gridpoints to select around the center lat - - nelmlon = 2*dnlon+1 - nelmlat = 2*dnlat+1 - - ! Start idices of rectangle: - ilons = ilonc-dnlon - ilats = ilatc-dnlat - - ! There is no "wrap-around" if southern/northen boundary of rectangle - ! goes beyond the pole. Instead rectangle is adjusted such that boundaries - ! are aligned with northernmost/sothernmost data gridpoint - if(ilats <= 0 ) ilats=1 - if(ilats > nlat-nelmlat+1) ilats= nlat-nelmlat+1 - - ! End indices of rectangle: - ilone = ilons+nelmlon-1 - ilate = ilats+nelmlat-1 - - if( ilons < -dnmax ) call moderr(routinestr,'error: data array too small') - if( ilone > dnmax+nlon ) call moderr(routinestr,'error: data array too small') - -endif - - -! Calculate mean profile: -do l=1,nz - - npts(l) = count(gdata(ilons:ilone,ilats:ilate,l) > fillval*0.1) - prf(l) = sum(gdata(ilons:ilone,ilats:ilate,l), mask=gdata(ilons:ilone,ilats:ilate,l) > fillval*0.1) - if( npts(l) > 0) then - prf(l) = prf(l)/npts(l) - else - prf(l) = fillval - endif - -enddo - - -!write(*,*) '================' -!if( gl ) then -! write(*,*) 'global' -!else -! write(*,*) dnlon,dnlat -! write(*,*) ilonc,ilons,ilone,lon(ilonc) -! write(*,*) ilatc,ilats,ilate,lat(ilatc) -!endif -!write(*,*) '================' - -!-------------------------------------------------------------------------------- -end subroutine calc_mean_profile - - - -subroutine clean_Gdata() -!-------------------------------------------------------------------------------- -! Deallocate fields and reset global variables -!-------------------------------------------------------------------------------- - -if( allocated(lon) ) deallocate( lon ) -if( allocated(lat) ) deallocate( lat ) -if( allocated(zlev) ) deallocate( zlev ) -if( allocated(zlev_bnds) ) deallocate( zlev_bnds ) -if( allocated(rvar) ) deallocate( rvar ) -if( allocated(gdata) ) deallocate( gdata ) - -infile = '' -ncname = '' -var = '' -dsrc = '' -cfac = 1.0 -ddeg = 0.0 -nz = 0 -lset = .false. - -!-------------------------------------------------------------------------------- -end subroutine clean_Gdata - - - -subroutine ncerr(status) -!-------------------------------------------------------------------------------- -! Handle netCDF-errors -!-------------------------------------------------------------------------------- -integer, intent(in) :: status - -if(status == nf90_NoErr) return - -write(io_stdo_bgc,*) 'NetCDF error: ',nf90_strerror(status) -write(io_stdo_bgc,*) 'Abort... ' -call flush(io_stdo_bgc) -call xchalt('(Module mo_Gdata_read, ncerr)') -stop '(Module mo_Gdata_read, ncerr)' - - -!-------------------------------------------------------------------------------- -end subroutine ncerr - - -subroutine moderr(routinestr,errstr) -!-------------------------------------------------------------------------------- -! Handle errors, which occur in this module -!-------------------------------------------------------------------------------- -character(len=*), intent(in) :: routinestr,errstr + subroutine moderr(routinestr,errstr) + !-------------------------------------------------------------------------------- + ! Handle errors, which occur in this module + !-------------------------------------------------------------------------------- + character(len=*), intent(in) :: routinestr,errstr -write(io_stdo_bgc,'(/3a)') routinestr, ': ', errstr -write(io_stdo_bgc,*) 'Abort... ' -call flush(io_stdo_bgc) -call xchalt('(Module mo_Gdata_read)') -stop '(Module mo_Gdata_read)' + write(io_stdo_bgc,'(/3a)') routinestr, ': ', errstr + write(io_stdo_bgc,*) 'Abort... ' + call flush(io_stdo_bgc) + call xchalt('(Module mo_Gdata_read)') + stop '(Module mo_Gdata_read)' -!-------------------------------------------------------------------------------- -end subroutine moderr + !-------------------------------------------------------------------------------- + end subroutine moderr -!******************************************************************************** + !******************************************************************************** end module mo_Gdata_read diff --git a/hamocc/mo_apply_fedep.F90 b/hamocc/mo_apply_fedep.F90 index b84a8533..ebdc5125 100644 --- a/hamocc/mo_apply_fedep.F90 +++ b/hamocc/mo_apply_fedep.F90 @@ -3,112 +3,111 @@ ! 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_apply_fedep -!******************************************************************************** -! -! J. Schwinger, *NORCE climate, Bergen* 2022-05-19 -! -! -! Purpose -! ------- -! - Routines for applying iron deposition data -! -! -! Description: -! ------------ -! Public routines and variable of this module: -! -! -subroutine apply_fedep -! apply iron deposition to the ocean tracer field -! -! This module replaces code previously found inside the ocprod-routine and -! encapsulates it in a module. -! -! -! Changes: -! -------- -! -!******************************************************************************** -implicit none - -private -public :: apply_fedep - -!******************************************************************************** -contains - - -subroutine apply_fedep(kpie,kpje,kpke,pddpo,omask,dust) -!-------------------------------------------------------------------------------- -! -! Purpose: -! -------- -! Apply dust deposition input to oceanic tracer fields -! -! Description: -! ------------ -! -! -! Arguments: -! ---------- -! *INTEGER* *kpie* - 1st dimension of model grid. -! *INTEGER* *kpje* - 2nd dimension of model grid. -! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. -! *REAL* *pddpo* - size of scalar grid cell (3rd dimension) [m]. -! *REAL* *omask* - ocean mask -! *REAL* *dust* - dust deposition flux [kg/m2/month]. -! -!-------------------------------------------------------------------------------- - use mo_control_bgc, only: dtb - use mo_param1_bgc, only: ifdust,iiron - use mo_param_bgc, only: perc_diron - use mo_carbch, only: ocetra - + !******************************************************************************** + ! + ! J. Schwinger, *NORCE climate, Bergen* 2022-05-19 + ! + ! + ! Purpose + ! ------- + ! - Routines for applying iron deposition data + ! + ! + ! Description: + ! ------------ + ! Public routines and variable of this module: + ! + ! -subroutine apply_fedep + ! apply iron deposition to the ocean tracer field + ! + ! This module replaces code previously found inside the ocprod-routine and + ! encapsulates it in a module. + ! + ! + ! Changes: + ! -------- + ! + !******************************************************************************** implicit none - integer,intent(in) :: kpie,kpje,kpke - real, intent(in) :: pddpo(kpie,kpje,kpke) - real, intent(in) :: omask(kpie,kpje) - real, intent(in) :: dust(kpie,kpje) + private + public :: apply_fedep - ! local variables - integer :: i,j - real :: dustinp - -! dust flux from the atmosphere to the surface layer; dust fields are -! monthly mean values (kg/m2/month - assume 30 days per month here) -! dissolved iron is a fixed fraction (typically 3.5%), and immediately released - -!$OMP PARALLEL DO PRIVATE(i,dustinp) - do j = 1,kpje - do i = 1,kpie - if(omask(i,j) > 0.5) then - dustinp = dust(i,j) / 30. * dtb / pddpo(i,j,1) - ocetra(i,j,1,ifdust) = ocetra(i,j,1,ifdust) + dustinp - ocetra(i,j,1,iiron) = ocetra(i,j,1,iiron) + dustinp * perc_diron - endif - enddo - enddo -!$OMP END PARALLEL DO - - -!-------------------------------------------------------------------------------- -end subroutine apply_fedep + !******************************************************************************** +contains -!******************************************************************************** + subroutine apply_fedep(kpie,kpje,kpke,pddpo,omask,dust) + !-------------------------------------------------------------------------------- + ! + ! Purpose: + ! -------- + ! Apply dust deposition input to oceanic tracer fields + ! + ! Description: + ! ------------ + ! + ! + ! Arguments: + ! ---------- + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. + ! *REAL* *pddpo* - size of scalar grid cell (3rd dimension) [m]. + ! *REAL* *omask* - ocean mask + ! *REAL* *dust* - dust deposition flux [kg/m2/month]. + ! + !-------------------------------------------------------------------------------- + use mo_control_bgc, only: dtb + use mo_param1_bgc, only: ifdust,iiron + use mo_param_bgc, only: perc_diron + use mo_carbch, only: ocetra + + implicit none + + integer,intent(in) :: kpie,kpje,kpke + real, intent(in) :: pddpo(kpie,kpje,kpke) + real, intent(in) :: omask(kpie,kpje) + real, intent(in) :: dust(kpie,kpje) + + ! local variables + integer :: i,j + real :: dustinp + + ! dust flux from the atmosphere to the surface layer; dust fields are + ! monthly mean values (kg/m2/month - assume 30 days per month here) + ! dissolved iron is a fixed fraction (typically 3.5%), and immediately released + + !$OMP PARALLEL DO PRIVATE(i,dustinp) + do j = 1,kpje + do i = 1,kpie + if(omask(i,j) > 0.5) then + dustinp = dust(i,j) / 30. * dtb / pddpo(i,j,1) + ocetra(i,j,1,ifdust) = ocetra(i,j,1,ifdust) + dustinp + ocetra(i,j,1,iiron) = ocetra(i,j,1,iiron) + dustinp * perc_diron + endif + enddo + enddo + !$OMP END PARALLEL DO + + + !-------------------------------------------------------------------------------- + end subroutine apply_fedep + + + !******************************************************************************** end module mo_apply_fedep - diff --git a/hamocc/mo_apply_ndep.F90 b/hamocc/mo_apply_ndep.F90 index b0a4dcb6..b26bc541 100644 --- a/hamocc/mo_apply_ndep.F90 +++ b/hamocc/mo_apply_ndep.F90 @@ -3,127 +3,126 @@ ! 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_apply_ndep -!****************************************************************************** -! -! S.Gao *Gfi, Bergen* 2017-08-19 -! -! Modified -! -------- -! J. Tjiputra, *Uni Research, Bergen* 2017-09-18 -! -add 1 mol [H+], per mol [NO3] deposition, to alkalinity (minus 1 mol) -! -! J. Schwinger, *NORCE climate, Bergen* 2022-05-18 -! -seperate modules into one module that reads a specific data set, and this -! module that applies the n-deposition flux to the surface ocean -! -! -! Purpose -! ------- -! -Routine for applying the nitrogen deposition flux -! -! -! Description: -! ------------ -! -! The routine n_deposition applies the nitrogen deposition flux to the -! top-most model layer. -! -! N deposition is activated through a logical switch 'do_ndep' read from -! HAMOCC's bgcnml namelist. -! -! -subroutine apply_ndep -! Apply n-deposition to the top-most model layer. -! -! -!****************************************************************************** + !****************************************************************************** + ! + ! S.Gao *Gfi, Bergen* 2017-08-19 + ! + ! Modified + ! -------- + ! J. Tjiputra, *Uni Research, Bergen* 2017-09-18 + ! -add 1 mol [H+], per mol [NO3] deposition, to alkalinity (minus 1 mol) + ! + ! J. Schwinger, *NORCE climate, Bergen* 2022-05-18 + ! -seperate modules into one module that reads a specific data set, and this + ! module that applies the n-deposition flux to the surface ocean + ! + ! + ! Purpose + ! ------- + ! -Routine for applying the nitrogen deposition flux + ! + ! + ! Description: + ! ------------ + ! + ! The routine n_deposition applies the nitrogen deposition flux to the + ! top-most model layer. + ! + ! N deposition is activated through a logical switch 'do_ndep' read from + ! HAMOCC's bgcnml namelist. + ! + ! -subroutine apply_ndep + ! Apply n-deposition to the top-most model layer. + ! + ! + !****************************************************************************** implicit none private public :: apply_ndep -!****************************************************************************** + !****************************************************************************** contains -subroutine apply_ndep(kpie,kpje,kpke,pddpo,omask,ndep) -!****************************************************************************** -! -! S. Gao *Gfi, Bergen* 19.08.2017 -! -! Purpose -! ------- -! -apply n-deposition to the top-most model layer. -! -! Changes: -! -------- -! Tjiputra (18.09.2017): add 1 mol [H+], per mol [NO3] deposition, to -! alkalinity (minus 1 mol) -! -! Parameter list: -! --------------- -! *INTEGER* *kpie* - 1st dimension of model grid. -! *INTEGER* *kpje* - 2nd dimension of model grid. -! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. -! *REAL* *pddpo* - size of grid cell (depth) [m]. -! *REAL* *omask* - land/ocean mask (1=ocean) -! *REAL* *ndep* - N-deposition field to apply -! -!****************************************************************************** - use mo_control_bgc, only: 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 - - integer, intent(in) :: kpie,kpje,kpke - real, intent(in) :: pddpo(kpie,kpje,kpke) - real, intent(in) :: omask(kpie,kpje) - real, intent(in) :: ndep(kpie,kpje) - - ! local variables - integer :: i,j - - - ! ndepflx stores the applied n-deposition flux for inventory calculations - ! and output - ndepflx(:,:)=0.0 - - if (.not. do_ndep) return - - ! deposite N in topmost layer - do j=1,kpje - do i=1,kpie - if (omask(i,j).gt.0.5) then - 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) - if (use_natDIC) then - ocetra(i,j,1,inatalkali)=ocetra(i,j,1,inatalkali)-ndepflx(i,j)/pddpo(i,j,1) - endif - endif - enddo - enddo - -!****************************************************************************** -end subroutine apply_ndep - - -!****************************************************************************** + subroutine apply_ndep(kpie,kpje,kpke,pddpo,omask,ndep) + !****************************************************************************** + ! + ! S. Gao *Gfi, Bergen* 19.08.2017 + ! + ! Purpose + ! ------- + ! -apply n-deposition to the top-most model layer. + ! + ! Changes: + ! -------- + ! Tjiputra (18.09.2017): add 1 mol [H+], per mol [NO3] deposition, to + ! alkalinity (minus 1 mol) + ! + ! Parameter list: + ! --------------- + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. + ! *REAL* *pddpo* - size of grid cell (depth) [m]. + ! *REAL* *omask* - land/ocean mask (1=ocean) + ! *REAL* *ndep* - N-deposition field to apply + ! + !****************************************************************************** + use mo_control_bgc, only: 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 + + integer, intent(in) :: kpie,kpje,kpke + real, intent(in) :: pddpo(kpie,kpje,kpke) + real, intent(in) :: omask(kpie,kpje) + real, intent(in) :: ndep(kpie,kpje) + + ! local variables + integer :: i,j + + + ! ndepflx stores the applied n-deposition flux for inventory calculations + ! and output + ndepflx(:,:)=0.0 + + if (.not. do_ndep) return + + ! deposite N in topmost layer + do j=1,kpje + do i=1,kpie + if (omask(i,j).gt.0.5) then + 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) + if (use_natDIC) then + ocetra(i,j,1,inatalkali)=ocetra(i,j,1,inatalkali)-ndepflx(i,j)/pddpo(i,j,1) + endif + endif + enddo + enddo + + !****************************************************************************** + end subroutine apply_ndep + + + !****************************************************************************** end module mo_apply_ndep - diff --git a/hamocc/mo_apply_oafx.F90 b/hamocc/mo_apply_oafx.F90 index e3e73900..06ba90da 100644 --- a/hamocc/mo_apply_oafx.F90 +++ b/hamocc/mo_apply_oafx.F90 @@ -3,107 +3,107 @@ ! 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_apply_oafx -!****************************************************************************** -! -! J.Schwinger *NORCE Climate, Bergen* 2021-11-15 -! -! Modified -! -------- -! -! Purpose -! ------- -! -Routines for applying ocean alkalinization -! -! -! Description: -! ------------ -! -! -subroutine alkalinization -! Apply alkalinization to the top-most model layer. -! -! -!****************************************************************************** + !****************************************************************************** + ! + ! J.Schwinger *NORCE Climate, Bergen* 2021-11-15 + ! + ! Modified + ! -------- + ! + ! Purpose + ! ------- + ! -Routines for applying ocean alkalinization + ! + ! + ! Description: + ! ------------ + ! + ! -subroutine alkalinization + ! Apply alkalinization to the top-most model layer. + ! + ! + !****************************************************************************** implicit none private public :: apply_oafx -!****************************************************************************** + !****************************************************************************** contains -subroutine apply_oafx(kpie,kpje,kpke,pddpo,omask,oafx) -!****************************************************************************** -! -! J. Schwinger *NORCE Climate, Bergen* 2021-11-15 -! -! Purpose -! ------- -! -apply alkalinization to the top-most model layer. -! -! Changes: -! -------- -! -! -! Parameter list: -! --------------- -! *INTEGER* *kpie* - 1st dimension of model grid. -! *INTEGER* *kpje* - 2nd dimension of model grid. -! *REAL* *pddpo* - size of grid cell (depth) [m]. -! *REAL* *omask* - land/ocean mask (1=ocean) -! *REAL* *oafx* - alkalinization field to apply [kmol m-2 yr-1] -! -!****************************************************************************** - use mo_control_bgc, only: dtb,do_oalk - use mo_param1_bgc, only: ialkali - use mo_carbch, only: ocetra,oalkflx,OmegaA - use mo_read_oafx, only: thrh_omegaa + subroutine apply_oafx(kpie,kpje,kpke,pddpo,omask,oafx) + !****************************************************************************** + ! + ! J. Schwinger *NORCE Climate, Bergen* 2021-11-15 + ! + ! Purpose + ! ------- + ! -apply alkalinization to the top-most model layer. + ! + ! Changes: + ! -------- + ! + ! + ! Parameter list: + ! --------------- + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! *REAL* *pddpo* - size of grid cell (depth) [m]. + ! *REAL* *omask* - land/ocean mask (1=ocean) + ! *REAL* *oafx* - alkalinization field to apply [kmol m-2 yr-1] + ! + !****************************************************************************** + use mo_control_bgc, only: dtb,do_oalk + use mo_param1_bgc, only: ialkali + use mo_carbch, only: ocetra,oalkflx,OmegaA + use mo_read_oafx, only: thrh_omegaa - implicit none + implicit none + + integer, intent(in) :: kpie,kpje,kpke + real, intent(in) :: pddpo(kpie,kpje,kpke) + real, intent(in) :: omask(kpie,kpje) + real, intent(in) :: oafx(kpie,kpje) - integer, intent(in) :: kpie,kpje,kpke - real, intent(in) :: pddpo(kpie,kpje,kpke) - real, intent(in) :: omask(kpie,kpje) - real, intent(in) :: oafx(kpie,kpje) + ! local variables + integer :: i,j - ! local variables - integer :: i,j + ! oalkflx stores the applied alaklinity flux for inventory calculations + ! and output + oalkflx(:,:)=0.0 - ! oalkflx stores the applied alaklinity flux for inventory calculations - ! and output - oalkflx(:,:)=0.0 - - if (.not. do_oalk) return + if (.not. do_oalk) return - ! alkalinization in topmost layer - do j=1,kpje - do i=1,kpie - if (omask(i,j).gt.0.5) then - if (thrh_omegaa > 0.0 .and. OmegaA(i,j,1) > thrh_omegaa) cycle - oalkflx(i,j) = oafx(i,j)*dtb/365. - ocetra(i,j,1,ialkali)=ocetra(i,j,1,ialkali)+oalkflx(i,j)/pddpo(i,j,1) - endif - enddo - enddo + ! alkalinization in topmost layer + do j=1,kpje + do i=1,kpie + if (omask(i,j).gt.0.5) then + if (thrh_omegaa > 0.0 .and. OmegaA(i,j,1) > thrh_omegaa) cycle + oalkflx(i,j) = oafx(i,j)*dtb/365. + ocetra(i,j,1,ialkali)=ocetra(i,j,1,ialkali)+oalkflx(i,j)/pddpo(i,j,1) + endif + enddo + enddo -!****************************************************************************** -end subroutine apply_oafx + !****************************************************************************** + end subroutine apply_oafx -!****************************************************************************** + !****************************************************************************** end module mo_apply_oafx diff --git a/hamocc/mo_apply_rivin.F90 b/hamocc/mo_apply_rivin.F90 index a30dec52..1f611d25 100644 --- a/hamocc/mo_apply_rivin.F90 +++ b/hamocc/mo_apply_rivin.F90 @@ -3,188 +3,187 @@ ! 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_apply_rivin -!******************************************************************************** -! -! S. Gao, *Gfi, Bergen* 19.08.2017 -! -! Purpose -! ------- -! - Routines for applying riverine nutrient and carbon input data -! -! -! Description: -! ------------ -! Public routines and variable of this module: -! -! -subroutine apply_rivin -! apply riverine input to the ocean tracer field -! -! BLOM_RIVER_NUTRIENTS must be set to TRUE in env_run.xml to activate -! riverine nutrients. -! -! -! Changes: -! -------- -! J. Schwinger, *NORCE climate, Bergen* 2020-05-27 -! - re-structured this module such that riverine input can be passed as an -! argument to iHAMOCC's main routine -! -! J. Schwinger, *NORCE climate, Bergen* 2022-05-18 -! - re-structured and renamed this module such that reading and application of -! data are seperated into two distinct modules -! -!******************************************************************************** -implicit none + !******************************************************************************** + ! + ! S. Gao, *Gfi, Bergen* 19.08.2017 + ! + ! Purpose + ! ------- + ! - Routines for applying riverine nutrient and carbon input data + ! + ! + ! Description: + ! ------------ + ! Public routines and variable of this module: + ! + ! -subroutine apply_rivin + ! apply riverine input to the ocean tracer field + ! + ! BLOM_RIVER_NUTRIENTS must be set to TRUE in env_run.xml to activate + ! riverine nutrients. + ! + ! + ! Changes: + ! -------- + ! J. Schwinger, *NORCE climate, Bergen* 2020-05-27 + ! - re-structured this module such that riverine input can be passed as an + ! argument to iHAMOCC's main routine + ! + ! J. Schwinger, *NORCE climate, Bergen* 2022-05-18 + ! - re-structured and renamed this module such that reading and application of + ! data are seperated into two distinct modules + ! + !******************************************************************************** + implicit none -private -public :: apply_rivin + private + public :: apply_rivin -! Approx. 80-99% of dFe riverine input is lost to the particulate phase in -! estuaries at low salinities [Boyle et al., 1977; Chester, 1990; Dai and -! Martin, 1995; Lohan and Bruland, 2006; Sholkovitz, 1978]. dFe_frac is the -! fraction of dissolved iron that enters the costal ocean. -real, parameter :: dFe_frac = 0.01 ! assume 99% loss of dissolved iron + ! Approx. 80-99% of dFe riverine input is lost to the particulate phase in + ! estuaries at low salinities [Boyle et al., 1977; Chester, 1990; Dai and + ! Martin, 1995; Lohan and Bruland, 2006; Sholkovitz, 1978]. dFe_frac is the + ! fraction of dissolved iron that enters the costal ocean. + real, parameter :: dFe_frac = 0.01 ! assume 99% loss of dissolved iron -!******************************************************************************** + !******************************************************************************** contains -subroutine apply_rivin(kpie,kpje,kpke,pddpo,omask,rivin) -!-------------------------------------------------------------------------------- -! -! Purpose: -! -------- -! Apply riverine input to oceanic tracer fields -! -! Description: -! ------------ -! -! -! Arguments: -! ---------- -! *INTEGER* *kpie* - 1st dimension of model grid. -! *INTEGER* *kpje* - 2nd dimension of model grid. -! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. -! *REAL* *pddpo* - size of scalar grid cell (3rd dimension) [m]. -! *REAL* *omask* - ocean mask -! *REAL* *rivin* - riverine input field [kmol m-2 yr-1] -! -!-------------------------------------------------------------------------------- - 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 - ! cisonew - use mo_param1_bgc, only: idet13,idet14,idoc13,idoc14,isco213,isco214,safediv - use mo_vgrid, only: kmle - use mo_carbch, only: ocetra,rivinflx - use mo_control_bgc, only: use_natDIC - - implicit none - - integer,intent(in) :: kpie,kpje,kpke - real, intent(in) :: pddpo(kpie,kpje,kpke) - real, intent(in) :: omask(kpie,kpje) - real, intent(in) :: rivin(kpie,kpje,nriv) - - ! local variables - integer :: i,j,k - real :: fdt,volij - - - ! rivinflx stores the applied n-deposition flux for inventory calculations - ! and output - rivinflx(:,:,:) = 0.0 + subroutine apply_rivin(kpie,kpje,kpke,pddpo,omask,rivin) + !-------------------------------------------------------------------------------- + ! + ! Purpose: + ! -------- + ! Apply riverine input to oceanic tracer fields + ! + ! Description: + ! ------------ + ! + ! + ! Arguments: + ! ---------- + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. + ! *REAL* *pddpo* - size of scalar grid cell (3rd dimension) [m]. + ! *REAL* *omask* - ocean mask + ! *REAL* *rivin* - riverine input field [kmol m-2 yr-1] + ! + !-------------------------------------------------------------------------------- + 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 + ! cisonew + use mo_param1_bgc, only: idet13,idet14,idoc13,idoc14,isco213,isco214,safediv + use mo_vgrid, only: kmle + use mo_carbch, only: ocetra,rivinflx + use mo_control_bgc, only: use_natDIC + + implicit none + + integer,intent(in) :: kpie,kpje,kpke + real, intent(in) :: pddpo(kpie,kpje,kpke) + real, intent(in) :: omask(kpie,kpje) + real, intent(in) :: rivin(kpie,kpje,nriv) + + ! local variables + integer :: i,j,k + real :: fdt,volij + + + ! rivinflx stores the applied n-deposition flux for inventory calculations + ! and output + rivinflx(:,:,:) = 0.0 + + if (.not. do_rivinpt) return + + fdt = dtb/365. + + !$OMP PARALLEL DO PRIVATE(i,k,volij) + DO j=1,kpje + DO i=1,kpie + IF(omask(i,j).GT.0.5) THEN + + ! Distribute riverine inputs over the model mixed layer + volij = 0. + DO k=1,kmle(i,j) + volij=volij+pddpo(i,j,k) + ENDDO + + 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 + endif + + ! 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 + ocetra(i,j,1:kmle(i,j),iphosph) = ocetra(i,j,1:kmle(i,j),iphosph) + rivin(i,j,irdip)*fdt/volij + ocetra(i,j,1:kmle(i,j),isilica) = ocetra(i,j,1:kmle(i,j),isilica) + rivin(i,j,irsi) *fdt/volij + ocetra(i,j,1:kmle(i,j),isco212) = ocetra(i,j,1:kmle(i,j),isco212) + 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),ialkali) = ocetra(i,j,1:kmle(i,j),ialkali) + rivin(i,j,iralk)*fdt/volij + 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 + endif + 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 + + rivinflx(i,j,irdin) = rivin(i,j,irdin)*fdt + rivinflx(i,j,irdip) = rivin(i,j,irdip)*fdt + rivinflx(i,j,irsi) = rivin(i,j,irsi)*fdt + rivinflx(i,j,iralk) = rivin(i,j,iralk)*fdt + rivinflx(i,j,iriron) = rivin(i,j,iriron)*fdt*dFe_frac + rivinflx(i,j,irdoc) = rivin(i,j,irdoc)*fdt + rivinflx(i,j,irdet) = rivin(i,j,irdet)*fdt + ENDIF + ENDDO + ENDDO + !$OMP END PARALLEL DO - if (.not. do_rivinpt) return - - fdt = dtb/365. + !-------------------------------------------------------------------------------- + end subroutine apply_rivin -!$OMP PARALLEL DO PRIVATE(i,k,volij) - DO j=1,kpje - DO i=1,kpie - IF(omask(i,j).GT.0.5) THEN - ! Distribute riverine inputs over the model mixed layer - volij = 0. - DO k=1,kmle(i,j) - volij=volij+pddpo(i,j,k) - ENDDO - - 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 - endif - - ! 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 - ocetra(i,j,1:kmle(i,j),iphosph) = ocetra(i,j,1:kmle(i,j),iphosph) + rivin(i,j,irdip)*fdt/volij - ocetra(i,j,1:kmle(i,j),isilica) = ocetra(i,j,1:kmle(i,j),isilica) + rivin(i,j,irsi) *fdt/volij - ocetra(i,j,1:kmle(i,j),isco212) = ocetra(i,j,1:kmle(i,j),isco212) + 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),ialkali) = ocetra(i,j,1:kmle(i,j),ialkali) + rivin(i,j,iralk)*fdt/volij - 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 - endif - 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 - - rivinflx(i,j,irdin) = rivin(i,j,irdin)*fdt - rivinflx(i,j,irdip) = rivin(i,j,irdip)*fdt - rivinflx(i,j,irsi) = rivin(i,j,irsi)*fdt - rivinflx(i,j,iralk) = rivin(i,j,iralk)*fdt - rivinflx(i,j,iriron) = rivin(i,j,iriron)*fdt*dFe_frac - rivinflx(i,j,irdoc) = rivin(i,j,irdoc)*fdt - rivinflx(i,j,irdet) = rivin(i,j,irdet)*fdt - ENDIF - ENDDO - ENDDO -!$OMP END PARALLEL DO - -!-------------------------------------------------------------------------------- -end subroutine apply_rivin - - -!******************************************************************************** + !******************************************************************************** end module mo_apply_rivin - diff --git a/hamocc/mo_bgcmean.F90 b/hamocc/mo_bgcmean.F90 index dacd8b3a..786eff46 100644 --- a/hamocc/mo_bgcmean.F90 +++ b/hamocc/mo_bgcmean.F90 @@ -5,2354 +5,2354 @@ ! 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_bgcmean -!*********************************************************************** -! -!**** *MODULE mo_bgcmean* - Variables for bgcmean. -! -! -! Patrick Wetzel *MPI-Met, HH* 09.12.02 -! Ingo Bethke *Bjer.NE. C.* 05.11.09 -! J. Schwinger *GFI, UiB 10.02.12 -! - added variables and functions for sediment burial -! - added variables for CFC output -! - added initialisation of namelist variables and -! index arrays -! -! Tjiputra *UNI-RESEARCH 25.11.15 -! - added natural DIC/ALK/CALC/OMEGAC variables -! -! A.Moree, *GFI, Bergen* 2018-04-12 -! - new version of carbon isotope code -! -! J.Tjiputra, *Uni Research, Bergen* 2018-04-12 -! - added preformed and saturated DIC tracers -! -! J.Schwinger, *Uni Research, Bergen* 2018-04-12 -! - changed naming of particle fluxes -! - removed output of AOU and added O2_sat instead -! - added output of omegaA -! - added sediment bypass preprocessor option -! -! Purpose -! ------- -! - declaration and memory allocation -! - declaration of auxiliary functions -! -!********************************************************************** - use mod_xc, only: ii,jj,kk,idm,jdm,kdm,nbdy,ifp,isp,ilp,mnproc,ip - use mod_dia, only: ddm,depthslev,depthslev_bnds,nstepinday,pbath - 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 - - PRIVATE :: ii,jj,kk,idm,jdm,kdm,nbdy,ifp,isp,ilp - PUBLIC :: ks,ddm,depthslev,depthslev_bnds - -! --- Averaging and writing frequencies for diagnostic output - INTEGER, SAVE :: nbgc - INTEGER, PARAMETER :: nbgcmax=10 - REAL, DIMENSION(nbgcmax), SAVE :: diagfq_bgc,filefq_bgc - INTEGER, DIMENSION(nbgcmax), SAVE :: nacc_bgc - LOGICAL, DIMENSION(nbgcmax), SAVE :: diagmon_bgc,diagann_bgc, & - & filemon_bgc,fileann_bgc,bgcwrt - -! --- Namelist for diagnostic output - INTEGER, DIMENSION(nbgcmax), SAVE :: & - & SRF_KWCO2 =0 ,SRF_PCO2 =0 ,SRF_DMSFLUX =0 , & - & SRF_KWCO2KHM =0 ,SRF_CO2KHM =0 ,SRF_CO2KH =0 , & - & SRF_PCO2M =0 , & - & SRF_CO2FXD =0 ,SRF_CO2FXU =0 ,SRF_CO213FXD =0 , & - & SRF_CO213FXU =0 ,SRF_CO214FXD =0 ,SRF_CO214FXU =0 , & - & SRF_OXFLUX =0 ,SRF_NIFLUX =0 ,SRF_DMS =0 , & - & SRF_DMSPROD =0 ,SRF_DMS_BAC =0 ,SRF_DMS_UV =0 , & - & SRF_EXPORT =0 ,SRF_EXPOSI =0 ,SRF_EXPOCA =0 , & - & SRF_ATMCO2 =0 ,SRF_ATMO2 =0 ,SRF_ATMN2 =0 , & - & SRF_ATMC13 =0 ,SRF_ATMC14 =0 , & - & SRF_N2OFX =0 ,SRF_CFC11 =0 ,SRF_CFC12 =0 , & - & SRF_SF6 =0 ,SRF_PHOSPH =0 ,SRF_OXYGEN =0 , & - & SRF_IRON =0 ,SRF_ANO3 =0 ,SRF_ALKALI =0 , & - & SRF_SILICA =0 ,SRF_DIC =0 ,SRF_PHYTO =0 , & - & SRF_PH =0 , & - & SRF_NATDIC =0 ,SRF_NATALKALI =0 ,SRF_NATPCO2 =0 , & - & SRF_NATCO2FX =0 ,SRF_NATPH =0 , & - & SRF_ATMBROMO =0 ,SRF_BROMO =0 ,SRF_BROMOFX =0 , & - & INT_BROMOPRO =0 ,INT_BROMOUV =0 , & - & INT_PHOSY =0 ,INT_NFIX =0 ,INT_DNIT =0 , & - & FLX_NDEP =0 ,FLX_OALK =0 , & - & FLX_CAR0100 =0 ,FLX_CAR0500 =0 ,FLX_CAR1000 =0 , & - & FLX_CAR2000 =0 ,FLX_CAR4000 =0 ,FLX_CAR_BOT =0 , & - & FLX_BSI0100 =0 ,FLX_BSI0500 =0 ,FLX_BSI1000 =0 , & - & FLX_BSI2000 =0 ,FLX_BSI4000 =0 ,FLX_BSI_BOT =0 , & - & FLX_CAL0100 =0 ,FLX_CAL0500 =0 ,FLX_CAL1000 =0 , & - & FLX_CAL2000 =0 ,FLX_CAL4000 =0 ,FLX_CAL_BOT =0 , & - & FLX_SEDIFFIC =0 ,FLX_SEDIFFAL =0 ,FLX_SEDIFFPH =0 , & - & FLX_SEDIFFOX =0 ,FLX_SEDIFFN2 =0 ,FLX_SEDIFFNO3 =0 , & - & FLX_SEDIFFSI =0 , & - & LYR_PHYTO =0 ,LYR_GRAZER =0 ,LYR_DOC =0 , & - & LYR_PHOSY =0 ,LYR_PHOSPH =0 ,LYR_OXYGEN =0 , & - & LYR_IRON =0 ,LYR_ANO3 =0 ,LYR_ALKALI =0 , & - & LYR_SILICA =0 ,LYR_DIC =0 ,LYR_POC =0 , & - & LYR_CALC =0 ,LYR_OPAL =0 ,LYR_CO3 =0 , & - & LYR_PH =0 ,LYR_OMEGAA =0 ,LYR_OMEGAC =0 , & - & LYR_DIC13 =0 ,LYR_DIC14 =0 ,LYR_DP =0 , & - & LYR_NOS =0 ,LYR_WPHY =0 ,LYR_WNOS =0 , & - & LYR_EPS =0 ,LYR_ASIZE =0 ,LYR_N2O =0 , & - & LYR_PREFO2 =0 ,LYR_O2SAT =0 ,LYR_PREFPO4 =0 , & - & LYR_PREFALK =0 ,LYR_PREFDIC =0 ,LYR_DICSAT =0 , & - & LYR_CFC11 =0 ,LYR_CFC12 =0 ,LYR_SF6 =0 , & - & LYR_NATDIC =0 ,LYR_NATALKALI =0 ,LYR_NATCALC =0 , & - & LYR_NATPH =0 ,LYR_NATOMEGAA =0 ,LYR_NATOMEGAC =0 , & - & LYR_NATCO3 =0 , & - & LYR_BROMO =0 , & - & LYR_D13C =0 ,LYR_D14C =0 ,LYR_BIGD14C =0 , & - & LYR_POC13 =0 ,LYR_DOC13 =0 ,LYR_CALC13 =0 , & - & LYR_PHYTO13 =0 ,LYR_GRAZER13 =0 , & - & LVL_PHYTO =0 ,LVL_GRAZER =0 ,LVL_DOC =0 , & - & LVL_PHOSY =0 ,LVL_PHOSPH =0 ,LVL_OXYGEN =0 , & - & LVL_IRON =0 ,LVL_ANO3 =0 ,LVL_ALKALI =0 , & - & LVL_SILICA =0 ,LVL_DIC =0 ,LVL_POC =0 , & - & LVL_CALC =0 ,LVL_OPAL =0 ,LVL_CO3 =0 , & - & LVL_PH =0 ,LVL_OMEGAA =0 ,LVL_OMEGAC =0 , & - & LVL_DIC13 =0 ,LVL_DIC14 =0 ,LVL_NOS =0 , & - & LVL_WPHY =0 ,LVL_WNOS =0 ,LVL_EPS =0 , & - & LVL_ASIZE =0 ,LVL_N2O =0 ,LVL_PREFO2 =0 , & - & LVL_O2SAT =0 ,LVL_PREFPO4 =0 ,LVL_PREFALK =0 , & - & LVL_PREFDIC =0 ,LVL_DICSAT =0 , & - & LVL_CFC11 =0 ,LVL_CFC12 =0 ,LVL_SF6 =0 , & - & LVL_NATDIC =0 ,LVL_NATALKALI =0 ,LVL_NATCALC =0 , & - & LVL_NATPH =0 ,LVL_NATOMEGAA =0 ,LVL_NATOMEGAC =0 , & - & LVL_NATCO3 =0 , & - & LVL_BROMO =0 , & - & LVL_D13C =0 ,LVL_D14C =0 ,LVL_BIGD14C =0 , & - & LVL_POC13 =0 ,LVL_DOC13 =0 ,LVL_CALC13 =0 , & - & LVL_PHYTO13 =0 ,LVL_GRAZER13 =0 , & - & SDM_POWAIC =0 ,SDM_POWAAL =0 ,SDM_POWAPH =0 , & - & SDM_POWAOX =0 ,SDM_POWN2 =0 ,SDM_POWNO3 =0 , & - & SDM_POWASI =0 ,SDM_SSSO12 =0 ,SDM_SSSSIL =0 , & - & SDM_SSSC12 =0 ,SDM_SSSTER =0 , & - & BUR_SSSO12 =0 ,BUR_SSSC12 =0 ,BUR_SSSSIL =0 , & - & BUR_SSSTER =0 , & - & GLB_AVEPERIO =0 ,GLB_FILEFREQ =0 ,GLB_COMPFLAG =0 , & - & GLB_NCFORMAT =0 ,GLB_INVENTORY =0 - CHARACTER(LEN=10), DIMENSION(nbgcmax), SAVE :: GLB_FNAMETAG - namelist /DIABGC/ & - & SRF_KWCO2 ,SRF_PCO2 ,SRF_DMSFLUX , & - & SRF_KWCO2KHM ,SRF_CO2KHM ,SRF_CO2KH , & - & SRF_PCO2M , & - & SRF_CO2FXD ,SRF_CO2FXU ,SRF_CO213FXD , & - & SRF_CO213FXU ,SRF_CO214FXD ,SRF_CO214FXU , & - & SRF_OXFLUX ,SRF_NIFLUX ,SRF_DMS , & - & SRF_DMSPROD ,SRF_DMS_BAC ,SRF_DMS_UV , & - & SRF_EXPORT ,SRF_EXPOSI ,SRF_EXPOCA , & - & SRF_ATMCO2 ,SRF_ATMO2 ,SRF_ATMN2 , & - & SRF_ATMC13 ,SRF_ATMC14 , & - & SRF_N2OFX ,SRF_CFC11 ,SRF_CFC12 , & - & SRF_SF6 ,SRF_PHOSPH ,SRF_OXYGEN , & - & SRF_IRON ,SRF_ANO3 ,SRF_ALKALI , & - & SRF_SILICA ,SRF_DIC ,SRF_PHYTO , & - & SRF_PH , & - & SRF_NATDIC ,SRF_NATALKALI ,SRF_NATPCO2 , & - & SRF_NATCO2FX ,SRF_NATPH , & - & SRF_ATMBROMO ,SRF_BROMO ,SRF_BROMOFX , & - & INT_BROMOPRO ,INT_BROMOUV , & - & 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 , & - & LYR_PHYTO ,LYR_GRAZER ,LYR_DOC , & - & LYR_PHOSY ,LYR_PHOSPH ,LYR_OXYGEN , & - & LYR_IRON ,LYR_ANO3 ,LYR_ALKALI , & - & LYR_SILICA ,LYR_DIC ,LYR_POC , & - & LYR_CALC ,LYR_OPAL ,LYR_CO3 , & - & LYR_PH ,LYR_OMEGAA ,LYR_OMEGAC , & - & LYR_DIC13 ,LYR_DIC14 ,LYR_DP , & - & LYR_NOS ,LYR_WPHY ,LYR_WNOS , & - & LYR_EPS ,LYR_ASIZE ,LYR_N2O , & - & LYR_PREFO2 ,LYR_O2SAT ,LYR_PREFPO4 , & - & LYR_PREFALK ,LYR_PREFDIC ,LYR_DICSAT , & - & LYR_CFC11 ,LYR_CFC12 ,LYR_SF6 , & - & LYR_NATDIC ,LYR_NATALKALI ,LYR_NATCALC , & - & LYR_NATPH ,LYR_NATOMEGAA ,LYR_NATOMEGAC , & - & LYR_NATCO3 , & - & LYR_BROMO , & - & LYR_D13C ,LYR_D14C ,LYR_BIGD14C , & - & LYR_PHYTO13 ,LYR_GRAZER13 ,LYR_POC13 , & - & LYR_DOC13 ,LYR_CALC13 , & - & LVL_PHYTO ,LVL_GRAZER ,LVL_DOC , & - & LVL_PHOSY ,LVL_PHOSPH ,LVL_OXYGEN , & - & LVL_IRON ,LVL_ANO3 ,LVL_ALKALI , & - & LVL_SILICA ,LVL_DIC ,LVL_POC , & - & LVL_CALC ,LVL_OPAL ,LVL_CO3 , & - & LVL_PH ,LVL_OMEGAA ,LVL_OMEGAC , & - & LVL_DIC13 ,LVL_DIC14 ,LVL_NOS , & - & LVL_WPHY ,LVL_WNOS ,LVL_EPS , & - & LVL_ASIZE ,LVL_N2O ,LVL_PREFO2 , & - & LVL_O2SAT ,LVL_PREFPO4 ,LVL_PREFALK , & - & LVL_PREFDIC ,LVL_DICSAT , & - & LVL_CFC11 ,LVL_CFC12 ,LVL_SF6 , & - & LVL_NATDIC ,LVL_NATALKALI ,LVL_NATCALC , & - & LVL_NATPH ,LVL_NATOMEGAA ,LVL_NATOMEGAC , & - & LVL_NATCO3 , & - & LVL_BROMO , & - & LVL_D13C ,LVL_D14C ,LVL_BIGD14C , & - & LVL_PHYTO13 ,LVL_GRAZER13 ,LVL_POC13 , & - & LVL_DOC13 ,LVL_CALC13 , & - & 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 , & - & GLB_AVEPERIO ,GLB_FILEFREQ ,GLB_COMPFLAG , & - & GLB_NCFORMAT ,GLB_FNAMETAG ,GLB_INVENTORY - -!---------------------------------------------------------------- -! declarations for inventory_bgc.F90 -! order and increments of river (jir...) indices require to be the same -! as in mo_riverinpt - INTEGER, parameter :: & - & jco2flux =1, & - & jo2flux =2, & - & jn2flux =3, & - & jn2oflux =4, & - & jprorca =5, & - & jprcaca =6, & - & jsilpro =7, & - & jpodiic =8, & - & jpodial =9, & - & jpodiph =10, & - & jpodiox =11, & - & jpodin2 =12, & - & jpodino3 =13, & - & jpodisi =14, & - & jndep =15, & - & joalk =16, & - & jirdin =17, & - & jirdip =18, & - & jirsi =19, & - & jiralk =20, & - & jiriron =21, & - & jirdoc =22, & - & jirdet =23, & - & nbgct2d =23 - -!---------------------------------------------------------------- - INTEGER, SAVE :: i_bsc_m2d - INTEGER, DIMENSION(nbgcmax), SAVE :: & - & jkwco2 = 0 , & - & jkwco2khm = 0 , & - & jco2kh = 0 , & - & jco2khm = 0 , & - & jpco2 = 0 , & - & jpco2m = 0 , & - & jdmsflux = 0 , & - & jco2fxd = 0 , & - & jco2fxu = 0 , & - & jco213fxd = 0 , & - & jco213fxu = 0 , & - & jco214fxd = 0 , & - & jco214fxu = 0 , & - & joxflux = 0 , & - & jniflux = 0 , & - & jn2ofx = 0 , & - & jdms = 0 , & - & jdmsprod = 0 , & - & jdms_bac = 0 , & - & jdms_uv = 0 , & - & jexport = 0 , & - & jexpoca = 0 , & - & jexposi = 0 , & - & jcfc11fx = 0 , & - & jcfc12fx = 0 , & - & jsf6fx = 0 , & - & jsrfphosph = 0 , & - & jsrfoxygen = 0 , & - & jsrfiron = 0 , & - & jsrfano3 = 0 , & - & jsrfalkali = 0 , & - & jsrfsilica = 0 , & - & jsrfdic = 0 , & - & jsrfphyto = 0 , & - & jsrfph = 0 , & - & jintphosy = 0 , & - & jintnfix = 0 , & - & jintdnit = 0 , & - & jndepfx = 0 , & - & joalkfx = 0 , & - & jcarflx0100= 0 , & - & jcarflx0500= 0 , & - & jcarflx1000= 0 , & - & jcarflx2000= 0 , & - & jcarflx4000= 0 , & - & jcarflx_bot= 0 , & - & jbsiflx0100= 0 , & - & jbsiflx0500= 0 , & - & jbsiflx1000= 0 , & - & jbsiflx2000= 0 , & - & jbsiflx4000= 0 , & - & jbsiflx_bot= 0 , & - & jcalflx0100= 0 , & - & jcalflx0500= 0 , & - & jcalflx1000= 0 , & - & jcalflx2000= 0 , & - & jcalflx4000= 0 , & - & jcalflx_bot= 0 - - INTEGER, DIMENSION(nbgcmax), SAVE :: & - & jsediffic = 0 , & - & jsediffal = 0 , & - & jsediffph = 0 , & - & jsediffox = 0 , & - & jsediffn2 = 0 , & - & jsediffno3 = 0 , & - jsediffsi = 0 - - INTEGER, DIMENSION(nbgcmax), SAVE :: & - & jsrfnatdic = 0 , & - & jsrfnatalk = 0 , & - & jnatpco2 = 0 , & - & jnatco2fx = 0 , & - & jsrfnatph = 0 - - INTEGER, DIMENSION(nbgcmax), SAVE :: & - & jbromofx = 0 , & - & jsrfbromo = 0 , & - & jbromo_prod= 0 , & - & jbromo_uv = 0 - - INTEGER, SAVE :: i_atm_m2d - INTEGER, DIMENSION(nbgcmax), SAVE :: & - & jatmco2 = 0 , & - & jatmo2 = 0 , & - & jatmn2 = 0 , & - & jatmc13 = 0 , & - & jatmc14 = 0 , & - & jatmbromo= 0 - - INTEGER, SAVE :: nbgcm2d - - LOGICAL, SAVE :: domassfluxes = .false. - -!---------------------------------------------------------------- - INTEGER, SAVE :: i_bsc_m3d,ilvl_bsc_m3d - INTEGER, DIMENSION(nbgcmax), SAVE :: & - & jdp = 0 , & - & jphyto = 0 , & - & jgrazer = 0 , & - & jdoc = 0 , & - & jphosy = 0 , & - & jphosph = 0 , & - & joxygen = 0 , & - & jiron = 0 , & - & jano3 = 0 , & - & jalkali = 0 , & - & jsilica = 0 , & - & jdic = 0 , & - & jpoc = 0 , & - & jcalc = 0 , & - & jopal = 0 , & - & jco3 = 0 , & - & jph = 0 , & - & jomegaa = 0 , & - & jomegac = 0 , & - & jn2o = 0 , & - & jprefo2 = 0 , & - & jo2sat = 0 , & - & jprefpo4 = 0 , & - & jprefalk = 0 , & - & jprefdic = 0 , & - & jdicsat = 0 , & - & jcfc11 = 0 , & - & jcfc12 = 0 , & - & jsf6 = 0 , & - & jlvlphyto = 0 , & - & jlvlgrazer = 0 , & - & jlvldoc = 0 , & - & jlvlphosy = 0 , & - & jlvlphosph = 0 , & - & jlvloxygen = 0 , & - & jlvliron = 0 , & - & jlvlano3 = 0 , & - & jlvlalkali = 0 , & - & jlvlsilica = 0 , & - & jlvldic = 0 , & - & jlvlpoc = 0 , & - & jlvlcalc = 0 , & - & jlvlopal = 0 , & - & jlvlco3 = 0 , & - & jlvlph = 0 , & - & jlvlomegaa = 0 , & - & jlvlomegac = 0 , & - & jlvln2o = 0 , & - & jlvlprefo2 = 0 , & - & jlvlo2sat = 0 , & - & jlvlprefpo4= 0 , & - & jlvlprefalk= 0 , & - & jlvlprefdic= 0 , & - & jlvldicsat = 0 , & - & jlvlcfc11 = 0 , & - & jlvlcfc12 = 0 , & - & jlvlsf6 = 0 - - INTEGER, DIMENSION(nbgcmax), SAVE :: & - & jdic13 = 0 , & - & jdic14 = 0 , & - & jd13c = 0 , & - & jd14c = 0 , & - & jbigd14c = 0 , & - & jpoc13 = 0 , & - & jdoc13 = 0 , & - & jcalc13 = 0 , & - & jphyto13 = 0 , & - & jgrazer13 = 0 , & - & jlvldic13 = 0 , & - & jlvldic14 = 0 , & - & jlvld13c = 0 , & - & jlvld14c = 0 , & - & jlvlbigd14c= 0 , & - & jlvlpoc13 = 0 , & - & jlvldoc13 = 0 , & - & jlvlcalc13 = 0 , & - & jlvlphyto13 = 0, & - & jlvlgrazer13= 0 - - INTEGER, DIMENSION(nbgcmax), SAVE :: & - & jnos = 0 , & - & jwphy = 0 , & - & jwnos = 0 , & - & jeps = 0 , & - & jasize = 0 , & - & jlvlnos = 0 , & - & jlvlwphy = 0 , & - & jlvlwnos = 0 , & - & jlvleps = 0 , & - & jlvlasize = 0 - - INTEGER, DIMENSION(nbgcmax), SAVE :: & - & jnatco3 = 0 , & - & jnatalkali = 0 , & - & jnatdic = 0 , & - & jnatcalc = 0 , & - & jnatph = 0 , & - & jnatomegaa = 0 , & - & jnatomegac = 0 , & - & jlvlnatco3 = 0 , & - & jlvlnatalkali = 0 , & - & jlvlnatdic = 0 , & - & jlvlnatcalc = 0 , & - & jlvlnatph = 0 , & - & jlvlnatomegaa = 0 , & - & jlvlnatomegac = 0 - - INTEGER, DIMENSION(nbgcmax), SAVE :: & - & jbromo = 0 , & - & jlvlbromo = 0 - - INTEGER, SAVE :: nbgcm3d,nbgcm3dlvl - -!---------------------------------------------------------------- -! sediment - INTEGER, SAVE :: i_bsc_sed - INTEGER, DIMENSION(nbgcmax), SAVE :: & - & jpowaic = 0 , & - & jpowaal = 0 , & - & jpowaph = 0 , & - & jpowaox = 0 , & - & jpown2 = 0 , & - & jpowno3 = 0 , & - & jpowasi = 0 , & - & jssso12 = 0 , & - & jssssil = 0 , & - & jsssc12 = 0 , & - & jssster = 0 - - - INTEGER, SAVE :: nbgct_sed - -!---------------------------------------------------------------- -! burial - INTEGER, SAVE :: i_bsc_bur - INTEGER, DIMENSION(nbgcmax), SAVE :: & - & jburssso12 = 0 , & - & jbursssc12 = 0 , & - & jburssssil = 0 , & - & jburssster = 0 - - - INTEGER, SAVE :: nbgct_bur - -!---------------------------------------------------------------- - - REAL, DIMENSION (:,:,:), ALLOCATABLE :: bgct2d - REAL, DIMENSION (:,:,:), ALLOCATABLE :: bgcm2d - REAL, DIMENSION (:,:,:,:), ALLOCATABLE :: bgcm3d,bgcm3dlvl - REAL, DIMENSION (:,:,:,:), ALLOCATABLE :: bgct_sed - REAL, DIMENSION (:,:,:), ALLOCATABLE :: bgct_bur - - - CONTAINS - - - SUBROUTINE ALLOC_MEM_BGCMEAN(kpie,kpje,kpke) - - use mo_control_bgc, only: io_stdo_bgc,bgc_namelist,get_bgc_namelist - - IMPLICIT NONE - - INTEGER, intent(in) :: kpie,kpje,kpke - - INTEGER :: m,n,errstat,iounit,checkdp(nbgcmax) - -! Read namelist for diagnostic output - GLB_AVEPERIO=0 - if(.not. allocated(bgc_namelist)) call get_bgc_namelist - OPEN (newunit=iounit, file=bgc_namelist, & - status='old', action='read', recl=80) - READ (iounit,nml=diabgc) - CLOSE (iounit) - -! Determine number of output groups - nbgc=0 - DO n=1,nbgcmax - IF (GLB_AVEPERIO(n).NE.0) THEN - nbgc=nbgc+1 - nacc_bgc(n)=0 - ENDIF - ENDDO - - DO n=1,nbgc - GLB_FILEFREQ(n)=max(GLB_AVEPERIO(n),GLB_FILEFREQ(n)) - IF (GLB_AVEPERIO(n).LT.0) THEN - diagfq_bgc(n)=-real(nstepinday)/GLB_AVEPERIO(n) - ELSE - diagfq_bgc(n)=nstepinday*max(1,GLB_AVEPERIO(n)) - ENDIF - diagmon_bgc(n)=.false. - diagann_bgc(n)=.false. - IF (GLB_AVEPERIO(n).EQ.30) THEN - diagmon_bgc(n)=.true. - ELSEIF (GLB_AVEPERIO(n).EQ.365) THEN - diagann_bgc(n)=.true. - ENDIF - IF (GLB_FILEFREQ(n).LT.0) THEN - filefq_bgc(n)=-real(nstepinday)/GLB_FILEFREQ(n) - ELSE - filefq_bgc(n)=nstepinday*max(1,GLB_FILEFREQ(n)) - ENDIF - filemon_bgc(n)=.false. - fileann_bgc(n)=.false. - IF (GLB_FILEFREQ(n).EQ.30) THEN - filemon_bgc(n)=.true. - ELSEIF (GLB_FILEFREQ(n).EQ.365) THEN - fileann_bgc(n)=.true. - ENDIF - ENDDO +MODULE mo_bgcmean + !*********************************************************************** + ! + !**** *MODULE mo_bgcmean* - Variables for bgcmean. + ! + ! + ! Patrick Wetzel *MPI-Met, HH* 09.12.02 + ! Ingo Bethke *Bjer.NE. C.* 05.11.09 + ! J. Schwinger *GFI, UiB 10.02.12 + ! - added variables and functions for sediment burial + ! - added variables for CFC output + ! - added initialisation of namelist variables and + ! index arrays + ! + ! Tjiputra *UNI-RESEARCH 25.11.15 + ! - added natural DIC/ALK/CALC/OMEGAC variables + ! + ! A.Moree, *GFI, Bergen* 2018-04-12 + ! - new version of carbon isotope code + ! + ! J.Tjiputra, *Uni Research, Bergen* 2018-04-12 + ! - added preformed and saturated DIC tracers + ! + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - changed naming of particle fluxes + ! - removed output of AOU and added O2_sat instead + ! - added output of omegaA + ! - added sediment bypass preprocessor option + ! + ! Purpose + ! ------- + ! - declaration and memory allocation + ! - declaration of auxiliary functions + ! + !********************************************************************** + use mod_xc, only: ii,jj,kk,idm,jdm,kdm,nbdy,ifp,isp,ilp,mnproc,ip + use mod_dia, only: ddm,depthslev,depthslev_bnds,nstepinday,pbath + 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 + + PRIVATE :: ii,jj,kk,idm,jdm,kdm,nbdy,ifp,isp,ilp + PUBLIC :: ks,ddm,depthslev,depthslev_bnds + + ! --- Averaging and writing frequencies for diagnostic output + INTEGER, SAVE :: nbgc + INTEGER, PARAMETER :: nbgcmax=10 + REAL, DIMENSION(nbgcmax), SAVE :: diagfq_bgc,filefq_bgc + INTEGER, DIMENSION(nbgcmax), SAVE :: nacc_bgc + LOGICAL, DIMENSION(nbgcmax), SAVE :: diagmon_bgc,diagann_bgc, & + & filemon_bgc,fileann_bgc,bgcwrt + + ! --- Namelist for diagnostic output + INTEGER, DIMENSION(nbgcmax), SAVE :: & + & SRF_KWCO2 =0 ,SRF_PCO2 =0 ,SRF_DMSFLUX =0 , & + & SRF_KWCO2KHM =0 ,SRF_CO2KHM =0 ,SRF_CO2KH =0 , & + & SRF_PCO2M =0 , & + & SRF_CO2FXD =0 ,SRF_CO2FXU =0 ,SRF_CO213FXD =0 , & + & SRF_CO213FXU =0 ,SRF_CO214FXD =0 ,SRF_CO214FXU =0 , & + & SRF_OXFLUX =0 ,SRF_NIFLUX =0 ,SRF_DMS =0 , & + & SRF_DMSPROD =0 ,SRF_DMS_BAC =0 ,SRF_DMS_UV =0 , & + & SRF_EXPORT =0 ,SRF_EXPOSI =0 ,SRF_EXPOCA =0 , & + & SRF_ATMCO2 =0 ,SRF_ATMO2 =0 ,SRF_ATMN2 =0 , & + & SRF_ATMC13 =0 ,SRF_ATMC14 =0 , & + & SRF_N2OFX =0 ,SRF_CFC11 =0 ,SRF_CFC12 =0 , & + & SRF_SF6 =0 ,SRF_PHOSPH =0 ,SRF_OXYGEN =0 , & + & SRF_IRON =0 ,SRF_ANO3 =0 ,SRF_ALKALI =0 , & + & SRF_SILICA =0 ,SRF_DIC =0 ,SRF_PHYTO =0 , & + & SRF_PH =0 , & + & SRF_NATDIC =0 ,SRF_NATALKALI =0 ,SRF_NATPCO2 =0 , & + & SRF_NATCO2FX =0 ,SRF_NATPH =0 , & + & SRF_ATMBROMO =0 ,SRF_BROMO =0 ,SRF_BROMOFX =0 , & + & INT_BROMOPRO =0 ,INT_BROMOUV =0 , & + & INT_PHOSY =0 ,INT_NFIX =0 ,INT_DNIT =0 , & + & FLX_NDEP =0 ,FLX_OALK =0 , & + & FLX_CAR0100 =0 ,FLX_CAR0500 =0 ,FLX_CAR1000 =0 , & + & FLX_CAR2000 =0 ,FLX_CAR4000 =0 ,FLX_CAR_BOT =0 , & + & FLX_BSI0100 =0 ,FLX_BSI0500 =0 ,FLX_BSI1000 =0 , & + & FLX_BSI2000 =0 ,FLX_BSI4000 =0 ,FLX_BSI_BOT =0 , & + & FLX_CAL0100 =0 ,FLX_CAL0500 =0 ,FLX_CAL1000 =0 , & + & FLX_CAL2000 =0 ,FLX_CAL4000 =0 ,FLX_CAL_BOT =0 , & + & FLX_SEDIFFIC =0 ,FLX_SEDIFFAL =0 ,FLX_SEDIFFPH =0 , & + & FLX_SEDIFFOX =0 ,FLX_SEDIFFN2 =0 ,FLX_SEDIFFNO3 =0 , & + & FLX_SEDIFFSI =0 , & + & LYR_PHYTO =0 ,LYR_GRAZER =0 ,LYR_DOC =0 , & + & LYR_PHOSY =0 ,LYR_PHOSPH =0 ,LYR_OXYGEN =0 , & + & LYR_IRON =0 ,LYR_ANO3 =0 ,LYR_ALKALI =0 , & + & LYR_SILICA =0 ,LYR_DIC =0 ,LYR_POC =0 , & + & LYR_CALC =0 ,LYR_OPAL =0 ,LYR_CO3 =0 , & + & LYR_PH =0 ,LYR_OMEGAA =0 ,LYR_OMEGAC =0 , & + & LYR_DIC13 =0 ,LYR_DIC14 =0 ,LYR_DP =0 , & + & LYR_NOS =0 ,LYR_WPHY =0 ,LYR_WNOS =0 , & + & LYR_EPS =0 ,LYR_ASIZE =0 ,LYR_N2O =0 , & + & LYR_PREFO2 =0 ,LYR_O2SAT =0 ,LYR_PREFPO4 =0 , & + & LYR_PREFALK =0 ,LYR_PREFDIC =0 ,LYR_DICSAT =0 , & + & LYR_CFC11 =0 ,LYR_CFC12 =0 ,LYR_SF6 =0 , & + & LYR_NATDIC =0 ,LYR_NATALKALI =0 ,LYR_NATCALC =0 , & + & LYR_NATPH =0 ,LYR_NATOMEGAA =0 ,LYR_NATOMEGAC =0 , & + & LYR_NATCO3 =0 , & + & LYR_BROMO =0 , & + & LYR_D13C =0 ,LYR_D14C =0 ,LYR_BIGD14C =0 , & + & LYR_POC13 =0 ,LYR_DOC13 =0 ,LYR_CALC13 =0 , & + & LYR_PHYTO13 =0 ,LYR_GRAZER13 =0 , & + & LVL_PHYTO =0 ,LVL_GRAZER =0 ,LVL_DOC =0 , & + & LVL_PHOSY =0 ,LVL_PHOSPH =0 ,LVL_OXYGEN =0 , & + & LVL_IRON =0 ,LVL_ANO3 =0 ,LVL_ALKALI =0 , & + & LVL_SILICA =0 ,LVL_DIC =0 ,LVL_POC =0 , & + & LVL_CALC =0 ,LVL_OPAL =0 ,LVL_CO3 =0 , & + & LVL_PH =0 ,LVL_OMEGAA =0 ,LVL_OMEGAC =0 , & + & LVL_DIC13 =0 ,LVL_DIC14 =0 ,LVL_NOS =0 , & + & LVL_WPHY =0 ,LVL_WNOS =0 ,LVL_EPS =0 , & + & LVL_ASIZE =0 ,LVL_N2O =0 ,LVL_PREFO2 =0 , & + & LVL_O2SAT =0 ,LVL_PREFPO4 =0 ,LVL_PREFALK =0 , & + & LVL_PREFDIC =0 ,LVL_DICSAT =0 , & + & LVL_CFC11 =0 ,LVL_CFC12 =0 ,LVL_SF6 =0 , & + & LVL_NATDIC =0 ,LVL_NATALKALI =0 ,LVL_NATCALC =0 , & + & LVL_NATPH =0 ,LVL_NATOMEGAA =0 ,LVL_NATOMEGAC =0 , & + & LVL_NATCO3 =0 , & + & LVL_BROMO =0 , & + & LVL_D13C =0 ,LVL_D14C =0 ,LVL_BIGD14C =0 , & + & LVL_POC13 =0 ,LVL_DOC13 =0 ,LVL_CALC13 =0 , & + & LVL_PHYTO13 =0 ,LVL_GRAZER13 =0 , & + & SDM_POWAIC =0 ,SDM_POWAAL =0 ,SDM_POWAPH =0 , & + & SDM_POWAOX =0 ,SDM_POWN2 =0 ,SDM_POWNO3 =0 , & + & SDM_POWASI =0 ,SDM_SSSO12 =0 ,SDM_SSSSIL =0 , & + & SDM_SSSC12 =0 ,SDM_SSSTER =0 , & + & BUR_SSSO12 =0 ,BUR_SSSC12 =0 ,BUR_SSSSIL =0 , & + & BUR_SSSTER =0 , & + & GLB_AVEPERIO =0 ,GLB_FILEFREQ =0 ,GLB_COMPFLAG =0 , & + & GLB_NCFORMAT =0 ,GLB_INVENTORY =0 + CHARACTER(LEN=10), DIMENSION(nbgcmax), SAVE :: GLB_FNAMETAG + namelist /DIABGC/ & + & SRF_KWCO2 ,SRF_PCO2 ,SRF_DMSFLUX , & + & SRF_KWCO2KHM ,SRF_CO2KHM ,SRF_CO2KH , & + & SRF_PCO2M , & + & SRF_CO2FXD ,SRF_CO2FXU ,SRF_CO213FXD , & + & SRF_CO213FXU ,SRF_CO214FXD ,SRF_CO214FXU , & + & SRF_OXFLUX ,SRF_NIFLUX ,SRF_DMS , & + & SRF_DMSPROD ,SRF_DMS_BAC ,SRF_DMS_UV , & + & SRF_EXPORT ,SRF_EXPOSI ,SRF_EXPOCA , & + & SRF_ATMCO2 ,SRF_ATMO2 ,SRF_ATMN2 , & + & SRF_ATMC13 ,SRF_ATMC14 , & + & SRF_N2OFX ,SRF_CFC11 ,SRF_CFC12 , & + & SRF_SF6 ,SRF_PHOSPH ,SRF_OXYGEN , & + & SRF_IRON ,SRF_ANO3 ,SRF_ALKALI , & + & SRF_SILICA ,SRF_DIC ,SRF_PHYTO , & + & SRF_PH , & + & SRF_NATDIC ,SRF_NATALKALI ,SRF_NATPCO2 , & + & SRF_NATCO2FX ,SRF_NATPH , & + & SRF_ATMBROMO ,SRF_BROMO ,SRF_BROMOFX , & + & INT_BROMOPRO ,INT_BROMOUV , & + & 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 , & + & LYR_PHYTO ,LYR_GRAZER ,LYR_DOC , & + & LYR_PHOSY ,LYR_PHOSPH ,LYR_OXYGEN , & + & LYR_IRON ,LYR_ANO3 ,LYR_ALKALI , & + & LYR_SILICA ,LYR_DIC ,LYR_POC , & + & LYR_CALC ,LYR_OPAL ,LYR_CO3 , & + & LYR_PH ,LYR_OMEGAA ,LYR_OMEGAC , & + & LYR_DIC13 ,LYR_DIC14 ,LYR_DP , & + & LYR_NOS ,LYR_WPHY ,LYR_WNOS , & + & LYR_EPS ,LYR_ASIZE ,LYR_N2O , & + & LYR_PREFO2 ,LYR_O2SAT ,LYR_PREFPO4 , & + & LYR_PREFALK ,LYR_PREFDIC ,LYR_DICSAT , & + & LYR_CFC11 ,LYR_CFC12 ,LYR_SF6 , & + & LYR_NATDIC ,LYR_NATALKALI ,LYR_NATCALC , & + & LYR_NATPH ,LYR_NATOMEGAA ,LYR_NATOMEGAC , & + & LYR_NATCO3 , & + & LYR_BROMO , & + & LYR_D13C ,LYR_D14C ,LYR_BIGD14C , & + & LYR_PHYTO13 ,LYR_GRAZER13 ,LYR_POC13 , & + & LYR_DOC13 ,LYR_CALC13 , & + & LVL_PHYTO ,LVL_GRAZER ,LVL_DOC , & + & LVL_PHOSY ,LVL_PHOSPH ,LVL_OXYGEN , & + & LVL_IRON ,LVL_ANO3 ,LVL_ALKALI , & + & LVL_SILICA ,LVL_DIC ,LVL_POC , & + & LVL_CALC ,LVL_OPAL ,LVL_CO3 , & + & LVL_PH ,LVL_OMEGAA ,LVL_OMEGAC , & + & LVL_DIC13 ,LVL_DIC14 ,LVL_NOS , & + & LVL_WPHY ,LVL_WNOS ,LVL_EPS , & + & LVL_ASIZE ,LVL_N2O ,LVL_PREFO2 , & + & LVL_O2SAT ,LVL_PREFPO4 ,LVL_PREFALK , & + & LVL_PREFDIC ,LVL_DICSAT , & + & LVL_CFC11 ,LVL_CFC12 ,LVL_SF6 , & + & LVL_NATDIC ,LVL_NATALKALI ,LVL_NATCALC , & + & LVL_NATPH ,LVL_NATOMEGAA ,LVL_NATOMEGAC , & + & LVL_NATCO3 , & + & LVL_BROMO , & + & LVL_D13C ,LVL_D14C ,LVL_BIGD14C , & + & LVL_PHYTO13 ,LVL_GRAZER13 ,LVL_POC13 , & + & LVL_DOC13 ,LVL_CALC13 , & + & 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 , & + & GLB_AVEPERIO ,GLB_FILEFREQ ,GLB_COMPFLAG , & + & GLB_NCFORMAT ,GLB_FNAMETAG ,GLB_INVENTORY + + !---------------------------------------------------------------- + ! declarations for inventory_bgc.F90 + ! order and increments of river (jir...) indices require to be the same + ! as in mo_riverinpt + INTEGER, parameter :: & + & jco2flux =1, & + & jo2flux =2, & + & jn2flux =3, & + & jn2oflux =4, & + & jprorca =5, & + & jprcaca =6, & + & jsilpro =7, & + & jpodiic =8, & + & jpodial =9, & + & jpodiph =10, & + & jpodiox =11, & + & jpodin2 =12, & + & jpodino3 =13, & + & jpodisi =14, & + & jndep =15, & + & joalk =16, & + & jirdin =17, & + & jirdip =18, & + & jirsi =19, & + & jiralk =20, & + & jiriron =21, & + & jirdoc =22, & + & jirdet =23, & + & nbgct2d =23 + + !---------------------------------------------------------------- + INTEGER, SAVE :: i_bsc_m2d + INTEGER, DIMENSION(nbgcmax), SAVE :: & + & jkwco2 = 0 , & + & jkwco2khm = 0 , & + & jco2kh = 0 , & + & jco2khm = 0 , & + & jpco2 = 0 , & + & jpco2m = 0 , & + & jdmsflux = 0 , & + & jco2fxd = 0 , & + & jco2fxu = 0 , & + & jco213fxd = 0 , & + & jco213fxu = 0 , & + & jco214fxd = 0 , & + & jco214fxu = 0 , & + & joxflux = 0 , & + & jniflux = 0 , & + & jn2ofx = 0 , & + & jdms = 0 , & + & jdmsprod = 0 , & + & jdms_bac = 0 , & + & jdms_uv = 0 , & + & jexport = 0 , & + & jexpoca = 0 , & + & jexposi = 0 , & + & jcfc11fx = 0 , & + & jcfc12fx = 0 , & + & jsf6fx = 0 , & + & jsrfphosph = 0 , & + & jsrfoxygen = 0 , & + & jsrfiron = 0 , & + & jsrfano3 = 0 , & + & jsrfalkali = 0 , & + & jsrfsilica = 0 , & + & jsrfdic = 0 , & + & jsrfphyto = 0 , & + & jsrfph = 0 , & + & jintphosy = 0 , & + & jintnfix = 0 , & + & jintdnit = 0 , & + & jndepfx = 0 , & + & joalkfx = 0 , & + & jcarflx0100= 0 , & + & jcarflx0500= 0 , & + & jcarflx1000= 0 , & + & jcarflx2000= 0 , & + & jcarflx4000= 0 , & + & jcarflx_bot= 0 , & + & jbsiflx0100= 0 , & + & jbsiflx0500= 0 , & + & jbsiflx1000= 0 , & + & jbsiflx2000= 0 , & + & jbsiflx4000= 0 , & + & jbsiflx_bot= 0 , & + & jcalflx0100= 0 , & + & jcalflx0500= 0 , & + & jcalflx1000= 0 , & + & jcalflx2000= 0 , & + & jcalflx4000= 0 , & + & jcalflx_bot= 0 + + INTEGER, DIMENSION(nbgcmax), SAVE :: & + & jsediffic = 0 , & + & jsediffal = 0 , & + & jsediffph = 0 , & + & jsediffox = 0 , & + & jsediffn2 = 0 , & + & jsediffno3 = 0 , & + jsediffsi = 0 + + INTEGER, DIMENSION(nbgcmax), SAVE :: & + & jsrfnatdic = 0 , & + & jsrfnatalk = 0 , & + & jnatpco2 = 0 , & + & jnatco2fx = 0 , & + & jsrfnatph = 0 + + INTEGER, DIMENSION(nbgcmax), SAVE :: & + & jbromofx = 0 , & + & jsrfbromo = 0 , & + & jbromo_prod= 0 , & + & jbromo_uv = 0 + + INTEGER, SAVE :: i_atm_m2d + INTEGER, DIMENSION(nbgcmax), SAVE :: & + & jatmco2 = 0 , & + & jatmo2 = 0 , & + & jatmn2 = 0 , & + & jatmc13 = 0 , & + & jatmc14 = 0 , & + & jatmbromo= 0 + + INTEGER, SAVE :: nbgcm2d + + LOGICAL, SAVE :: domassfluxes = .false. + + !---------------------------------------------------------------- + INTEGER, SAVE :: i_bsc_m3d,ilvl_bsc_m3d + INTEGER, DIMENSION(nbgcmax), SAVE :: & + & jdp = 0 , & + & jphyto = 0 , & + & jgrazer = 0 , & + & jdoc = 0 , & + & jphosy = 0 , & + & jphosph = 0 , & + & joxygen = 0 , & + & jiron = 0 , & + & jano3 = 0 , & + & jalkali = 0 , & + & jsilica = 0 , & + & jdic = 0 , & + & jpoc = 0 , & + & jcalc = 0 , & + & jopal = 0 , & + & jco3 = 0 , & + & jph = 0 , & + & jomegaa = 0 , & + & jomegac = 0 , & + & jn2o = 0 , & + & jprefo2 = 0 , & + & jo2sat = 0 , & + & jprefpo4 = 0 , & + & jprefalk = 0 , & + & jprefdic = 0 , & + & jdicsat = 0 , & + & jcfc11 = 0 , & + & jcfc12 = 0 , & + & jsf6 = 0 , & + & jlvlphyto = 0 , & + & jlvlgrazer = 0 , & + & jlvldoc = 0 , & + & jlvlphosy = 0 , & + & jlvlphosph = 0 , & + & jlvloxygen = 0 , & + & jlvliron = 0 , & + & jlvlano3 = 0 , & + & jlvlalkali = 0 , & + & jlvlsilica = 0 , & + & jlvldic = 0 , & + & jlvlpoc = 0 , & + & jlvlcalc = 0 , & + & jlvlopal = 0 , & + & jlvlco3 = 0 , & + & jlvlph = 0 , & + & jlvlomegaa = 0 , & + & jlvlomegac = 0 , & + & jlvln2o = 0 , & + & jlvlprefo2 = 0 , & + & jlvlo2sat = 0 , & + & jlvlprefpo4= 0 , & + & jlvlprefalk= 0 , & + & jlvlprefdic= 0 , & + & jlvldicsat = 0 , & + & jlvlcfc11 = 0 , & + & jlvlcfc12 = 0 , & + & jlvlsf6 = 0 + + INTEGER, DIMENSION(nbgcmax), SAVE :: & + & jdic13 = 0 , & + & jdic14 = 0 , & + & jd13c = 0 , & + & jd14c = 0 , & + & jbigd14c = 0 , & + & jpoc13 = 0 , & + & jdoc13 = 0 , & + & jcalc13 = 0 , & + & jphyto13 = 0 , & + & jgrazer13 = 0 , & + & jlvldic13 = 0 , & + & jlvldic14 = 0 , & + & jlvld13c = 0 , & + & jlvld14c = 0 , & + & jlvlbigd14c= 0 , & + & jlvlpoc13 = 0 , & + & jlvldoc13 = 0 , & + & jlvlcalc13 = 0 , & + & jlvlphyto13 = 0, & + & jlvlgrazer13= 0 + + INTEGER, DIMENSION(nbgcmax), SAVE :: & + & jnos = 0 , & + & jwphy = 0 , & + & jwnos = 0 , & + & jeps = 0 , & + & jasize = 0 , & + & jlvlnos = 0 , & + & jlvlwphy = 0 , & + & jlvlwnos = 0 , & + & jlvleps = 0 , & + & jlvlasize = 0 + + INTEGER, DIMENSION(nbgcmax), SAVE :: & + & jnatco3 = 0 , & + & jnatalkali = 0 , & + & jnatdic = 0 , & + & jnatcalc = 0 , & + & jnatph = 0 , & + & jnatomegaa = 0 , & + & jnatomegac = 0 , & + & jlvlnatco3 = 0 , & + & jlvlnatalkali = 0 , & + & jlvlnatdic = 0 , & + & jlvlnatcalc = 0 , & + & jlvlnatph = 0 , & + & jlvlnatomegaa = 0 , & + & jlvlnatomegac = 0 + + INTEGER, DIMENSION(nbgcmax), SAVE :: & + & jbromo = 0 , & + & jlvlbromo = 0 + + INTEGER, SAVE :: nbgcm3d,nbgcm3dlvl + + !---------------------------------------------------------------- + ! sediment + INTEGER, SAVE :: i_bsc_sed + INTEGER, DIMENSION(nbgcmax), SAVE :: & + & jpowaic = 0 , & + & jpowaal = 0 , & + & jpowaph = 0 , & + & jpowaox = 0 , & + & jpown2 = 0 , & + & jpowno3 = 0 , & + & jpowasi = 0 , & + & jssso12 = 0 , & + & jssssil = 0 , & + & jsssc12 = 0 , & + & jssster = 0 + + + INTEGER, SAVE :: nbgct_sed + + !---------------------------------------------------------------- + ! burial + INTEGER, SAVE :: i_bsc_bur + INTEGER, DIMENSION(nbgcmax), SAVE :: & + & jburssso12 = 0 , & + & jbursssc12 = 0 , & + & jburssssil = 0 , & + & jburssster = 0 + + + INTEGER, SAVE :: nbgct_bur + + !---------------------------------------------------------------- + + REAL, DIMENSION (:,:,:), ALLOCATABLE :: bgct2d + REAL, DIMENSION (:,:,:), ALLOCATABLE :: bgcm2d + REAL, DIMENSION (:,:,:,:), ALLOCATABLE :: bgcm3d,bgcm3dlvl + REAL, DIMENSION (:,:,:,:), ALLOCATABLE :: bgct_sed + REAL, DIMENSION (:,:,:), ALLOCATABLE :: bgct_bur + + +CONTAINS + + + SUBROUTINE ALLOC_MEM_BGCMEAN(kpie,kpje,kpke) + + use mo_control_bgc, only: io_stdo_bgc,bgc_namelist,get_bgc_namelist + + IMPLICIT NONE + + INTEGER, intent(in) :: kpie,kpje,kpke + + INTEGER :: m,n,errstat,iounit,checkdp(nbgcmax) + + ! Read namelist for diagnostic output + GLB_AVEPERIO=0 + if(.not. allocated(bgc_namelist)) call get_bgc_namelist + OPEN (newunit=iounit, file=bgc_namelist, & + status='old', action='read', recl=80) + READ (iounit,nml=diabgc) + CLOSE (iounit) + + ! Determine number of output groups + nbgc=0 + DO n=1,nbgcmax + IF (GLB_AVEPERIO(n).NE.0) THEN + nbgc=nbgc+1 + nacc_bgc(n)=0 + ENDIF + ENDDO -! Re-define index variables according to namelist - i_bsc_m2d=0 - DO n=1,nbgc - IF (SRF_KWCO2(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jkwco2(n)=i_bsc_m2d*min(1,SRF_KWCO2(n)) - IF (SRF_KWCO2KHM(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jkwco2khm(n)=i_bsc_m2d*min(1,SRF_KWCO2KHM(n)) - IF (SRF_CO2KH(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jco2kh(n)=i_bsc_m2d*min(1,SRF_CO2KH(n)) - IF (SRF_CO2KHM(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jco2khm(n)=i_bsc_m2d*min(1,SRF_CO2KHM(n)) - IF (SRF_PCO2(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jpco2(n)=i_bsc_m2d*min(1,SRF_PCO2(n)) - IF (SRF_PCO2M(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jpco2m(n)=i_bsc_m2d*min(1,SRF_PCO2M(n)) - IF (SRF_DMSFLUX(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jdmsflux(n)=i_bsc_m2d*min(1,SRF_DMSFLUX(n)) - IF (SRF_CO2FXD(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jco2fxd(n)=i_bsc_m2d*min(1,SRF_CO2FXD(n)) - IF (SRF_CO2FXU(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jco2fxu(n)=i_bsc_m2d*min(1,SRF_CO2FXU(n)) - IF (SRF_OXFLUX(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - joxflux(n)=i_bsc_m2d*min(1,SRF_OXFLUX(n)) - IF (SRF_NIFLUX(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jniflux(n)=i_bsc_m2d*min(1,SRF_NIFLUX(n)) - IF (SRF_DMS(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jdms(n)=i_bsc_m2d*min(1,SRF_DMS(n)) - IF (SRF_DMSPROD(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jdmsprod(n)=i_bsc_m2d*min(1,SRF_DMSPROD(n)) - IF (SRF_DMS_BAC(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jdms_bac(n)=i_bsc_m2d*min(1,SRF_DMS_BAC(n)) - IF (SRF_DMS_UV(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jdms_uv(n)=i_bsc_m2d*min(1,SRF_DMS_UV(n)) - IF (SRF_EXPORT(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jexport(n)=i_bsc_m2d*min(1,SRF_EXPORT(n)) - IF (SRF_EXPOCA(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jexpoca(n)=i_bsc_m2d*min(1,SRF_EXPOCA(n)) - IF (SRF_EXPOSI(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jexposi(n)=i_bsc_m2d*min(1,SRF_EXPOSI(n)) - IF (SRF_N2OFX(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jn2ofx(n)=i_bsc_m2d*min(1,SRF_N2OFX(n)) - IF (SRF_PHOSPH(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jsrfphosph(n)=i_bsc_m2d*min(1,SRF_PHOSPH(n)) - IF (SRF_OXYGEN(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jsrfoxygen(n)=i_bsc_m2d*min(1,SRF_OXYGEN(n)) - IF (SRF_IRON(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jsrfiron(n)=i_bsc_m2d*min(1,SRF_IRON(n)) - IF (SRF_ANO3(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jsrfano3(n)=i_bsc_m2d*min(1,SRF_ANO3(n)) - IF (SRF_ALKALI(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jsrfalkali(n)=i_bsc_m2d*min(1,SRF_ALKALI(n)) - IF (SRF_SILICA(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jsrfsilica(n)=i_bsc_m2d*min(1,SRF_SILICA(n)) - IF (SRF_DIC(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jsrfdic(n)=i_bsc_m2d*min(1,SRF_DIC(n)) - IF (SRF_PHYTO(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jsrfphyto(n)=i_bsc_m2d*min(1,SRF_PHYTO(n)) - IF (SRF_PH(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jsrfph(n)=i_bsc_m2d*min(1,SRF_PH(n)) - IF (INT_PHOSY(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jintphosy(n)=i_bsc_m2d*min(1,INT_PHOSY(n)) - IF (INT_NFIX(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jintnfix(n)=i_bsc_m2d*min(1,INT_NFIX(n)) - IF (INT_DNIT(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jintdnit(n)=i_bsc_m2d*min(1,INT_DNIT(n)) - IF (FLX_NDEP(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jndepfx(n)=i_bsc_m2d*min(1,FLX_NDEP(n)) - IF (FLX_OALK(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - joalkfx(n)=i_bsc_m2d*min(1,FLX_OALK(n)) - IF (FLX_CAR0100(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jcarflx0100(n)=i_bsc_m2d*min(1,FLX_CAR0100(n)) - IF (FLX_CAR0500(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jcarflx0500(n)=i_bsc_m2d*min(1,FLX_CAR0500(n)) - IF (FLX_CAR1000(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jcarflx1000(n)=i_bsc_m2d*min(1,FLX_CAR1000(n)) - IF (FLX_CAR2000(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jcarflx2000(n)=i_bsc_m2d*min(1,FLX_CAR2000(n)) - IF (FLX_CAR4000(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jcarflx4000(n)=i_bsc_m2d*min(1,FLX_CAR4000(n)) - IF (FLX_CAR_BOT(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jcarflx_bot(n)=i_bsc_m2d*min(1,FLX_CAR_BOT(n)) - IF (FLX_BSI0100(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jbsiflx0100(n)=i_bsc_m2d*min(1,FLX_BSI0100(n)) - IF (FLX_BSI0500(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jbsiflx0500(n)=i_bsc_m2d*min(1,FLX_BSI0500(n)) - IF (FLX_BSI1000(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jbsiflx1000(n)=i_bsc_m2d*min(1,FLX_BSI1000(n)) - IF (FLX_BSI2000(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jbsiflx2000(n)=i_bsc_m2d*min(1,FLX_BSI2000(n)) - IF (FLX_BSI4000(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jbsiflx4000(n)=i_bsc_m2d*min(1,FLX_BSI4000(n)) - IF (FLX_BSI_BOT(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jbsiflx_bot(n)=i_bsc_m2d*min(1,FLX_BSI_BOT(n)) - IF (FLX_CAL0100(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jcalflx0100(n)=i_bsc_m2d*min(1,FLX_CAL0100(n)) - IF (FLX_CAL0500(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jcalflx0500(n)=i_bsc_m2d*min(1,FLX_CAL0500(n)) - IF (FLX_CAL1000(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jcalflx1000(n)=i_bsc_m2d*min(1,FLX_CAL1000(n)) - IF (FLX_CAL2000(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - jcalflx2000(n)=i_bsc_m2d*min(1,FLX_CAL2000(n)) - IF (FLX_CAL4000(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 - 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)) - 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)) - endif - 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)) - endif - 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)) - endif - 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)) - endif - 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)) - endif - ENDDO - - domassfluxes = any( & - jcarflx0100+jcarflx0500+jcarflx1000+ & - jcarflx2000+jcarflx4000+jcarflx_bot+ & - jbsiflx0100+jbsiflx0500+jbsiflx1000+ & - jbsiflx2000+jbsiflx4000+jbsiflx_bot+ & - jcalflx0100+jcalflx0500+jcalflx1000+ & - jcalflx2000+jcalflx4000+jcalflx_bot > 0) - - i_atm_m2d=i_bsc_m2d - 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 (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)) - endif - 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)) - endif - 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)) - endif - ENDDO - i_atm_m2d=i_atm_m2d-i_bsc_m2d - - i_bsc_m3d=0 - ilvl_bsc_m3d=0 - DO n=1,nbgc - checkdp(n)=0 - - IF (LYR_PHYTO(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jphyto(n)=i_bsc_m3d*min(1,LYR_PHYTO(n)) - IF (LYR_GRAZER(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jgrazer(n)=i_bsc_m3d*min(1,LYR_GRAZER(n)) - IF (LYR_DOC(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jdoc(n)=i_bsc_m3d*min(1,LYR_DOC(n)) - IF (LYR_PHOSY(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jphosy(n)=i_bsc_m3d*min(1,LYR_PHOSY(n)) - IF (LYR_PHOSPH(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jphosph(n)=i_bsc_m3d*min(1,LYR_PHOSPH(n)) - IF (LYR_OXYGEN(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - joxygen(n)=i_bsc_m3d*min(1,LYR_OXYGEN(n)) - IF (LYR_IRON(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jiron(n)=i_bsc_m3d*min(1,LYR_IRON(n)) - IF (LYR_ANO3(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jano3(n)=i_bsc_m3d*min(1,LYR_ANO3(n)) - IF (LYR_ALKALI(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jalkali(n)=i_bsc_m3d*min(1,LYR_ALKALI(n)) - IF (LYR_SILICA(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jsilica(n)=i_bsc_m3d*min(1,LYR_SILICA(n)) - IF (LYR_DIC(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jdic(n)=i_bsc_m3d*min(1,LYR_DIC(n)) - IF (LYR_POC(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jpoc(n)=i_bsc_m3d*min(1,LYR_POC(n)) - IF (LYR_CALC(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jcalc(n)=i_bsc_m3d*min(1,LYR_CALC(n)) - IF (LYR_OPAL(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jopal(n)=i_bsc_m3d*min(1,LYR_OPAL(n)) - IF (LYR_CO3(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jco3(n)=i_bsc_m3d*min(1,LYR_CO3(n)) - IF (LYR_PH(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jph(n)=i_bsc_m3d*min(1,LYR_PH(n)) - IF (LYR_OMEGAA(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jomegaa(n)=i_bsc_m3d*min(1,LYR_OMEGAA(n)) - IF (LYR_OMEGAC(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jomegac(n)=i_bsc_m3d*min(1,LYR_OMEGAC(n)) - IF (LYR_N2O(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jn2o(n)=i_bsc_m3d*min(1,LYR_N2O(n)) - IF (LYR_PREFO2(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jprefo2(n)=i_bsc_m3d*min(1,LYR_PREFO2(n)) - IF (LYR_O2SAT(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jo2sat(n)=i_bsc_m3d*min(1,LYR_O2SAT(n)) - IF (LYR_PREFPO4(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jprefpo4(n)=i_bsc_m3d*min(1,LYR_PREFPO4(n)) - IF (LYR_PREFALK(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jprefalk(n)=i_bsc_m3d*min(1,LYR_PREFALK(n)) - IF (LYR_PREFDIC(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - jprefdic(n)=i_bsc_m3d*min(1,LYR_PREFDIC(n)) - IF (LYR_DICSAT(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 - 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)) - 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)) - endif - 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)) - endif - 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)) - endif - 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)) - endif - 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)) - endif - - IF (LVL_PHYTO(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlphyto(n)=ilvl_bsc_m3d*min(1,LVL_PHYTO(n)) - IF (LVL_GRAZER(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlgrazer(n)=ilvl_bsc_m3d*min(1,LVL_GRAZER(n)) - IF (LVL_DOC(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvldoc(n)=ilvl_bsc_m3d*min(1,LVL_DOC(n)) - IF (LVL_PHOSY(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlphosy(n)=ilvl_bsc_m3d*min(1,LVL_PHOSY(n)) - IF (LVL_PHOSPH(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlphosph(n)=ilvl_bsc_m3d*min(1,LVL_PHOSPH(n)) - IF (LVL_OXYGEN(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvloxygen(n)=ilvl_bsc_m3d*min(1,LVL_OXYGEN(n)) - IF (LVL_IRON(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvliron(n)=ilvl_bsc_m3d*min(1,LVL_IRON(n)) - IF (LVL_ANO3(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlano3(n)=ilvl_bsc_m3d*min(1,LVL_ANO3(n)) - IF (LVL_ALKALI(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlalkali(n)=ilvl_bsc_m3d*min(1,LVL_ALKALI(n)) - IF (LVL_SILICA(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlsilica(n)=ilvl_bsc_m3d*min(1,LVL_SILICA(n)) - IF (LVL_DIC(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvldic(n)=ilvl_bsc_m3d*min(1,LVL_DIC(n)) - IF (LVL_POC(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlpoc(n)=ilvl_bsc_m3d*min(1,LVL_POC(n)) - IF (LVL_CALC(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlcalc(n)=ilvl_bsc_m3d*min(1,LVL_CALC(n)) - IF (LVL_OPAL(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlopal(n)=ilvl_bsc_m3d*min(1,LVL_OPAL(n)) - IF (LVL_CO3(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlco3(n)=ilvl_bsc_m3d*min(1,LVL_CO3(n)) - IF (LVL_PH(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlph(n)=ilvl_bsc_m3d*min(1,LVL_PH(n)) - IF (LVL_OMEGAA(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlomegaa(n)=ilvl_bsc_m3d*min(1,LVL_OMEGAA(n)) - IF (LVL_OMEGAC(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlomegac(n)=ilvl_bsc_m3d*min(1,LVL_OMEGAC(n)) - IF (LVL_N2O(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvln2o(n)=ilvl_bsc_m3d*min(1,LVL_N2O(n)) - IF (LVL_PREFO2(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlprefo2(n)=ilvl_bsc_m3d*min(1,LVL_PREFO2(n)) - IF (LVL_O2SAT(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlo2sat(n)=ilvl_bsc_m3d*min(1,LVL_O2SAT(n)) - IF (LVL_PREFPO4(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlprefpo4(n)=ilvl_bsc_m3d*min(1,LVL_PREFPO4(n)) - IF (LVL_PREFALK(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - jlvlprefalk(n)=ilvl_bsc_m3d*min(1,LVL_PREFALK(n)) - IF (LVL_PREFDIC(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 - 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)) - 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)) - endif - 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)) - endif - 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)) - endif - 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)) - endif - 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)) - endif - - IF (i_bsc_m3d.NE.0) checkdp(n)=1 - ENDDO - - -! add dp required - DO n=1,nbgc - IF (checkdp(n).NE.0.AND.LYR_DP(n).EQ.0) THEN - i_bsc_m3d=i_bsc_m3d+1 - jdp(n)=i_bsc_m3d - ENDIF - ENDDO - - i_bsc_sed=0 - i_bsc_bur=0 + DO n=1,nbgc + GLB_FILEFREQ(n)=max(GLB_AVEPERIO(n),GLB_FILEFREQ(n)) + IF (GLB_AVEPERIO(n).LT.0) THEN + diagfq_bgc(n)=-real(nstepinday)/GLB_AVEPERIO(n) + ELSE + diagfq_bgc(n)=nstepinday*max(1,GLB_AVEPERIO(n)) + ENDIF + diagmon_bgc(n)=.false. + diagann_bgc(n)=.false. + IF (GLB_AVEPERIO(n).EQ.30) THEN + diagmon_bgc(n)=.true. + ELSEIF (GLB_AVEPERIO(n).EQ.365) THEN + diagann_bgc(n)=.true. + ENDIF + IF (GLB_FILEFREQ(n).LT.0) THEN + filefq_bgc(n)=-real(nstepinday)/GLB_FILEFREQ(n) + ELSE + filefq_bgc(n)=nstepinday*max(1,GLB_FILEFREQ(n)) + ENDIF + filemon_bgc(n)=.false. + fileann_bgc(n)=.false. + IF (GLB_FILEFREQ(n).EQ.30) THEN + filemon_bgc(n)=.true. + ELSEIF (GLB_FILEFREQ(n).EQ.365) THEN + fileann_bgc(n)=.true. + ENDIF + ENDDO + + ! Re-define index variables according to namelist + i_bsc_m2d=0 + DO n=1,nbgc + IF (SRF_KWCO2(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jkwco2(n)=i_bsc_m2d*min(1,SRF_KWCO2(n)) + IF (SRF_KWCO2KHM(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jkwco2khm(n)=i_bsc_m2d*min(1,SRF_KWCO2KHM(n)) + IF (SRF_CO2KH(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jco2kh(n)=i_bsc_m2d*min(1,SRF_CO2KH(n)) + IF (SRF_CO2KHM(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jco2khm(n)=i_bsc_m2d*min(1,SRF_CO2KHM(n)) + IF (SRF_PCO2(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jpco2(n)=i_bsc_m2d*min(1,SRF_PCO2(n)) + IF (SRF_PCO2M(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jpco2m(n)=i_bsc_m2d*min(1,SRF_PCO2M(n)) + IF (SRF_DMSFLUX(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jdmsflux(n)=i_bsc_m2d*min(1,SRF_DMSFLUX(n)) + IF (SRF_CO2FXD(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jco2fxd(n)=i_bsc_m2d*min(1,SRF_CO2FXD(n)) + IF (SRF_CO2FXU(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jco2fxu(n)=i_bsc_m2d*min(1,SRF_CO2FXU(n)) + IF (SRF_OXFLUX(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + joxflux(n)=i_bsc_m2d*min(1,SRF_OXFLUX(n)) + IF (SRF_NIFLUX(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jniflux(n)=i_bsc_m2d*min(1,SRF_NIFLUX(n)) + IF (SRF_DMS(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jdms(n)=i_bsc_m2d*min(1,SRF_DMS(n)) + IF (SRF_DMSPROD(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jdmsprod(n)=i_bsc_m2d*min(1,SRF_DMSPROD(n)) + IF (SRF_DMS_BAC(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jdms_bac(n)=i_bsc_m2d*min(1,SRF_DMS_BAC(n)) + IF (SRF_DMS_UV(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jdms_uv(n)=i_bsc_m2d*min(1,SRF_DMS_UV(n)) + IF (SRF_EXPORT(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jexport(n)=i_bsc_m2d*min(1,SRF_EXPORT(n)) + IF (SRF_EXPOCA(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jexpoca(n)=i_bsc_m2d*min(1,SRF_EXPOCA(n)) + IF (SRF_EXPOSI(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jexposi(n)=i_bsc_m2d*min(1,SRF_EXPOSI(n)) + IF (SRF_N2OFX(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jn2ofx(n)=i_bsc_m2d*min(1,SRF_N2OFX(n)) + IF (SRF_PHOSPH(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jsrfphosph(n)=i_bsc_m2d*min(1,SRF_PHOSPH(n)) + IF (SRF_OXYGEN(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jsrfoxygen(n)=i_bsc_m2d*min(1,SRF_OXYGEN(n)) + IF (SRF_IRON(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jsrfiron(n)=i_bsc_m2d*min(1,SRF_IRON(n)) + IF (SRF_ANO3(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jsrfano3(n)=i_bsc_m2d*min(1,SRF_ANO3(n)) + IF (SRF_ALKALI(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jsrfalkali(n)=i_bsc_m2d*min(1,SRF_ALKALI(n)) + IF (SRF_SILICA(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jsrfsilica(n)=i_bsc_m2d*min(1,SRF_SILICA(n)) + IF (SRF_DIC(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jsrfdic(n)=i_bsc_m2d*min(1,SRF_DIC(n)) + IF (SRF_PHYTO(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jsrfphyto(n)=i_bsc_m2d*min(1,SRF_PHYTO(n)) + IF (SRF_PH(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jsrfph(n)=i_bsc_m2d*min(1,SRF_PH(n)) + IF (INT_PHOSY(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jintphosy(n)=i_bsc_m2d*min(1,INT_PHOSY(n)) + IF (INT_NFIX(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jintnfix(n)=i_bsc_m2d*min(1,INT_NFIX(n)) + IF (INT_DNIT(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jintdnit(n)=i_bsc_m2d*min(1,INT_DNIT(n)) + IF (FLX_NDEP(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jndepfx(n)=i_bsc_m2d*min(1,FLX_NDEP(n)) + IF (FLX_OALK(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + joalkfx(n)=i_bsc_m2d*min(1,FLX_OALK(n)) + IF (FLX_CAR0100(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jcarflx0100(n)=i_bsc_m2d*min(1,FLX_CAR0100(n)) + IF (FLX_CAR0500(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jcarflx0500(n)=i_bsc_m2d*min(1,FLX_CAR0500(n)) + IF (FLX_CAR1000(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jcarflx1000(n)=i_bsc_m2d*min(1,FLX_CAR1000(n)) + IF (FLX_CAR2000(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jcarflx2000(n)=i_bsc_m2d*min(1,FLX_CAR2000(n)) + IF (FLX_CAR4000(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jcarflx4000(n)=i_bsc_m2d*min(1,FLX_CAR4000(n)) + IF (FLX_CAR_BOT(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jcarflx_bot(n)=i_bsc_m2d*min(1,FLX_CAR_BOT(n)) + IF (FLX_BSI0100(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jbsiflx0100(n)=i_bsc_m2d*min(1,FLX_BSI0100(n)) + IF (FLX_BSI0500(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jbsiflx0500(n)=i_bsc_m2d*min(1,FLX_BSI0500(n)) + IF (FLX_BSI1000(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jbsiflx1000(n)=i_bsc_m2d*min(1,FLX_BSI1000(n)) + IF (FLX_BSI2000(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jbsiflx2000(n)=i_bsc_m2d*min(1,FLX_BSI2000(n)) + IF (FLX_BSI4000(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jbsiflx4000(n)=i_bsc_m2d*min(1,FLX_BSI4000(n)) + IF (FLX_BSI_BOT(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jbsiflx_bot(n)=i_bsc_m2d*min(1,FLX_BSI_BOT(n)) + IF (FLX_CAL0100(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jcalflx0100(n)=i_bsc_m2d*min(1,FLX_CAL0100(n)) + IF (FLX_CAL0500(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jcalflx0500(n)=i_bsc_m2d*min(1,FLX_CAL0500(n)) + IF (FLX_CAL1000(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jcalflx1000(n)=i_bsc_m2d*min(1,FLX_CAL1000(n)) + IF (FLX_CAL2000(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + jcalflx2000(n)=i_bsc_m2d*min(1,FLX_CAL2000(n)) + IF (FLX_CAL4000(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 + 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)) 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 + 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 + 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)) + endif + 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)) + endif + 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)) + endif + 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)) + endif + ENDDO + + domassfluxes = any( & + jcarflx0100+jcarflx0500+jcarflx1000+ & + jcarflx2000+jcarflx4000+jcarflx_bot+ & + jbsiflx0100+jbsiflx0500+jbsiflx1000+ & + jbsiflx2000+jbsiflx4000+jbsiflx_bot+ & + jcalflx0100+jcalflx0500+jcalflx1000+ & + jcalflx2000+jcalflx4000+jcalflx_bot > 0) + + i_atm_m2d=i_bsc_m2d + 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 (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)) + endif + 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)) + endif + 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)) + endif + ENDDO + i_atm_m2d=i_atm_m2d-i_bsc_m2d + + i_bsc_m3d=0 + ilvl_bsc_m3d=0 + DO n=1,nbgc + checkdp(n)=0 + + IF (LYR_PHYTO(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jphyto(n)=i_bsc_m3d*min(1,LYR_PHYTO(n)) + IF (LYR_GRAZER(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jgrazer(n)=i_bsc_m3d*min(1,LYR_GRAZER(n)) + IF (LYR_DOC(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jdoc(n)=i_bsc_m3d*min(1,LYR_DOC(n)) + IF (LYR_PHOSY(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jphosy(n)=i_bsc_m3d*min(1,LYR_PHOSY(n)) + IF (LYR_PHOSPH(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jphosph(n)=i_bsc_m3d*min(1,LYR_PHOSPH(n)) + IF (LYR_OXYGEN(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + joxygen(n)=i_bsc_m3d*min(1,LYR_OXYGEN(n)) + IF (LYR_IRON(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jiron(n)=i_bsc_m3d*min(1,LYR_IRON(n)) + IF (LYR_ANO3(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jano3(n)=i_bsc_m3d*min(1,LYR_ANO3(n)) + IF (LYR_ALKALI(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jalkali(n)=i_bsc_m3d*min(1,LYR_ALKALI(n)) + IF (LYR_SILICA(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jsilica(n)=i_bsc_m3d*min(1,LYR_SILICA(n)) + IF (LYR_DIC(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jdic(n)=i_bsc_m3d*min(1,LYR_DIC(n)) + IF (LYR_POC(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jpoc(n)=i_bsc_m3d*min(1,LYR_POC(n)) + IF (LYR_CALC(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jcalc(n)=i_bsc_m3d*min(1,LYR_CALC(n)) + IF (LYR_OPAL(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jopal(n)=i_bsc_m3d*min(1,LYR_OPAL(n)) + IF (LYR_CO3(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jco3(n)=i_bsc_m3d*min(1,LYR_CO3(n)) + IF (LYR_PH(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jph(n)=i_bsc_m3d*min(1,LYR_PH(n)) + IF (LYR_OMEGAA(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jomegaa(n)=i_bsc_m3d*min(1,LYR_OMEGAA(n)) + IF (LYR_OMEGAC(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jomegac(n)=i_bsc_m3d*min(1,LYR_OMEGAC(n)) + IF (LYR_N2O(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jn2o(n)=i_bsc_m3d*min(1,LYR_N2O(n)) + IF (LYR_PREFO2(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jprefo2(n)=i_bsc_m3d*min(1,LYR_PREFO2(n)) + IF (LYR_O2SAT(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jo2sat(n)=i_bsc_m3d*min(1,LYR_O2SAT(n)) + IF (LYR_PREFPO4(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jprefpo4(n)=i_bsc_m3d*min(1,LYR_PREFPO4(n)) + IF (LYR_PREFALK(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jprefalk(n)=i_bsc_m3d*min(1,LYR_PREFALK(n)) + IF (LYR_PREFDIC(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + jprefdic(n)=i_bsc_m3d*min(1,LYR_PREFDIC(n)) + IF (LYR_DICSAT(n).GT.0) i_bsc_m3d=i_bsc_m3d+1 + 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)) + 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)) + endif + 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)) + endif + 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)) + endif + 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)) + endif + 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)) endif - - nbgcm2d = i_bsc_m2d+i_atm_m2d - nbgcm3d = i_bsc_m3d - nbgcm3dlvl = ilvl_bsc_m3d - nbgct_sed = i_bsc_sed - nbgct_bur = i_bsc_bur - -! Allocate buffers - - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'***************************************************' - WRITE(io_stdo_bgc,*)'Memory allocation for averaging model output :' - WRITE(io_stdo_bgc,*)' ' - ENDIF + IF (LVL_PHYTO(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlphyto(n)=ilvl_bsc_m3d*min(1,LVL_PHYTO(n)) + IF (LVL_GRAZER(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlgrazer(n)=ilvl_bsc_m3d*min(1,LVL_GRAZER(n)) + IF (LVL_DOC(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvldoc(n)=ilvl_bsc_m3d*min(1,LVL_DOC(n)) + IF (LVL_PHOSY(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlphosy(n)=ilvl_bsc_m3d*min(1,LVL_PHOSY(n)) + IF (LVL_PHOSPH(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlphosph(n)=ilvl_bsc_m3d*min(1,LVL_PHOSPH(n)) + IF (LVL_OXYGEN(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvloxygen(n)=ilvl_bsc_m3d*min(1,LVL_OXYGEN(n)) + IF (LVL_IRON(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvliron(n)=ilvl_bsc_m3d*min(1,LVL_IRON(n)) + IF (LVL_ANO3(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlano3(n)=ilvl_bsc_m3d*min(1,LVL_ANO3(n)) + IF (LVL_ALKALI(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlalkali(n)=ilvl_bsc_m3d*min(1,LVL_ALKALI(n)) + IF (LVL_SILICA(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlsilica(n)=ilvl_bsc_m3d*min(1,LVL_SILICA(n)) + IF (LVL_DIC(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvldic(n)=ilvl_bsc_m3d*min(1,LVL_DIC(n)) + IF (LVL_POC(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlpoc(n)=ilvl_bsc_m3d*min(1,LVL_POC(n)) + IF (LVL_CALC(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlcalc(n)=ilvl_bsc_m3d*min(1,LVL_CALC(n)) + IF (LVL_OPAL(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlopal(n)=ilvl_bsc_m3d*min(1,LVL_OPAL(n)) + IF (LVL_CO3(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlco3(n)=ilvl_bsc_m3d*min(1,LVL_CO3(n)) + IF (LVL_PH(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlph(n)=ilvl_bsc_m3d*min(1,LVL_PH(n)) + IF (LVL_OMEGAA(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlomegaa(n)=ilvl_bsc_m3d*min(1,LVL_OMEGAA(n)) + IF (LVL_OMEGAC(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlomegac(n)=ilvl_bsc_m3d*min(1,LVL_OMEGAC(n)) + IF (LVL_N2O(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvln2o(n)=ilvl_bsc_m3d*min(1,LVL_N2O(n)) + IF (LVL_PREFO2(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlprefo2(n)=ilvl_bsc_m3d*min(1,LVL_PREFO2(n)) + IF (LVL_O2SAT(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlo2sat(n)=ilvl_bsc_m3d*min(1,LVL_O2SAT(n)) + IF (LVL_PREFPO4(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlprefpo4(n)=ilvl_bsc_m3d*min(1,LVL_PREFPO4(n)) + IF (LVL_PREFALK(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + jlvlprefalk(n)=ilvl_bsc_m3d*min(1,LVL_PREFALK(n)) + IF (LVL_PREFDIC(n).GT.0) ilvl_bsc_m3d=ilvl_bsc_m3d+1 + 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)) + 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)) + endif + 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)) + endif + 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)) + endif + 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)) + endif + 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)) + endif - IF (mnproc.EQ.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable bgct2d ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',nbgct2d - ENDIF + IF (i_bsc_m3d.NE.0) checkdp(n)=1 + ENDDO - ALLOCATE (bgct2d(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy,nbgct2d), & - & stat=errstat) - IF (errstat.NE.0) STOP 'not enough memory bgct2d' - IF (nbgct2d.NE.0) bgct2d=0. - - IF (mnproc.EQ.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable bgcm2d ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',nbgcm2d + + ! add dp required + DO n=1,nbgc + IF (checkdp(n).NE.0.AND.LYR_DP(n).EQ.0) THEN + i_bsc_m3d=i_bsc_m3d+1 + jdp(n)=i_bsc_m3d ENDIF + ENDDO - ALLOCATE (bgcm2d(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy,nbgcm2d), & - & stat=errstat) - IF (errstat.NE.0) STOP 'not enough memory bgcm2d' - IF (nbgcm2d.NE.0) bgcm2d=0. + i_bsc_sed=0 + i_bsc_bur=0 + 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 + endif + + nbgcm2d = i_bsc_m2d+i_atm_m2d + nbgcm3d = i_bsc_m3d + nbgcm3dlvl = ilvl_bsc_m3d + nbgct_sed = i_bsc_sed + nbgct_bur = i_bsc_bur + + ! Allocate buffers + + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)' ' + WRITE(io_stdo_bgc,*)'***************************************************' + WRITE(io_stdo_bgc,*)'Memory allocation for averaging model output :' + WRITE(io_stdo_bgc,*)' ' + ENDIF + + + IF (mnproc.EQ.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable bgct2d ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',nbgct2d + ENDIF + + ALLOCATE (bgct2d(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy,nbgct2d), & + & stat=errstat) + IF (errstat.NE.0) STOP 'not enough memory bgct2d' + IF (nbgct2d.NE.0) bgct2d=0. + + IF (mnproc.EQ.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable bgcm2d ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',nbgcm2d + ENDIF + + ALLOCATE (bgcm2d(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy,nbgcm2d), & + & stat=errstat) + IF (errstat.NE.0) STOP 'not enough memory bgcm2d' + IF (nbgcm2d.NE.0) bgcm2d=0. + + IF (mnproc.EQ.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable bgcm3d ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',kpke + WRITE(io_stdo_bgc,*)'Forth dimension : ',nbgcm3d + ENDIF + + ALLOCATE (bgcm3d(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy,kpke,nbgcm3d), & + & stat=errstat) + IF (errstat.NE.0) STOP 'not enough memory bgcm3d' + IF (nbgcm3d.NE.0) bgcm3d=0. + + IF (mnproc.EQ.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable bgcm3dlvl ' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',kpke + WRITE(io_stdo_bgc,*)'Forth dimension : ',nbgcm3dlvl + ENDIF + + ALLOCATE (bgcm3dlvl(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy,ddm, & + & nbgcm3dlvl),stat=errstat) + IF (errstat.NE.0) STOP 'not enough memory bgcm3dlvl' + IF (nbgcm3dlvl.NE.0) bgcm3dlvl=0. + + if (.not. use_sedbypass) then IF (mnproc.EQ.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable bgcm3d ...' + 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 : ',kpke - WRITE(io_stdo_bgc,*)'Forth dimension : ',nbgcm3d + WRITE(io_stdo_bgc,*)'Third dimension : ',ks + WRITE(io_stdo_bgc,*)'Forth dimension : ',nbgct_sed ENDIF - ALLOCATE (bgcm3d(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy,kpke,nbgcm3d), & - & stat=errstat) - IF (errstat.NE.0) STOP 'not enough memory bgcm3d' - IF (nbgcm3d.NE.0) bgcm3d=0. + 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 bgcm3dlvl ' + 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 : ',kpke - WRITE(io_stdo_bgc,*)'Forth dimension : ',nbgcm3dlvl + WRITE(io_stdo_bgc,*)'Third dimension : ',nbgct_bur ENDIF - ALLOCATE (bgcm3dlvl(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy,ddm, & - & nbgcm3dlvl),stat=errstat) - IF (errstat.NE.0) STOP 'not enough memory bgcm3dlvl' - IF (nbgcm3dlvl.NE.0) bgcm3dlvl=0. - - 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. - endif - - END SUBROUTINE ALLOC_MEM_BGCMEAN - - - - SUBROUTINE inisrf(pos,inival) -! -! --- ------------------------------------------------------------------ -! --- Description: initialise 2d diagnostic field -! --- -! --- Arguments: -! --- int pos (in) : position in common buffer -! --- real inival (in) : value used for initalisation -! --- ------------------------------------------------------------------ -! - IMPLICIT NONE -! - INTEGER :: pos - REAL ::inival -! - INTEGER :: i,j,l -! -! --- Check whether field should be initialised - IF (pos.EQ.0) RETURN -! -!$OMP PARALLEL DO PRIVATE(l,i) + 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 + + END SUBROUTINE ALLOC_MEM_BGCMEAN + + + + SUBROUTINE inisrf(pos,inival) + ! + ! --- ------------------------------------------------------------------ + ! --- Description: initialise 2d diagnostic field + ! --- + ! --- Arguments: + ! --- int pos (in) : position in common buffer + ! --- real inival (in) : value used for initalisation + ! --- ------------------------------------------------------------------ + ! + IMPLICIT NONE + ! + INTEGER :: pos + REAL ::inival + ! + INTEGER :: i,j,l + ! + ! --- Check whether field should be initialised + IF (pos.EQ.0) RETURN + ! + !$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)) + bgcm2d(i,j,pos)=inival + ENDDO + ENDDO + ENDDO + !$OMP END PARALLEL DO + ! + END SUBROUTINE inisrf + + + + SUBROUTINE inilyr(pos,inival) + ! + ! --- ------------------------------------------------------------------ + ! --- Description: initialise layer diagnostic field + ! --- + ! --- Arguments: + ! --- int pos (in) : position in common buffer + ! --- real inival (in) : value used for initalisation + ! --- ------------------------------------------------------------------ + ! + IMPLICIT NONE + ! + INTEGER :: pos + REAL ::inival + ! + INTEGER :: i,j,k,l + ! + ! --- Check whether field should be initialised + IF (pos.EQ.0) RETURN + ! + DO k=1,kdm + !$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)) - bgcm2d(i,j,pos)=inival + bgcm3d(i,j,k,pos)=inival ENDDO ENDDO ENDDO -!$OMP END PARALLEL DO -! - END SUBROUTINE inisrf - - - - SUBROUTINE inilyr(pos,inival) -! -! --- ------------------------------------------------------------------ -! --- Description: initialise layer diagnostic field -! --- -! --- Arguments: -! --- int pos (in) : position in common buffer -! --- real inival (in) : value used for initalisation -! --- ------------------------------------------------------------------ -! - IMPLICIT NONE -! - INTEGER :: pos - REAL ::inival -! - INTEGER :: i,j,k,l -! -! --- Check whether field should be initialised - IF (pos.EQ.0) RETURN -! - DO k=1,kdm -!$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)) - bgcm3d(i,j,k,pos)=inival - ENDDO + !$OMP END PARALLEL DO + ENDDO + ! + END SUBROUTINE inilyr + + + + SUBROUTINE inilvl(pos,inival) + ! + ! --- ------------------------------------------------------------------ + ! --- Description: initialise level diagnostic field + ! --- + ! --- Arguments: + ! --- int pos (in) : position in common buffer + ! --- real inival (in) : value used for initalisation + ! --- ------------------------------------------------------------------ + ! + IMPLICIT NONE + ! + INTEGER :: pos + REAL ::inival + ! + INTEGER :: i,j,k,l + ! + ! --- Check whether field should be initialised + IF (pos.EQ.0) RETURN + ! + DO k=1,ddm + !$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)) + bgcm3dlvl(i,j,k,pos)=inival ENDDO ENDDO -!$OMP END PARALLEL DO ENDDO -! - END SUBROUTINE inilyr - - - - SUBROUTINE inilvl(pos,inival) -! -! --- ------------------------------------------------------------------ -! --- Description: initialise level diagnostic field -! --- -! --- Arguments: -! --- int pos (in) : position in common buffer -! --- real inival (in) : value used for initalisation -! --- ------------------------------------------------------------------ -! - IMPLICIT NONE -! - INTEGER :: pos - REAL ::inival -! - INTEGER :: i,j,k,l -! -! --- Check whether field should be initialised - IF (pos.EQ.0) RETURN -! - DO k=1,ddm -!$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)) - bgcm3dlvl(i,j,k,pos)=inival - ENDDO + !$OMP END PARALLEL DO + ENDDO + ! + END SUBROUTINE inilvl + + + + SUBROUTINE inisdm(pos,inival) + ! + ! --- ------------------------------------------------------------------ + ! --- Description: initialise sediment diagnostic field + ! --- + ! --- Arguments: + ! --- int pos (in) : position in common buffer + ! --- real inival (in) : value used for initalisation + ! --- ------------------------------------------------------------------ + ! + IMPLICIT NONE + ! + INTEGER :: pos + REAL ::inival + ! + INTEGER :: i,j,k,l + ! + ! --- Check whether field should be initialised + IF (pos.EQ.0) RETURN + ! + DO k=1,ks + !$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)) + bgct_sed(i,j,k,pos)=inival ENDDO ENDDO -!$OMP END PARALLEL DO ENDDO -! - END SUBROUTINE inilvl - - - - SUBROUTINE inisdm(pos,inival) -! -! --- ------------------------------------------------------------------ -! --- Description: initialise sediment diagnostic field -! --- -! --- Arguments: -! --- int pos (in) : position in common buffer -! --- real inival (in) : value used for initalisation -! --- ------------------------------------------------------------------ -! - IMPLICIT NONE -! - INTEGER :: pos - REAL ::inival -! - INTEGER :: i,j,k,l -! -! --- Check whether field should be initialised - IF (pos.EQ.0) RETURN -! - DO k=1,ks -!$OMP PARALLEL DO PRIVATE(l,i) + !$OMP END PARALLEL DO + ENDDO + ! + END SUBROUTINE inisdm + + + + SUBROUTINE inibur(pos,inival) + ! + ! --- ------------------------------------------------------------------ + ! --- Description: initialise sediment burial diagnostic field + ! --- + ! --- Arguments: + ! --- int pos (in) : position in common buffer + ! --- real inival (in) : value used for initalisation + ! --- ------------------------------------------------------------------ + ! + IMPLICIT NONE + ! + INTEGER :: pos + REAL ::inival + ! + INTEGER :: i,j,l + ! + ! --- Check whether field should be initialised + IF (pos.EQ.0) RETURN + ! + !$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)) + bgct_bur(i,j,pos)=inival + ENDDO + ENDDO + ENDDO + !$OMP END PARALLEL DO + ! + END SUBROUTINE inibur + + + + SUBROUTINE accsrf(pos,fld,wghts,wghtsflg) + ! + ! --- ------------------------------------------------------------------ + ! --- Description: accumulate 2d fields + ! --- + ! --- Arguments: + ! --- int pos (in) : position in 2d buffer + ! --- real fld (in) : input data used for accumulation + ! --- real wghts (in) : weights used for accumulation + ! --- ------------------------------------------------------------------ + ! + IMPLICIT NONE + ! + INTEGER :: pos(nbgcmax),wghtsflg + REAL, DIMENSION(idm,jdm) :: fld,wghts + ! + INTEGER :: i,j,l,o + ! + ! --- Check whether field should be accumulated + DO o=1,nbgc + IF (pos(o).EQ.0) cycle + ! + IF (wghtsflg.eq.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)) - bgct_sed(i,j,k,pos)=inival + bgcm2d(i,j,pos(o))=bgcm2d(i,j,pos(o))+fld(i,j) ENDDO ENDDO ENDDO -!$OMP END PARALLEL DO - ENDDO -! - END SUBROUTINE inisdm - - - - SUBROUTINE inibur(pos,inival) -! -! --- ------------------------------------------------------------------ -! --- Description: initialise sediment burial diagnostic field -! --- -! --- Arguments: -! --- int pos (in) : position in common buffer -! --- real inival (in) : value used for initalisation -! --- ------------------------------------------------------------------ -! - IMPLICIT NONE -! - INTEGER :: pos - REAL ::inival -! - INTEGER :: i,j,l -! -! --- Check whether field should be initialised - IF (pos.EQ.0) RETURN -! -!$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)) - bgct_bur(i,j,pos)=inival - ENDDO - ENDDO - ENDDO -!$OMP END PARALLEL DO -! - END SUBROUTINE inibur - - - - SUBROUTINE accsrf(pos,fld,wghts,wghtsflg) -! -! --- ------------------------------------------------------------------ -! --- Description: accumulate 2d fields -! --- -! --- Arguments: -! --- int pos (in) : position in 2d buffer -! --- real fld (in) : input data used for accumulation -! --- real wghts (in) : weights used for accumulation -! --- ------------------------------------------------------------------ -! - IMPLICIT NONE -! - INTEGER :: pos(nbgcmax),wghtsflg - REAL, DIMENSION(idm,jdm) :: fld,wghts -! - INTEGER :: i,j,l,o -! -! --- Check whether field should be accumulated - DO o=1,nbgc - IF (pos(o).EQ.0) cycle -! - IF (wghtsflg.eq.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)) - bgcm2d(i,j,pos(o))=bgcm2d(i,j,pos(o))+fld(i,j) - ENDDO - ENDDO - ENDDO -!$OMP END PARALLEL DO - ELSE -!$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)) - bgcm2d(i,j,pos(o))=bgcm2d(i,j,pos(o))+fld(i,j)* & - & wghts(i,j) - ENDDO - ENDDO - ENDDO -!$OMP END PARALLEL DO - ENDIF -! - ENDDO -! - END SUBROUTINE accsrf - - - - SUBROUTINE acclyr(pos,fld,wghts,wghtsflg) -! -! --- ------------------------------------------------------------------ -! --- Description: accumulate layer fields -! --- -! --- Arguments: -! --- int pos (in) : position in 3d layer buffer -! --- real fld (in) : input data used for accumulation -! --- real wghts (in) : weights used for accumulation -! --- ------------------------------------------------------------------ -! - IMPLICIT NONE -! - INTEGER :: pos(nbgcmax),wghtsflg - REAL, DIMENSION(idm,jdm,kdm) :: fld,wghts -! - INTEGER :: i,j,k,l,o -! -! --- Check whether field should be accumulated - DO o=1,nbgc - IF (pos(o).EQ.0) cycle -! - IF (wghtsflg.eq.0) then - DO k=1,kk -!$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)) - bgcm3d(i,j,k,pos(o))=bgcm3d(i,j,k,pos(o))+ & - & fld(i,j,k) - ENDDO - ENDDO - ENDDO -!$OMP END PARALLEL DO - ENDDO - ELSE - DO k=1,kk -!$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)) - bgcm3d(i,j,k,pos(o))=bgcm3d(i,j,k,pos(o))+ & - & fld(i,j,k)*wghts(i,j,k) - ENDDO - ENDDO - ENDDO -!$OMP END PARALLEL DO - ENDDO - ENDIF -! - ENDDO - END SUBROUTINE acclyr - - - - SUBROUTINE acclvl(pos,fld,k,ind1,ind2,wghts) -! -! --- ------------------------------------------------------------------ -! --- Description: accumulate 3d level fields -! --- -! --- Arguments: -! --- int pos (in) : position in buffer -! --- real fld (in) : input data used for accumulation -! --- int k (in) : layer index of fld -! --- int ind1 (in) : index field for first accumulated level -! --- int ind2 (in) : index field for last accumulated level -! --- real wghts (in) : weights used for accumulation -! --- ------------------------------------------------------------------ -! - IMPLICIT NONE -! - INTEGER :: pos(nbgcmax),k - INTEGER, DIMENSION(idm,jdm) :: ind1,ind2 - REAL, DIMENSION(idm,jdm,ddm) :: wghts - REAL, DIMENSION(idm,jdm,kdm) :: fld -! - INTEGER :: d,i,j,l,o -! -! --- Check whether field should be accumulated - DO o=1,nbgc - IF (pos(o).EQ.0) cycle -! -!$OMP PARALLEL DO PRIVATE(l,i,d) + !$OMP END PARALLEL DO + ELSE + !$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)) - DO d=ind1(i,j),ind2(i,j) - bgcm3dlvl(i,j,d,pos(o))=bgcm3dlvl(i,j,d,pos(o))+ & - & fld(i,j,k)*wghts(i,j,d) + bgcm2d(i,j,pos(o))=bgcm2d(i,j,pos(o))+fld(i,j)* & + & wghts(i,j) + ENDDO + ENDDO + ENDDO + !$OMP END PARALLEL DO + ENDIF + ! + ENDDO + ! + END SUBROUTINE accsrf + + + + SUBROUTINE acclyr(pos,fld,wghts,wghtsflg) + ! + ! --- ------------------------------------------------------------------ + ! --- Description: accumulate layer fields + ! --- + ! --- Arguments: + ! --- int pos (in) : position in 3d layer buffer + ! --- real fld (in) : input data used for accumulation + ! --- real wghts (in) : weights used for accumulation + ! --- ------------------------------------------------------------------ + ! + IMPLICIT NONE + ! + INTEGER :: pos(nbgcmax),wghtsflg + REAL, DIMENSION(idm,jdm,kdm) :: fld,wghts + ! + INTEGER :: i,j,k,l,o + ! + ! --- Check whether field should be accumulated + DO o=1,nbgc + IF (pos(o).EQ.0) cycle + ! + IF (wghtsflg.eq.0) then + DO k=1,kk + !$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)) + bgcm3d(i,j,k,pos(o))=bgcm3d(i,j,k,pos(o))+ & + & fld(i,j,k) ENDDO ENDDO ENDDO + !$OMP END PARALLEL DO ENDDO -!$OMP END PARALLEL DO - ENDDO -! - END SUBROUTINE acclvl - - - - SUBROUTINE accsdm(pos,fld) -! -! --- ------------------------------------------------------------------ -! --- Description: accumulate sediment fields -! --- -! --- Arguments: -! --- int pos (in) : position in 3d layer buffer -! --- real fld (in) : input data used for accumulation -! --- ------------------------------------------------------------------ -! - IMPLICIT NONE -! - INTEGER :: pos(nbgcmax) - REAL, DIMENSION(idm,jdm,ks) :: fld -! - INTEGER :: i,j,k,l,o -! -! --- Check whether field should be accumulated - DO o=1,nbgc - IF (pos(o).EQ.0) cycle -! - DO k=1,ks -!$OMP PARALLEL DO PRIVATE(l,i) + ELSE + DO k=1,kk + !$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)) - bgct_sed(i,j,k,pos(o))=bgct_sed(i,j,k,pos(o))+fld(i,j,k) + bgcm3d(i,j,k,pos(o))=bgcm3d(i,j,k,pos(o))+ & + & fld(i,j,k)*wghts(i,j,k) ENDDO ENDDO ENDDO -!$OMP END PARALLEL DO + !$OMP END PARALLEL DO + ENDDO + ENDIF + ! + ENDDO + END SUBROUTINE acclyr + + + + SUBROUTINE acclvl(pos,fld,k,ind1,ind2,wghts) + ! + ! --- ------------------------------------------------------------------ + ! --- Description: accumulate 3d level fields + ! --- + ! --- Arguments: + ! --- int pos (in) : position in buffer + ! --- real fld (in) : input data used for accumulation + ! --- int k (in) : layer index of fld + ! --- int ind1 (in) : index field for first accumulated level + ! --- int ind2 (in) : index field for last accumulated level + ! --- real wghts (in) : weights used for accumulation + ! --- ------------------------------------------------------------------ + ! + IMPLICIT NONE + ! + INTEGER :: pos(nbgcmax),k + INTEGER, DIMENSION(idm,jdm) :: ind1,ind2 + REAL, DIMENSION(idm,jdm,ddm) :: wghts + REAL, DIMENSION(idm,jdm,kdm) :: fld + ! + INTEGER :: d,i,j,l,o + ! + ! --- Check whether field should be accumulated + DO o=1,nbgc + IF (pos(o).EQ.0) cycle + ! + !$OMP PARALLEL DO PRIVATE(l,i,d) + DO j=1,jj + DO l=1,isp(j) + DO i=max(1,ifp(j,l)),min(ii,ilp(j,l)) + DO d=ind1(i,j),ind2(i,j) + bgcm3dlvl(i,j,d,pos(o))=bgcm3dlvl(i,j,d,pos(o))+ & + & fld(i,j,k)*wghts(i,j,d) + ENDDO + ENDDO ENDDO ENDDO -! - END SUBROUTINE accsdm - - - - SUBROUTINE accbur(pos,fld) -! -! --- ------------------------------------------------------------------ -! --- Description: accumulate sediment burial fields -! --- -! --- Arguments: -! --- int pos (in) : position in 3d layer buffer -! --- real fld (in) : input data used for accumulation -! --- ------------------------------------------------------------------ -! - IMPLICIT NONE -! - INTEGER :: pos(nbgcmax) - REAL, DIMENSION(idm,jdm) :: fld -! - INTEGER :: i,j,l,o -! -! --- Check whether field should be accumulated - DO o=1,nbgc - IF (pos(o).EQ.0) cycle -! -!$OMP PARALLEL DO PRIVATE(l,i) + !$OMP END PARALLEL DO + ENDDO + ! + END SUBROUTINE acclvl + + + + SUBROUTINE accsdm(pos,fld) + ! + ! --- ------------------------------------------------------------------ + ! --- Description: accumulate sediment fields + ! --- + ! --- Arguments: + ! --- int pos (in) : position in 3d layer buffer + ! --- real fld (in) : input data used for accumulation + ! --- ------------------------------------------------------------------ + ! + IMPLICIT NONE + ! + INTEGER :: pos(nbgcmax) + REAL, DIMENSION(idm,jdm,ks) :: fld + ! + INTEGER :: i,j,k,l,o + ! + ! --- Check whether field should be accumulated + DO o=1,nbgc + IF (pos(o).EQ.0) cycle + ! + DO k=1,ks + !$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)) - bgct_bur(i,j,pos(o))=bgct_bur(i,j,pos(o))+fld(i,j) + bgct_sed(i,j,k,pos(o))=bgct_sed(i,j,k,pos(o))+fld(i,j,k) ENDDO ENDDO ENDDO -!$OMP END PARALLEL DO + !$OMP END PARALLEL DO ENDDO -! - END SUBROUTINE accbur - - - - SUBROUTINE finsrf(posacc,poswgt) -! -! --- ------------------------------------------------------------------ -! --- Description: finalise accumulation of weighted 2d fields -! --- -! --- Arguments: -! --- real posacc (in) : position of accumulated field in buffer -! --- real poswgt (in) : position of accumulated weights -! --- ------------------------------------------------------------------ -! - IMPLICIT NONE -! - INTEGER :: posacc,poswgt -! - INTEGER :: i,j,l - REAL, parameter :: epsil=1e-11 -! -! --- Check whether field should be initialised - IF (posacc.EQ.0) RETURN -! -!$OMP PARALLEL DO PRIVATE(l,i) + ENDDO + ! + END SUBROUTINE accsdm + + + + SUBROUTINE accbur(pos,fld) + ! + ! --- ------------------------------------------------------------------ + ! --- Description: accumulate sediment burial fields + ! --- + ! --- Arguments: + ! --- int pos (in) : position in 3d layer buffer + ! --- real fld (in) : input data used for accumulation + ! --- ------------------------------------------------------------------ + ! + IMPLICIT NONE + ! + INTEGER :: pos(nbgcmax) + REAL, DIMENSION(idm,jdm) :: fld + ! + INTEGER :: i,j,l,o + ! + ! --- Check whether field should be accumulated + DO o=1,nbgc + IF (pos(o).EQ.0) cycle + ! + !$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)) - bgcm2d(i,j,posacc)=bgcm2d(i,j,posacc)/ & - & max(epsil,bgcm2d(i,j,poswgt)) + bgct_bur(i,j,pos(o))=bgct_bur(i,j,pos(o))+fld(i,j) ENDDO ENDDO ENDDO -!$OMP END PARALLEL DO -! - END SUBROUTINE finsrf - - - - SUBROUTINE finlyr(posacc,poswgt) -! -! --- ------------------------------------------------------------------ -! --- Description: finalise accumulation of weighted 3d layer fields -! --- -! --- Arguments: -! --- real posacc (in) : position of accumulated field in buffer -! --- real poswgt) (in) : position of accumulated weights -! --- ------------------------------------------------------------------ -! - IMPLICIT NONE -! - INTEGER :: posacc,poswgt -! - INTEGER :: i,j,k,l - REAL, parameter :: epsil=1e-11 -! -! --- Check whether field should be initialised - IF (posacc.EQ.0) RETURN -! - DO k=1,kk -!$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)) - IF (bgcm3d(i,j,k,poswgt).GT.epsil) THEN - bgcm3d(i,j,k,posacc)=bgcm3d(i,j,k,posacc)/ & - & bgcm3d(i,j,k,poswgt) - ELSE - bgcm3d(i,j,k,posacc)=nf90_fill_double - ENDIF - ENDDO + !$OMP END PARALLEL DO + ENDDO + ! + END SUBROUTINE accbur + + + + SUBROUTINE finsrf(posacc,poswgt) + ! + ! --- ------------------------------------------------------------------ + ! --- Description: finalise accumulation of weighted 2d fields + ! --- + ! --- Arguments: + ! --- real posacc (in) : position of accumulated field in buffer + ! --- real poswgt (in) : position of accumulated weights + ! --- ------------------------------------------------------------------ + ! + IMPLICIT NONE + ! + INTEGER :: posacc,poswgt + ! + INTEGER :: i,j,l + REAL, parameter :: epsil=1e-11 + ! + ! --- Check whether field should be initialised + IF (posacc.EQ.0) RETURN + ! + !$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)) + bgcm2d(i,j,posacc)=bgcm2d(i,j,posacc)/ & + & max(epsil,bgcm2d(i,j,poswgt)) + ENDDO + ENDDO + ENDDO + !$OMP END PARALLEL DO + ! + END SUBROUTINE finsrf + + + + SUBROUTINE finlyr(posacc,poswgt) + ! + ! --- ------------------------------------------------------------------ + ! --- Description: finalise accumulation of weighted 3d layer fields + ! --- + ! --- Arguments: + ! --- real posacc (in) : position of accumulated field in buffer + ! --- real poswgt) (in) : position of accumulated weights + ! --- ------------------------------------------------------------------ + ! + IMPLICIT NONE + ! + INTEGER :: posacc,poswgt + ! + INTEGER :: i,j,k,l + REAL, parameter :: epsil=1e-11 + ! + ! --- Check whether field should be initialised + IF (posacc.EQ.0) RETURN + ! + DO k=1,kk + !$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)) + IF (bgcm3d(i,j,k,poswgt).GT.epsil) THEN + bgcm3d(i,j,k,posacc)=bgcm3d(i,j,k,posacc)/ & + & bgcm3d(i,j,k,poswgt) + ELSE + bgcm3d(i,j,k,posacc)=nf90_fill_double + ENDIF ENDDO ENDDO -!$OMP END PARALLEL DO ENDDO -! - END SUBROUTINE finlyr - - - - SUBROUTINE wrtsrf(pos,frmt,sfac,offs,cmpflg,vnm) -! -! --- ------------------------------------------------------------------ -! --- Description: writes diagnostic 2d field to file -! --- -! --- Arguments: -! --- int pos (in) : variable position in common buffer -! --- int frmt (in) : format/precision of output -! --- 0=field is not written -! --- 2=field is written as int2 with scale -! --- factor and offset -! --- 4=field is written as real4 -! --- 8=field is written as real8 -! --- real sfac (in) : user def.NE. scale factor to be applied -! --- real offs (in) : user def.NE. offset to be added -! --- int cmpflg (in) : compression flag; only wet points are -! --- written IF flag is set to 1 -! --- char vnm (in) : variable name used in nc-file -! --- ------------------------------------------------------------------ -! - IMPLICIT NONE -! - REAL, intent(in) :: sfac,offs - INTEGER, intent(in) :: frmt,cmpflg,pos - CHARACTER(LEN=*),intent(in) :: vnm -! - INTEGER :: n - CHARACTER(LEN=100) :: dims -! -! --- Check whether field should be written - IF (pos.EQ.0 .OR. frmt.EQ.0) RETURN -! -! --- Create dimension string + !$OMP END PARALLEL DO + ENDDO + ! + END SUBROUTINE finlyr + + + + SUBROUTINE wrtsrf(pos,frmt,sfac,offs,cmpflg,vnm) + ! + ! --- ------------------------------------------------------------------ + ! --- Description: writes diagnostic 2d field to file + ! --- + ! --- Arguments: + ! --- int pos (in) : variable position in common buffer + ! --- int frmt (in) : format/precision of output + ! --- 0=field is not written + ! --- 2=field is written as int2 with scale + ! --- factor and offset + ! --- 4=field is written as real4 + ! --- 8=field is written as real8 + ! --- real sfac (in) : user def.NE. scale factor to be applied + ! --- real offs (in) : user def.NE. offset to be added + ! --- int cmpflg (in) : compression flag; only wet points are + ! --- written IF flag is set to 1 + ! --- char vnm (in) : variable name used in nc-file + ! --- ------------------------------------------------------------------ + ! + IMPLICIT NONE + ! + REAL, intent(in) :: sfac,offs + INTEGER, intent(in) :: frmt,cmpflg,pos + CHARACTER(LEN=*),intent(in) :: vnm + ! + INTEGER :: n + CHARACTER(LEN=100) :: dims + ! + ! --- Check whether field should be written + IF (pos.EQ.0 .OR. frmt.EQ.0) RETURN + ! + ! --- Create dimension string + IF (cmpflg.EQ.1) THEN + dims='pcomp time' + ELSE + dims='x y time' + ENDIF + ! + ! --- Check output format + IF (frmt.EQ.2) THEN IF (cmpflg.EQ.1) THEN - dims='pcomp time' + CALL nccopa(vnm,dims,bgcm2d(1-nbdy,1-nbdy,pos),ip,sfac, & + & offs) ELSE - dims='x y time' + CALL ncpack(vnm,dims,bgcm2d(1-nbdy,1-nbdy,pos),ip,2, & + & sfac,offs) ENDIF -! -! --- Check output format - IF (frmt.EQ.2) THEN - IF (cmpflg.EQ.1) THEN - CALL nccopa(vnm,dims,bgcm2d(1-nbdy,1-nbdy,pos),ip,sfac, & - & offs) - ELSE - CALL ncpack(vnm,dims,bgcm2d(1-nbdy,1-nbdy,pos),ip,2, & - & sfac,offs) - ENDIF - ELSEIF (frmt.EQ.4) THEN - IF (cmpflg.EQ.1) THEN - CALL nccomp(vnm,dims,bgcm2d(1-nbdy,1-nbdy,pos),ip,sfac, & - & offs,4) - ELSE - CALL ncwrtr(vnm,dims,bgcm2d(1-nbdy,1-nbdy,pos),ip,1, & - & sfac,offs,4) - ENDIF - ELSEIF (frmt.EQ.8) THEN - IF (cmpflg.EQ.1) THEN - CALL nccomp(vnm,dims,bgcm2d(1-nbdy,1-nbdy,pos),ip,sfac, & - & offs,8) - ELSE - CALL ncwrtr(vnm,dims,bgcm2d(1-nbdy,1-nbdy,pos),ip,1, & - & sfac,offs,8) - ENDIF + ELSEIF (frmt.EQ.4) THEN + IF (cmpflg.EQ.1) THEN + CALL nccomp(vnm,dims,bgcm2d(1-nbdy,1-nbdy,pos),ip,sfac, & + & offs,4) ELSE - STOP 'unknown output format ' + CALL ncwrtr(vnm,dims,bgcm2d(1-nbdy,1-nbdy,pos),ip,1, & + & sfac,offs,4) ENDIF -! - END SUBROUTINE wrtsrf - - - - SUBROUTINE wrtlyr(pos,frmt,sfac,offs,cmpflg,vnm) -! -! --- ------------------------------------------------------------------ -! --- Description: writes diagnostic layer field to file -! --- -! --- Arguments: -! --- int pos (in) : variable position in common buffer -! --- int frmt (in) : format/precision of output -! --- 0=field is not written -! --- 2=field is written as int2 with scale -! --- factor and offset -! --- 4=field is written as real4 -! --- 8=field is written as real8 -! --- real sfac (in) : user def.NE. scale factor to be applied -! --- real offs (in) : user def.NE. offset to be added -! --- int cmpflg (in) : compression flag; only wet points are -! --- written IF flag is set to 1 -! --- char vnm (in) : variable name used in nc-file -! --- ------------------------------------------------------------------ -! - IMPLICIT NONE -! - REAL, intent(in) :: sfac,offs - INTEGER, intent(in) :: frmt,cmpflg,pos - CHARACTER(LEN=*),intent(in) :: vnm -! - INTEGER :: n - CHARACTER(LEN=100) :: dims -! -! --- Check whether field should be written - IF (pos.EQ.0 .OR. frmt.EQ.0) RETURN -! -! --- Create dimension string + ELSEIF (frmt.EQ.8) THEN IF (cmpflg.EQ.1) THEN - dims='pcomp sigma time' + CALL nccomp(vnm,dims,bgcm2d(1-nbdy,1-nbdy,pos),ip,sfac, & + & offs,8) ELSE - dims='x y sigma time' + CALL ncwrtr(vnm,dims,bgcm2d(1-nbdy,1-nbdy,pos),ip,1, & + & sfac,offs,8) ENDIF -! -! --- Check output format - IF (frmt.EQ.2) THEN - IF (cmpflg.EQ.1) THEN - CALL nccopa(vnm,dims,bgcm3d(1-nbdy,1-nbdy,1,pos),ip,sfac, & - & offs) - ELSE - CALL ncpack(vnm,dims,bgcm3d(1-nbdy,1-nbdy,1,pos),ip,2, & - & sfac,offs) - ENDIF - ELSEIF (frmt.EQ.4) THEN - IF (cmpflg.EQ.1) THEN - CALL nccomp(vnm,dims,bgcm3d(1-nbdy,1-nbdy,1,pos),ip,sfac, & - & offs,4) - ELSE - CALL ncwrtr(vnm,dims,bgcm3d(1-nbdy,1-nbdy,1,pos),ip,2, & - & sfac,offs,4) - ENDIF - ELSEIF (frmt.EQ.8) THEN - IF (cmpflg.EQ.1) THEN - CALL nccomp(vnm,dims,bgcm3d(1-nbdy,1-nbdy,1,pos),ip,sfac, & - & offs,8) - ELSE - CALL ncwrtr(vnm,dims,bgcm3d(1-nbdy,1-nbdy,1,pos),ip,2, & - & sfac,offs,8) - ENDIF + ELSE + STOP 'unknown output format ' + ENDIF + ! + END SUBROUTINE wrtsrf + + + + SUBROUTINE wrtlyr(pos,frmt,sfac,offs,cmpflg,vnm) + ! + ! --- ------------------------------------------------------------------ + ! --- Description: writes diagnostic layer field to file + ! --- + ! --- Arguments: + ! --- int pos (in) : variable position in common buffer + ! --- int frmt (in) : format/precision of output + ! --- 0=field is not written + ! --- 2=field is written as int2 with scale + ! --- factor and offset + ! --- 4=field is written as real4 + ! --- 8=field is written as real8 + ! --- real sfac (in) : user def.NE. scale factor to be applied + ! --- real offs (in) : user def.NE. offset to be added + ! --- int cmpflg (in) : compression flag; only wet points are + ! --- written IF flag is set to 1 + ! --- char vnm (in) : variable name used in nc-file + ! --- ------------------------------------------------------------------ + ! + IMPLICIT NONE + ! + REAL, intent(in) :: sfac,offs + INTEGER, intent(in) :: frmt,cmpflg,pos + CHARACTER(LEN=*),intent(in) :: vnm + ! + INTEGER :: n + CHARACTER(LEN=100) :: dims + ! + ! --- Check whether field should be written + IF (pos.EQ.0 .OR. frmt.EQ.0) RETURN + ! + ! --- Create dimension string + IF (cmpflg.EQ.1) THEN + dims='pcomp sigma time' + ELSE + dims='x y sigma time' + ENDIF + ! + ! --- Check output format + IF (frmt.EQ.2) THEN + IF (cmpflg.EQ.1) THEN + CALL nccopa(vnm,dims,bgcm3d(1-nbdy,1-nbdy,1,pos),ip,sfac, & + & offs) ELSE - STOP 'unknown output format ' + CALL ncpack(vnm,dims,bgcm3d(1-nbdy,1-nbdy,1,pos),ip,2, & + & sfac,offs) ENDIF -! - END SUBROUTINE wrtlyr - - - - SUBROUTINE wrtlvl(pos,frmt,sfac,offs,cmpflg,vnm) -! -! --- ------------------------------------------------------------------ -! --- Description: writes diagnostic level field to file -! --- -! --- Arguments: -! --- int pos (in) : variable position in common buffer -! --- int frmt (in) : format/precision of output -! --- 0=field is not written -! --- 2=field is written as int2 with scale -! --- factor and offset -! --- 4=field is written as real4 -! --- 8=field is written as real8 -! --- real sfac (in) : user def.NE. scale factor to be applied -! --- real offs (in) : user def.NE. offset to be added -! --- int cmpflg (in) : compression flag; only wet points are -! --- written IF flag is set to 1 -! --- char vnm (in) : variable name used in nc-file -! --- ------------------------------------------------------------------ -! - IMPLICIT NONE -! - REAL, intent(in) :: sfac,offs - INTEGER, intent(in) :: frmt,cmpflg,pos - CHARACTER(LEN=*),intent(in) :: vnm -! - INTEGER :: n - CHARACTER(LEN=100) :: dims -! -! --- Check whether field should be written - IF (pos.EQ.0 .OR. frmt.EQ.0) RETURN -! -! --- Create dimension string + ELSEIF (frmt.EQ.4) THEN IF (cmpflg.EQ.1) THEN - dims='pcomp depth time' + CALL nccomp(vnm,dims,bgcm3d(1-nbdy,1-nbdy,1,pos),ip,sfac, & + & offs,4) ELSE - dims='x y depth time' + CALL ncwrtr(vnm,dims,bgcm3d(1-nbdy,1-nbdy,1,pos),ip,2, & + & sfac,offs,4) ENDIF -! -! --- Check output format - IF (frmt.EQ.2) THEN - IF (cmpflg.EQ.1) THEN - CALL nccopa(vnm,dims,bgcm3dlvl(1-nbdy,1-nbdy,1,pos),ip,sfac, & - & offs) - ELSE - CALL ncpack(vnm,dims,bgcm3dlvl(1-nbdy,1-nbdy,1,pos),ip,2, & - & sfac,offs) - ENDIF - ELSEIF (frmt.EQ.4) THEN - IF (cmpflg.EQ.1) THEN - CALL nccomp(vnm,dims,bgcm3dlvl(1-nbdy,1-nbdy,1,pos),ip,sfac, & - & offs,4) - ELSE - CALL ncwrtr(vnm,dims,bgcm3dlvl(1-nbdy,1-nbdy,1,pos),ip,2, & - & sfac,offs,4) - ENDIF - ELSEIF (frmt.EQ.8) THEN - IF (cmpflg.EQ.1) THEN - CALL nccomp(vnm,dims,bgcm3dlvl(1-nbdy,1-nbdy,1,pos),ip,sfac, & - & offs,8) - ELSE - CALL ncwrtr(vnm,dims,bgcm3dlvl(1-nbdy,1-nbdy,1,pos),ip,2, & - & sfac,offs,8) - ENDIF + ELSEIF (frmt.EQ.8) THEN + IF (cmpflg.EQ.1) THEN + CALL nccomp(vnm,dims,bgcm3d(1-nbdy,1-nbdy,1,pos),ip,sfac, & + & offs,8) ELSE - STOP 'unknown output format ' + CALL ncwrtr(vnm,dims,bgcm3d(1-nbdy,1-nbdy,1,pos),ip,2, & + & sfac,offs,8) ENDIF -! - END SUBROUTINE wrtlvl - - - - SUBROUTINE wrtsdm(pos,frmt,sfac,offs,cmpflg,vnm) -! -! --- ------------------------------------------------------------------ -! --- Description: writes diagnostic sediment field to file -! --- -! --- Arguments: -! --- int pos (in) : variable position in common buffer -! --- int frmt (in) : format/precision of output -! --- 0=field is not written -! --- 2=field is written as int2 with scale -! --- factor and offset -! --- 4=field is written as real4 -! --- 8=field is written as real8 -! --- real sfac (in) : user def.NE. scale factor to be applied -! --- real offs (in) : user def.NE. offset to be added -! --- int cmpflg (in) : compression flag; only wet points are -! --- written IF flag is set to 1 -! --- char vnm (in) : variable name used in nc-file -! --- ------------------------------------------------------------------ -! - IMPLICIT NONE -! - REAL, intent(in) :: sfac,offs - INTEGER, intent(in) :: frmt,cmpflg,pos - CHARACTER(LEN=*),intent(in) :: vnm -! - INTEGER :: n - CHARACTER(LEN=100) :: dims -! -! --- Check whether field should be written - IF (pos.EQ.0 .OR. frmt.EQ.0) RETURN -! -! --- Create dimension string + ELSE + STOP 'unknown output format ' + ENDIF + ! + END SUBROUTINE wrtlyr + + + + SUBROUTINE wrtlvl(pos,frmt,sfac,offs,cmpflg,vnm) + ! + ! --- ------------------------------------------------------------------ + ! --- Description: writes diagnostic level field to file + ! --- + ! --- Arguments: + ! --- int pos (in) : variable position in common buffer + ! --- int frmt (in) : format/precision of output + ! --- 0=field is not written + ! --- 2=field is written as int2 with scale + ! --- factor and offset + ! --- 4=field is written as real4 + ! --- 8=field is written as real8 + ! --- real sfac (in) : user def.NE. scale factor to be applied + ! --- real offs (in) : user def.NE. offset to be added + ! --- int cmpflg (in) : compression flag; only wet points are + ! --- written IF flag is set to 1 + ! --- char vnm (in) : variable name used in nc-file + ! --- ------------------------------------------------------------------ + ! + IMPLICIT NONE + ! + REAL, intent(in) :: sfac,offs + INTEGER, intent(in) :: frmt,cmpflg,pos + CHARACTER(LEN=*),intent(in) :: vnm + ! + INTEGER :: n + CHARACTER(LEN=100) :: dims + ! + ! --- Check whether field should be written + IF (pos.EQ.0 .OR. frmt.EQ.0) RETURN + ! + ! --- Create dimension string + IF (cmpflg.EQ.1) THEN + dims='pcomp depth time' + ELSE + dims='x y depth time' + ENDIF + ! + ! --- Check output format + IF (frmt.EQ.2) THEN IF (cmpflg.EQ.1) THEN - dims='pcomp ks time' + CALL nccopa(vnm,dims,bgcm3dlvl(1-nbdy,1-nbdy,1,pos),ip,sfac, & + & offs) ELSE - dims='x y ks time' + CALL ncpack(vnm,dims,bgcm3dlvl(1-nbdy,1-nbdy,1,pos),ip,2, & + & sfac,offs) ENDIF -! -! --- Check output format - IF (frmt.EQ.2) THEN - IF (cmpflg.EQ.1) THEN - CALL nccopa(vnm,dims,bgct_sed(1-nbdy,1-nbdy,1,pos),ip,sfac, & - & offs) - ELSE - CALL ncpack(vnm,dims,bgct_sed(1-nbdy,1-nbdy,1,pos),ip,1, & - & sfac,offs) - ENDIF - ELSEIF (frmt.EQ.4) THEN - IF (cmpflg.EQ.1) THEN - CALL nccomp(vnm,dims,bgct_sed(1-nbdy,1-nbdy,1,pos),ip,sfac, & - & offs,4) - ELSE - CALL ncwrtr(vnm,dims,bgct_sed(1-nbdy,1-nbdy,1,pos),ip,1, & - & sfac,offs,4) - ENDIF - ELSEIF (frmt.EQ.8) THEN - IF (cmpflg.EQ.1) THEN - CALL nccomp(vnm,dims,bgct_sed(1-nbdy,1-nbdy,1,pos),ip,sfac, & - & offs,8) - ELSE - CALL ncwrtr(vnm,dims,bgct_sed(1-nbdy,1-nbdy,1,pos),ip,1, & - & sfac,offs,8) - ENDIF + ELSEIF (frmt.EQ.4) THEN + IF (cmpflg.EQ.1) THEN + CALL nccomp(vnm,dims,bgcm3dlvl(1-nbdy,1-nbdy,1,pos),ip,sfac, & + & offs,4) ELSE - STOP 'unknown output format ' + CALL ncwrtr(vnm,dims,bgcm3dlvl(1-nbdy,1-nbdy,1,pos),ip,2, & + & sfac,offs,4) ENDIF -! - END SUBROUTINE wrtsdm - - - - SUBROUTINE wrtbur(pos,frmt,sfac,offs,cmpflg,vnm) -! -! --- ------------------------------------------------------------------ -! --- Description: writes diagnostic sediment burial field to file -! --- -! --- Arguments: -! --- int pos (in) : variable position in common buffer -! --- int frmt (in) : format/precision of output -! --- 0=field is not written -! --- 2=field is written as int2 with scale -! --- factor and offset -! --- 4=field is written as real4 -! --- 8=field is written as real8 -! --- real sfac (in) : user def.NE. scale factor to be applied -! --- real offs (in) : user def.NE. offset to be added -! --- int cmpflg (in) : compression flag; only wet points are -! --- written IF flag is set to 1 -! --- char vnm (in) : variable name used in nc-file -! --- ------------------------------------------------------------------ -! - IMPLICIT NONE -! - REAL, intent(in) :: sfac,offs - INTEGER, intent(in) :: frmt,cmpflg,pos - CHARACTER(LEN=*),intent(in) :: vnm -! - INTEGER :: n - CHARACTER(LEN=100) :: dims -! -! --- Check whether field should be written - IF (pos.EQ.0 .OR. frmt.EQ.0) RETURN -! -! --- Create dimension string + ELSEIF (frmt.EQ.8) THEN IF (cmpflg.EQ.1) THEN - dims='pcomp time' + CALL nccomp(vnm,dims,bgcm3dlvl(1-nbdy,1-nbdy,1,pos),ip,sfac, & + & offs,8) ELSE - dims='x y time' + CALL ncwrtr(vnm,dims,bgcm3dlvl(1-nbdy,1-nbdy,1,pos),ip,2, & + & sfac,offs,8) ENDIF -! -! --- Check output format - IF (frmt.EQ.2) THEN - IF (cmpflg.EQ.1) THEN - CALL nccopa(vnm,dims,bgct_bur(1-nbdy,1-nbdy,pos),ip,sfac, & - & offs) - ELSE - CALL ncpack(vnm,dims,bgct_bur(1-nbdy,1-nbdy,pos),ip,1, & - & sfac,offs) - ENDIF - ELSEIF (frmt.EQ.4) THEN - IF (cmpflg.EQ.1) THEN - CALL nccomp(vnm,dims,bgct_bur(1-nbdy,1-nbdy,pos),ip,sfac, & - & offs,4) - ELSE - CALL ncwrtr(vnm,dims,bgct_bur(1-nbdy,1-nbdy,pos),ip,1, & - & sfac,offs,4) - ENDIF - ELSEIF (frmt.EQ.8) THEN - IF (cmpflg.EQ.1) THEN - CALL nccomp(vnm,dims,bgct_bur(1-nbdy,1-nbdy,pos),ip,sfac, & - & offs,8) - ELSE - CALL ncwrtr(vnm,dims,bgct_bur(1-nbdy,1-nbdy,pos),ip,1, & - & sfac,offs,8) - ENDIF + ELSE + STOP 'unknown output format ' + ENDIF + ! + END SUBROUTINE wrtlvl + + + + SUBROUTINE wrtsdm(pos,frmt,sfac,offs,cmpflg,vnm) + ! + ! --- ------------------------------------------------------------------ + ! --- Description: writes diagnostic sediment field to file + ! --- + ! --- Arguments: + ! --- int pos (in) : variable position in common buffer + ! --- int frmt (in) : format/precision of output + ! --- 0=field is not written + ! --- 2=field is written as int2 with scale + ! --- factor and offset + ! --- 4=field is written as real4 + ! --- 8=field is written as real8 + ! --- real sfac (in) : user def.NE. scale factor to be applied + ! --- real offs (in) : user def.NE. offset to be added + ! --- int cmpflg (in) : compression flag; only wet points are + ! --- written IF flag is set to 1 + ! --- char vnm (in) : variable name used in nc-file + ! --- ------------------------------------------------------------------ + ! + IMPLICIT NONE + ! + REAL, intent(in) :: sfac,offs + INTEGER, intent(in) :: frmt,cmpflg,pos + CHARACTER(LEN=*),intent(in) :: vnm + ! + INTEGER :: n + CHARACTER(LEN=100) :: dims + ! + ! --- Check whether field should be written + IF (pos.EQ.0 .OR. frmt.EQ.0) RETURN + ! + ! --- Create dimension string + IF (cmpflg.EQ.1) THEN + dims='pcomp ks time' + ELSE + dims='x y ks time' + ENDIF + ! + ! --- Check output format + IF (frmt.EQ.2) THEN + IF (cmpflg.EQ.1) THEN + CALL nccopa(vnm,dims,bgct_sed(1-nbdy,1-nbdy,1,pos),ip,sfac, & + & offs) ELSE - STOP 'unknown output format ' + CALL ncpack(vnm,dims,bgct_sed(1-nbdy,1-nbdy,1,pos),ip,1, & + & sfac,offs) ENDIF -! - END SUBROUTINE wrtbur - - - - SUBROUTINE logsrf(pos,sfac,offs) -! -! --- ------------------------------------------------------------------ -! --- Description: replace 2d field with log10(field) -! --- -! --- Arguments: -! --- int pos (in) : field position in layer buffer -! --- real sfac (in) : scale factor to be applied before log10 -! --- real offs (in) : offset to be added before log10 -! --- ------------------------------------------------------------------ -! - IMPLICIT NONE -! - REAL ::sfac,offs - INTEGER :: pos -! - INTEGER :: i,j,l - REAL ::epsil=1e-11 -! -! --- Check whether field should be processed - IF (pos.EQ.0) RETURN -! -!$OMP PARALLEL DO PRIVATE(l,i) + ELSEIF (frmt.EQ.4) THEN + IF (cmpflg.EQ.1) THEN + CALL nccomp(vnm,dims,bgct_sed(1-nbdy,1-nbdy,1,pos),ip,sfac, & + & offs,4) + ELSE + CALL ncwrtr(vnm,dims,bgct_sed(1-nbdy,1-nbdy,1,pos),ip,1, & + & sfac,offs,4) + ENDIF + ELSEIF (frmt.EQ.8) THEN + IF (cmpflg.EQ.1) THEN + CALL nccomp(vnm,dims,bgct_sed(1-nbdy,1-nbdy,1,pos),ip,sfac, & + & offs,8) + ELSE + CALL ncwrtr(vnm,dims,bgct_sed(1-nbdy,1-nbdy,1,pos),ip,1, & + & sfac,offs,8) + ENDIF + ELSE + STOP 'unknown output format ' + ENDIF + ! + END SUBROUTINE wrtsdm + + + + SUBROUTINE wrtbur(pos,frmt,sfac,offs,cmpflg,vnm) + ! + ! --- ------------------------------------------------------------------ + ! --- Description: writes diagnostic sediment burial field to file + ! --- + ! --- Arguments: + ! --- int pos (in) : variable position in common buffer + ! --- int frmt (in) : format/precision of output + ! --- 0=field is not written + ! --- 2=field is written as int2 with scale + ! --- factor and offset + ! --- 4=field is written as real4 + ! --- 8=field is written as real8 + ! --- real sfac (in) : user def.NE. scale factor to be applied + ! --- real offs (in) : user def.NE. offset to be added + ! --- int cmpflg (in) : compression flag; only wet points are + ! --- written IF flag is set to 1 + ! --- char vnm (in) : variable name used in nc-file + ! --- ------------------------------------------------------------------ + ! + IMPLICIT NONE + ! + REAL, intent(in) :: sfac,offs + INTEGER, intent(in) :: frmt,cmpflg,pos + CHARACTER(LEN=*),intent(in) :: vnm + ! + INTEGER :: n + CHARACTER(LEN=100) :: dims + ! + ! --- Check whether field should be written + IF (pos.EQ.0 .OR. frmt.EQ.0) RETURN + ! + ! --- Create dimension string + IF (cmpflg.EQ.1) THEN + dims='pcomp time' + ELSE + dims='x y time' + ENDIF + ! + ! --- Check output format + IF (frmt.EQ.2) THEN + IF (cmpflg.EQ.1) THEN + CALL nccopa(vnm,dims,bgct_bur(1-nbdy,1-nbdy,pos),ip,sfac, & + & offs) + ELSE + CALL ncpack(vnm,dims,bgct_bur(1-nbdy,1-nbdy,pos),ip,1, & + & sfac,offs) + ENDIF + ELSEIF (frmt.EQ.4) THEN + IF (cmpflg.EQ.1) THEN + CALL nccomp(vnm,dims,bgct_bur(1-nbdy,1-nbdy,pos),ip,sfac, & + & offs,4) + ELSE + CALL ncwrtr(vnm,dims,bgct_bur(1-nbdy,1-nbdy,pos),ip,1, & + & sfac,offs,4) + ENDIF + ELSEIF (frmt.EQ.8) THEN + IF (cmpflg.EQ.1) THEN + CALL nccomp(vnm,dims,bgct_bur(1-nbdy,1-nbdy,pos),ip,sfac, & + & offs,8) + ELSE + CALL ncwrtr(vnm,dims,bgct_bur(1-nbdy,1-nbdy,pos),ip,1, & + & sfac,offs,8) + ENDIF + ELSE + STOP 'unknown output format ' + ENDIF + ! + END SUBROUTINE wrtbur + + + + SUBROUTINE logsrf(pos,sfac,offs) + ! + ! --- ------------------------------------------------------------------ + ! --- Description: replace 2d field with log10(field) + ! --- + ! --- Arguments: + ! --- int pos (in) : field position in layer buffer + ! --- real sfac (in) : scale factor to be applied before log10 + ! --- real offs (in) : offset to be added before log10 + ! --- ------------------------------------------------------------------ + ! + IMPLICIT NONE + ! + REAL ::sfac,offs + INTEGER :: pos + ! + INTEGER :: i,j,l + REAL ::epsil=1e-11 + ! + ! --- Check whether field should be processed + IF (pos.EQ.0) RETURN + ! + !$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)) + IF (bgcm2d(i,j,pos).LT.epsil) THEN + bgcm2d(i,j,pos)=0. + ELSE + bgcm2d(i,j,pos)=log10(bgcm2d(i,j,pos)*sfac+offs) + ENDIF + ENDDO + ENDDO + ENDDO + !$OMP END PARALLEL DO + ! + END SUBROUTINE logsrf + + + + SUBROUTINE loglyr(pos,sfac,offs) + ! + ! --- ------------------------------------------------------------------ + ! --- Description: replace layer field with log10(field) + ! --- + ! --- Arguments: + ! --- int pos (in) : field position in layer buffer + ! --- real sfac (in) : scale factor to be applied before log10 + ! --- real offs (in) : offset to be added before log10 + ! --- ------------------------------------------------------------------ + ! + IMPLICIT NONE + ! + REAL ::sfac,offs + INTEGER :: pos + ! + INTEGER :: i,j,k,l + REAL ::epsil=1e-11 + ! + ! --- Check whether field should be processed + IF (pos.EQ.0) RETURN + ! + DO k=1,kdm + !$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)) - IF (bgcm2d(i,j,pos).LT.epsil) THEN - bgcm2d(i,j,pos)=0. - ELSE - bgcm2d(i,j,pos)=log10(bgcm2d(i,j,pos)*sfac+offs) + IF (bgcm3d(i,j,k,pos).LT.epsil) THEN + bgcm3d(i,j,k,pos)=0. + ELSEIF (bgcm3d(i,j,k,pos).NE.nf90_fill_double) THEN + bgcm3d(i,j,k,pos)=log10(bgcm3d(i,j,k,pos)*sfac+offs) ENDIF ENDDO ENDDO ENDDO -!$OMP END PARALLEL DO -! - END SUBROUTINE logsrf - - - - SUBROUTINE loglyr(pos,sfac,offs) -! -! --- ------------------------------------------------------------------ -! --- Description: replace layer field with log10(field) -! --- -! --- Arguments: -! --- int pos (in) : field position in layer buffer -! --- real sfac (in) : scale factor to be applied before log10 -! --- real offs (in) : offset to be added before log10 -! --- ------------------------------------------------------------------ -! - IMPLICIT NONE -! - REAL ::sfac,offs - INTEGER :: pos -! - INTEGER :: i,j,k,l - REAL ::epsil=1e-11 -! -! --- Check whether field should be processed - IF (pos.EQ.0) RETURN -! - DO k=1,kdm -!$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)) - IF (bgcm3d(i,j,k,pos).LT.epsil) THEN - bgcm3d(i,j,k,pos)=0. - ELSEIF (bgcm3d(i,j,k,pos).NE.nf90_fill_double) THEN - bgcm3d(i,j,k,pos)=log10(bgcm3d(i,j,k,pos)*sfac+offs) - ENDIF - ENDDO + !$OMP END PARALLEL DO + ENDDO + ! + END SUBROUTINE loglyr + + + + SUBROUTINE loglvl(pos,sfac,offs) + ! + ! --- ------------------------------------------------------------------ + ! --- Description: replace level field with log10(field) + ! --- + ! --- Arguments: + ! --- int pos (in) : field position in layer buffer + ! --- real sfac (in) : scale factor to be applied before log10 + ! --- real offs (in) : offset to be added before log10 + ! --- ------------------------------------------------------------------ + ! + IMPLICIT NONE + ! + REAL ::sfac,offs + INTEGER :: pos + ! + INTEGER :: i,j,k,l + REAL ::epsil=1e-11 + ! + ! --- Check whether field should be processed + IF (pos.EQ.0) RETURN + ! + DO k=1,ddm + !$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)) + IF (bgcm3dlvl(i,j,k,pos).LT.epsil) THEN + bgcm3dlvl(i,j,k,pos)=0. + ELSEIF (bgcm3dlvl(i,j,k,pos).NE.nf90_fill_double) THEN + bgcm3dlvl(i,j,k,pos)=log10(bgcm3dlvl(i,j,k,pos)*sfac+ & + & offs) + ENDIF ENDDO ENDDO -!$OMP END PARALLEL DO - ENDDO -! - END SUBROUTINE loglyr - - - - SUBROUTINE loglvl(pos,sfac,offs) -! -! --- ------------------------------------------------------------------ -! --- Description: replace level field with log10(field) -! --- -! --- Arguments: -! --- int pos (in) : field position in layer buffer -! --- real sfac (in) : scale factor to be applied before log10 -! --- real offs (in) : offset to be added before log10 -! --- ------------------------------------------------------------------ -! - IMPLICIT NONE -! - REAL ::sfac,offs - INTEGER :: pos -! - INTEGER :: i,j,k,l - REAL ::epsil=1e-11 -! -! --- Check whether field should be processed - IF (pos.EQ.0) RETURN -! - DO k=1,ddm -!$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)) - IF (bgcm3dlvl(i,j,k,pos).LT.epsil) THEN - bgcm3dlvl(i,j,k,pos)=0. - ELSEIF (bgcm3dlvl(i,j,k,pos).NE.nf90_fill_double) THEN - bgcm3dlvl(i,j,k,pos)=log10(bgcm3dlvl(i,j,k,pos)*sfac+ & - & offs) - ENDIF - ENDDO + ENDDO + !$OMP END PARALLEL DO + ENDDO + ! + END SUBROUTINE loglvl + + + + SUBROUTINE logsdm(pos,sfac,offs) + ! + ! --- ------------------------------------------------------------------ + ! --- Description: replace sediment field with log10(field) + ! --- + ! --- Arguments: + ! --- int pos (in) : field position in layer buffer + ! --- real sfac (in) : scale factor to be applied before log10 + ! --- real offs (in) : offset to be added before log10 + ! --- ------------------------------------------------------------------ + ! + IMPLICIT NONE + ! + REAL ::sfac,offs + INTEGER :: pos + ! + INTEGER :: i,j,k,l + REAL ::epsil=1e-11 + ! + ! --- Check whether field should be processed + IF (pos.EQ.0) RETURN + ! + DO k=1,ks + !$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)) + IF (bgct_sed(i,j,k,pos).LT.epsil) THEN + bgct_sed(i,j,k,pos)=0. + ELSE + bgct_sed(i,j,k,pos)=log10(bgct_sed(i,j,k,pos)*sfac+offs) + ENDIF ENDDO ENDDO -!$OMP END PARALLEL DO ENDDO -! - END SUBROUTINE loglvl - - - - SUBROUTINE logsdm(pos,sfac,offs) -! -! --- ------------------------------------------------------------------ -! --- Description: replace sediment field with log10(field) -! --- -! --- Arguments: -! --- int pos (in) : field position in layer buffer -! --- real sfac (in) : scale factor to be applied before log10 -! --- real offs (in) : offset to be added before log10 -! --- ------------------------------------------------------------------ -! - IMPLICIT NONE -! - REAL ::sfac,offs - INTEGER :: pos -! - INTEGER :: i,j,k,l - REAL ::epsil=1e-11 -! -! --- Check whether field should be processed - IF (pos.EQ.0) RETURN -! - DO k=1,ks -!$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)) - IF (bgct_sed(i,j,k,pos).LT.epsil) THEN - bgct_sed(i,j,k,pos)=0. - ELSE - bgct_sed(i,j,k,pos)=log10(bgct_sed(i,j,k,pos)*sfac+offs) - ENDIF - ENDDO - ENDDO + !$OMP END PARALLEL DO + ENDDO + ! + END SUBROUTINE logsdm + + + SUBROUTINE msksrf(pos,idepth) + ! + ! --- ------------------------------------------------------------------ + ! --- Description: set sea floor points to NaN in mass flux fields + ! --- + ! --- Arguments: + ! --- int pos (in) : field position in level buffer + ! --- int idepth (in) : k-index field used to define the + ! --- depth surface + ! --- ------------------------------------------------------------------ + ! + IMPLICIT NONE + ! + INTEGER :: pos + INTEGER, DIMENSION(idm,jdm) :: idepth + ! + INTEGER :: i,j,l + REAL, parameter :: mskval=nf90_fill_double + ! + ! --- Check whether field should be initia + IF (pos.EQ.0) RETURN + ! + !$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)) + if( idepth(i,j) <= 0 ) bgcm2d(i,j,pos)=mskval ENDDO -!$OMP END PARALLEL DO ENDDO -! - END SUBROUTINE logsdm - - - SUBROUTINE msksrf(pos,idepth) -! -! --- ------------------------------------------------------------------ -! --- Description: set sea floor points to NaN in mass flux fields -! --- -! --- Arguments: -! --- int pos (in) : field position in level buffer -! --- int idepth (in) : k-index field used to define the -! --- depth surface -! --- ------------------------------------------------------------------ -! - IMPLICIT NONE -! - INTEGER :: pos - INTEGER, DIMENSION(idm,jdm) :: idepth -! - INTEGER :: i,j,l - REAL, parameter :: mskval=nf90_fill_double -! -! --- Check whether field should be initia - IF (pos.EQ.0) RETURN -! -!$OMP PARALLEL DO PRIVATE(l,i) + ENDDO + !$OMP END PARALLEL DO + ! + END SUBROUTINE msksrf + + + SUBROUTINE msklvl(pos,depths) + ! + ! --- ------------------------------------------------------------------ + ! --- Description: set sea floor points to NaN in level fields + ! --- + ! --- Arguments: + ! --- int pos (in) : field position in level buffer + ! --- int depths (in) : bathymetry field + ! --- ------------------------------------------------------------------ + ! + IMPLICIT NONE + ! + INTEGER :: pos + REAL, DIMENSION(1-nbdy:idm+nbdy,1-nbdy:jdm+nbdy) :: depths + ! + INTEGER :: i,j,k,l + LOGICAL :: iniflg=.true. + INTEGER, DIMENSION(idm,jdm) :: kmax + REAL, parameter :: mskval=nf90_fill_double + ! + SAVE iniflg,kmax + ! + ! --- Check whether field should be processed + IF (pos.EQ.0) RETURN + ! + ! --- Prepare index fields for masking + + IF (iniflg) THEN + !$OMP PARALLEL DO PRIVATE(i) DO j=1,jj - DO l=1,isp(j) - DO i=max(1,ifp(j,l)),min(ii,ilp(j,l)) - if( idepth(i,j) <= 0 ) bgcm2d(i,j,pos)=mskval - ENDDO + DO i=1,ii + kmax(i,j)=0 ENDDO ENDDO -!$OMP END PARALLEL DO -! - END SUBROUTINE msksrf - - - SUBROUTINE msklvl(pos,depths) -! -! --- ------------------------------------------------------------------ -! --- Description: set sea floor points to NaN in level fields -! --- -! --- Arguments: -! --- int pos (in) : field position in level buffer -! --- int depths (in) : bathymetry field -! --- ------------------------------------------------------------------ -! - IMPLICIT NONE -! - INTEGER :: pos - REAL, DIMENSION(1-nbdy:idm+nbdy,1-nbdy:jdm+nbdy) :: depths -! - INTEGER :: i,j,k,l - LOGICAL :: iniflg=.true. - INTEGER, DIMENSION(idm,jdm) :: kmax - REAL, parameter :: mskval=nf90_fill_double -! - SAVE iniflg,kmax -! -! --- Check whether field should be processed - IF (pos.EQ.0) RETURN -! -! --- Prepare index fields for masking - - IF (iniflg) THEN -!$OMP PARALLEL DO PRIVATE(i) + !$OMP END PARALLEL DO + DO k=1,ddm + !$OMP PARALLEL DO PRIVATE(i) DO j=1,jj DO i=1,ii - kmax(i,j)=0 + IF (depths(i,j).GT.depthslev_bnds(1,k)) kmax(i,j)=k ENDDO ENDDO -!$OMP END PARALLEL DO - DO k=1,ddm -!$OMP PARALLEL DO PRIVATE(i) - DO j=1,jj - DO i=1,ii - IF (depths(i,j).GT.depthslev_bnds(1,k)) kmax(i,j)=k + !$OMP END PARALLEL DO + ENDDO + iniflg=.false. + ENDIF + ! + !$OMP PARALLEL DO PRIVATE(i,k) + DO j=1,jj + DO i=1,ii + DO k=kmax(i,j)+1,ddm + bgcm3dlvl(i,j,k,pos)=mskval + ENDDO + ENDDO + ENDDO + !$OMP END PARALLEL DO + ! + END SUBROUTINE msklvl + + + + SUBROUTINE bgczlv(pddpo,kin,ind1,ind2,weights) + !----------------------------------------------------------------------- + ! + ! + IMPLICIT NONE + ! + INTEGER :: d,i,j,k,l,kin + INTEGER, DIMENSION(idm,jdm) :: ind1,ind2 + ! + REAL, PARAMETER :: eps=1e-10 + REAL, DIMENSION(idm,jdm,kdm) :: pddpo,ztop,zbot + REAL, DIMENSION(idm,jdm,ddm) :: weights,dlev + ! + LOGICAL :: iniflg=.true. + ! + SAVE ztop,zbot,dlev,iniflg + ! + ! --- Adjust bounds of levitus levels according to model bathymetry + IF (iniflg) THEN + DO d=1,ddm + !$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)) + dlev(i,j,d)=max(eps,min(pbath(i,j), & + & depthslev_bnds(2,d))-depthslev_bnds(1,d)) ENDDO ENDDO -!$OMP END PARALLEL DO ENDDO - iniflg=.false. - ENDIF -! -!$OMP PARALLEL DO PRIVATE(i,k) + !$OMP END PARALLEL DO + ENDDO + iniflg=.false. + ENDIF + ! + ! --- Compute top and bottom depths of density layers + IF (kin.EQ.1) THEN + !$OMP PARALLEL DO PRIVATE(l,i) DO j=1,jj - DO i=1,ii - DO k=kmax(i,j)+1,ddm - bgcm3dlvl(i,j,k,pos)=mskval + DO l=1,isp(j) + DO i=max(1,ifp(j,l)),min(ii,ilp(j,l)) + zbot(i,j,1)=pddpo(i,j,1) ENDDO ENDDO ENDDO -!$OMP END PARALLEL DO -! - END SUBROUTINE msklvl - - - - SUBROUTINE bgczlv(pddpo,kin,ind1,ind2,weights) -!----------------------------------------------------------------------- -! -! - IMPLICIT NONE -! - INTEGER :: d,i,j,k,l,kin - INTEGER, DIMENSION(idm,jdm) :: ind1,ind2 -! - REAL, PARAMETER :: eps=1e-10 - REAL, DIMENSION(idm,jdm,kdm) :: pddpo,ztop,zbot - REAL, DIMENSION(idm,jdm,ddm) :: weights,dlev -! - LOGICAL :: iniflg=.true. -! - SAVE ztop,zbot,dlev,iniflg -! -! --- Adjust bounds of levitus levels according to model bathymetry - IF (iniflg) THEN - DO d=1,ddm -!$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)) - dlev(i,j,d)=max(eps,min(pbath(i,j), & - & depthslev_bnds(2,d))-depthslev_bnds(1,d)) - ENDDO - ENDDO - ENDDO -!$OMP END PARALLEL DO - ENDDO - iniflg=.false. - ENDIF -! -! --- Compute top and bottom depths of density layers - IF (kin.EQ.1) THEN -!$OMP PARALLEL DO PRIVATE(l,i) + !$OMP END PARALLEL DO + DO k=2,kk + !$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)) - zbot(i,j,1)=pddpo(i,j,1) + zbot(i,j,k)=zbot(i,j,k-1)+pddpo(i,j,k) ENDDO ENDDO ENDDO -!$OMP END PARALLEL DO - DO k=2,kk -!$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)) - zbot(i,j,k)=zbot(i,j,k-1)+pddpo(i,j,k) - ENDDO - ENDDO + !$OMP END PARALLEL DO + ENDDO + !$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)) + zbot(i,j,1)=zbot(i,j,1)*pbath(i,j)/zbot(i,j,kk) + ztop(i,j,1)=0. + ind1(i,j)=1 ENDDO -!$OMP END PARALLEL DO ENDDO -!$OMP PARALLEL DO PRIVATE(l,i) + ENDDO + !$OMP END PARALLEL DO + DO k=2,kk + !$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)) - zbot(i,j,1)=zbot(i,j,1)*pbath(i,j)/zbot(i,j,kk) - ztop(i,j,1)=0. - ind1(i,j)=1 + zbot(i,j,k)=zbot(i,j,k)*pbath(i,j)/zbot(i,j,kk) + ztop(i,j,k)=zbot(i,j,k-1) ENDDO ENDDO ENDDO -!$OMP END PARALLEL DO - DO k=2,kk -!$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)) - zbot(i,j,k)=zbot(i,j,k)*pbath(i,j)/zbot(i,j,kk) - ztop(i,j,k)=zbot(i,j,k-1) - ENDDO + !$OMP END PARALLEL DO + ENDDO + ENDIF + ! + ! --- Compute interpolation weights + !$OMP PARALLEL DO PRIVATE(l,i,d) + DO j=1,jj + DO l=1,isp(j) + DO i=max(1,ifp(j,l)),min(ii,ilp(j,l)) + ind2(i,j)=0 + IF (pddpo(i,j,kin).GT.eps) THEN + DO d=ind1(i,j),ddm + IF (depthslev_bnds(2,d).LE.ztop(i,j,kin)) THEN + ind1(i,j)=d+1 + CYCLE + ELSEIF (depthslev_bnds(1,d).GE.zbot(i,j,kin)) THEN + EXIT + ENDIF + ind2(i,j)=d + weights(i,j,d)=(min(zbot(i,j,kin), & + & depthslev_bnds(2,d))-max(ztop(i,j,kin), & + & depthslev_bnds(1,d)))/dlev(i,j,d) ENDDO - ENDDO -!$OMP END PARALLEL DO - ENDDO - ENDIF -! -! --- Compute interpolation weights -!$OMP PARALLEL DO PRIVATE(l,i,d) - DO j=1,jj - DO l=1,isp(j) - DO i=max(1,ifp(j,l)),min(ii,ilp(j,l)) - ind2(i,j)=0 - IF (pddpo(i,j,kin).GT.eps) THEN - DO d=ind1(i,j),ddm - IF (depthslev_bnds(2,d).LE.ztop(i,j,kin)) THEN - ind1(i,j)=d+1 - CYCLE - ELSEIF (depthslev_bnds(1,d).GE.zbot(i,j,kin)) THEN - EXIT - ENDIF - ind2(i,j)=d - weights(i,j,d)=(min(zbot(i,j,kin), & - & depthslev_bnds(2,d))-max(ztop(i,j,kin), & - & depthslev_bnds(1,d)))/dlev(i,j,d) - ENDDO - ENDIF - ENDDO + ENDIF ENDDO ENDDO -!$OMP END PARALLEL DO -! - END SUBROUTINE bgczlv + ENDDO + !$OMP END PARALLEL DO + ! + END SUBROUTINE bgczlv - END MODULE mo_bgcmean +END MODULE mo_bgcmean diff --git a/hamocc/mo_biomod.F90 b/hamocc/mo_biomod.F90 index c56ad068..9f023a28 100644 --- a/hamocc/mo_biomod.F90 +++ b/hamocc/mo_biomod.F90 @@ -4,359 +4,359 @@ ! 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_biomod -!****************************************************************************** -! -! MODULE mo_biomod - Variables for marine biology. -! -! S.Legutke, *MPI-MaD, HH* 31.10.01 -! -! Modified -! -------- -! -! I. Kriest, GEOMAR, 11.08.2016 -! - included T-dependence of cyanobacteria growth -! - modified stoichiometry for denitrification -! -! J.Schwinger, *Uni Research, Bergen* 2018-04-12 -! - moved accumulation of all output fields to seperate subroutine, -! new global fields for output defined here -! -! Purpose -! ------- -! - declaration and memory allocation. -! -! Description: -! ------------ -! Public routines and variable of this module: -! -! -subroutine alloc_mem_biomod -! Allocate memory for biomod variables -! -! -!****************************************************************************** - implicit none - - REAL, DIMENSION (:,:), ALLOCATABLE :: strahl - REAL, DIMENSION (:,:), ALLOCATABLE :: expoor - REAL, DIMENSION (:,:), ALLOCATABLE :: expoca - REAL, DIMENSION (:,:), ALLOCATABLE :: exposi - REAL, DIMENSION (:,:), ALLOCATABLE :: intphosy - REAL, DIMENSION (:,:), ALLOCATABLE :: intdnit - REAL, DIMENSION (:,:), ALLOCATABLE :: intnfix - REAL, DIMENSION (:,:), ALLOCATABLE :: intdmsprod - REAL, DIMENSION (:,:), ALLOCATABLE :: intdms_bac - REAL, DIMENSION (:,:), ALLOCATABLE :: intdms_uv - REAL, DIMENSION (:,:), ALLOCATABLE :: carflx0100 - REAL, DIMENSION (:,:), ALLOCATABLE :: carflx0500 - REAL, DIMENSION (:,:), ALLOCATABLE :: carflx1000 - REAL, DIMENSION (:,:), ALLOCATABLE :: carflx2000 - REAL, DIMENSION (:,:), ALLOCATABLE :: carflx4000 - REAL, DIMENSION (:,:), ALLOCATABLE :: carflx_bot - REAL, DIMENSION (:,:), ALLOCATABLE :: bsiflx0100 - REAL, DIMENSION (:,:), ALLOCATABLE :: bsiflx0500 - REAL, DIMENSION (:,:), ALLOCATABLE :: bsiflx1000 - REAL, DIMENSION (:,:), ALLOCATABLE :: bsiflx2000 - REAL, DIMENSION (:,:), ALLOCATABLE :: bsiflx4000 - REAL, DIMENSION (:,:), ALLOCATABLE :: bsiflx_bot - REAL, DIMENSION (:,:), ALLOCATABLE :: calflx0100 - REAL, DIMENSION (:,:), ALLOCATABLE :: calflx0500 - REAL, DIMENSION (:,:), ALLOCATABLE :: calflx1000 - REAL, DIMENSION (:,:), ALLOCATABLE :: calflx2000 - REAL, DIMENSION (:,:), ALLOCATABLE :: calflx4000 - REAL, DIMENSION (:,:), ALLOCATABLE :: calflx_bot - REAL, DIMENSION (:,:,:), ALLOCATABLE :: phosy3d - - ! Variables for interactive phytoplanktion absorption (use_FB_BGC_OCE=.true.) - REAL, DIMENSION (:,:,:), ALLOCATABLE :: abs_oce - - ! Variables for aggregation scheme (use_AGG=.true.) - REAL, DIMENSION (:,:,:), ALLOCATABLE :: wmass - REAL, DIMENSION (:,:,:), ALLOCATABLE :: wnumb - REAL, DIMENSION (:,:,:), ALLOCATABLE :: eps3d - REAL, DIMENSION (:,:,:), ALLOCATABLE :: asize3d - - ! Variables for bromoform scheme (use_BROMO=.true.) - REAL, DIMENSION (:,:), ALLOCATABLE :: int_chbr3_prod - REAL, DIMENSION (:,:), ALLOCATABLE :: int_chbr3_uv - - REAL :: growth_co2,bifr13_perm - - - 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 - - - IF (mnproc.eq.1) THEN +MODULE mo_biomod + !****************************************************************************** + ! + ! MODULE mo_biomod - Variables for marine biology. + ! + ! S.Legutke, *MPI-MaD, HH* 31.10.01 + ! + ! Modified + ! -------- + ! + ! I. Kriest, GEOMAR, 11.08.2016 + ! - included T-dependence of cyanobacteria growth + ! - modified stoichiometry for denitrification + ! + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - moved accumulation of all output fields to seperate subroutine, + ! new global fields for output defined here + ! + ! Purpose + ! ------- + ! - declaration and memory allocation. + ! + ! Description: + ! ------------ + ! Public routines and variable of this module: + ! + ! -subroutine alloc_mem_biomod + ! Allocate memory for biomod variables + ! + ! + !****************************************************************************** + implicit none + + REAL, DIMENSION (:,:), ALLOCATABLE :: strahl + REAL, DIMENSION (:,:), ALLOCATABLE :: expoor + REAL, DIMENSION (:,:), ALLOCATABLE :: expoca + REAL, DIMENSION (:,:), ALLOCATABLE :: exposi + REAL, DIMENSION (:,:), ALLOCATABLE :: intphosy + REAL, DIMENSION (:,:), ALLOCATABLE :: intdnit + REAL, DIMENSION (:,:), ALLOCATABLE :: intnfix + REAL, DIMENSION (:,:), ALLOCATABLE :: intdmsprod + REAL, DIMENSION (:,:), ALLOCATABLE :: intdms_bac + REAL, DIMENSION (:,:), ALLOCATABLE :: intdms_uv + REAL, DIMENSION (:,:), ALLOCATABLE :: carflx0100 + REAL, DIMENSION (:,:), ALLOCATABLE :: carflx0500 + REAL, DIMENSION (:,:), ALLOCATABLE :: carflx1000 + REAL, DIMENSION (:,:), ALLOCATABLE :: carflx2000 + REAL, DIMENSION (:,:), ALLOCATABLE :: carflx4000 + REAL, DIMENSION (:,:), ALLOCATABLE :: carflx_bot + REAL, DIMENSION (:,:), ALLOCATABLE :: bsiflx0100 + REAL, DIMENSION (:,:), ALLOCATABLE :: bsiflx0500 + REAL, DIMENSION (:,:), ALLOCATABLE :: bsiflx1000 + REAL, DIMENSION (:,:), ALLOCATABLE :: bsiflx2000 + REAL, DIMENSION (:,:), ALLOCATABLE :: bsiflx4000 + REAL, DIMENSION (:,:), ALLOCATABLE :: bsiflx_bot + REAL, DIMENSION (:,:), ALLOCATABLE :: calflx0100 + REAL, DIMENSION (:,:), ALLOCATABLE :: calflx0500 + REAL, DIMENSION (:,:), ALLOCATABLE :: calflx1000 + REAL, DIMENSION (:,:), ALLOCATABLE :: calflx2000 + REAL, DIMENSION (:,:), ALLOCATABLE :: calflx4000 + REAL, DIMENSION (:,:), ALLOCATABLE :: calflx_bot + REAL, DIMENSION (:,:,:), ALLOCATABLE :: phosy3d + + ! Variables for interactive phytoplanktion absorption (use_FB_BGC_OCE=.true.) + REAL, DIMENSION (:,:,:), ALLOCATABLE :: abs_oce + + ! Variables for aggregation scheme (use_AGG=.true.) + REAL, DIMENSION (:,:,:), ALLOCATABLE :: wmass + REAL, DIMENSION (:,:,:), ALLOCATABLE :: wnumb + REAL, DIMENSION (:,:,:), ALLOCATABLE :: eps3d + REAL, DIMENSION (:,:,:), ALLOCATABLE :: asize3d + + ! Variables for bromoform scheme (use_BROMO=.true.) + REAL, DIMENSION (:,:), ALLOCATABLE :: int_chbr3_prod + REAL, DIMENSION (:,:), ALLOCATABLE :: int_chbr3_uv + + REAL :: growth_co2,bifr13_perm + + +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 + + + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)' ' WRITE(io_stdo_bgc,*)'***************************************************' WRITE(io_stdo_bgc,*)'Memory allocation for marine biology module :' WRITE(io_stdo_bgc,*)' ' - ENDIF + ENDIF - IF (mnproc.eq.1) THEN + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable strahl ...' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF + ENDIF - ALLOCATE (strahl(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory strahl' - strahl(:,:) = 0.0 + ALLOCATE (strahl(kpie,kpje),stat=errstat) + 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 + 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 - 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 + endif - IF (mnproc.eq.1) THEN + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable expoor ...' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF + ENDIF - ALLOCATE (expoor(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory expoor' - expoor(:,:) = 0.0 + ALLOCATE (expoor(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory expoor' + expoor(:,:) = 0.0 - IF (mnproc.eq.1) THEN + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable expoca ...' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF + ENDIF - ALLOCATE (expoca(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory expoca' - expoca(:,:) = 0.0 + ALLOCATE (expoca(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory expoca' + expoca(:,:) = 0.0 - IF (mnproc.eq.1) THEN + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable exposi ...' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF + ENDIF - ALLOCATE (exposi(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory exposi' - exposi(:,:) = 0.0 + ALLOCATE (exposi(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory exposi' + exposi(:,:) = 0.0 - IF (mnproc.eq.1) THEN + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable intphosy ...' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF + ENDIF - ALLOCATE (intphosy(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory intphosy' - intphosy(:,:) = 0.0 + ALLOCATE (intphosy(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory intphosy' + intphosy(:,:) = 0.0 - IF (mnproc.eq.1) THEN + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable intdnit ...' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF + ENDIF - ALLOCATE (intdnit(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory intdnit' - intdnit(:,:) = 0.0 + ALLOCATE (intdnit(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory intdnit' + intdnit(:,:) = 0.0 - IF (mnproc.eq.1) THEN + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable intnfix ...' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF + ENDIF - ALLOCATE (intnfix(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory intnfix' - intnfix(:,:) = 0.0 + ALLOCATE (intnfix(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory intnfix' + intnfix(:,:) = 0.0 - IF (mnproc.eq.1) THEN + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable intdmsprod, intdms_bac, intdms_uv ...' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF + ENDIF - ALLOCATE (intdmsprod(kpie,kpje),stat=errstat) - ALLOCATE (intdms_bac(kpie,kpje),stat=errstat) - ALLOCATE (intdms_uv(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory intdmsprod, intdms_bac, intdms_uv' - intdmsprod(:,:) = 0.0 - intdms_bac(:,:) = 0.0 - intdms_uv(:,:) = 0.0 + ALLOCATE (intdmsprod(kpie,kpje),stat=errstat) + ALLOCATE (intdms_bac(kpie,kpje),stat=errstat) + ALLOCATE (intdms_uv(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory intdmsprod, intdms_bac, intdms_uv' + intdmsprod(:,:) = 0.0 + intdms_bac(:,:) = 0.0 + intdms_uv(:,:) = 0.0 - IF (mnproc.eq.1) THEN + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable carflx* ...' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF - - ALLOCATE (carflx0100(kpie,kpje),stat=errstat) - ALLOCATE (carflx0500(kpie,kpje),stat=errstat) - ALLOCATE (carflx1000(kpie,kpje),stat=errstat) - ALLOCATE (carflx2000(kpie,kpje),stat=errstat) - ALLOCATE (carflx4000(kpie,kpje),stat=errstat) - ALLOCATE (carflx_bot(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory carflx*' - carflx0100(:,:) = 0.0 - carflx0500(:,:) = 0.0 - carflx1000(:,:) = 0.0 - carflx2000(:,:) = 0.0 - carflx4000(:,:) = 0.0 - carflx_bot(:,:) = 0.0 - - - IF (mnproc.eq.1) THEN + ENDIF + + ALLOCATE (carflx0100(kpie,kpje),stat=errstat) + ALLOCATE (carflx0500(kpie,kpje),stat=errstat) + ALLOCATE (carflx1000(kpie,kpje),stat=errstat) + ALLOCATE (carflx2000(kpie,kpje),stat=errstat) + ALLOCATE (carflx4000(kpie,kpje),stat=errstat) + ALLOCATE (carflx_bot(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory carflx*' + carflx0100(:,:) = 0.0 + carflx0500(:,:) = 0.0 + carflx1000(:,:) = 0.0 + carflx2000(:,:) = 0.0 + carflx4000(:,:) = 0.0 + carflx_bot(:,:) = 0.0 + + + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable bsiflx* ...' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + ENDIF + + ALLOCATE (bsiflx0100(kpie,kpje),stat=errstat) + ALLOCATE (bsiflx0500(kpie,kpje),stat=errstat) + ALLOCATE (bsiflx1000(kpie,kpje),stat=errstat) + ALLOCATE (bsiflx2000(kpie,kpje),stat=errstat) + ALLOCATE (bsiflx4000(kpie,kpje),stat=errstat) + ALLOCATE (bsiflx_bot(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory bsiflx*' + bsiflx0100(:,:) = 0.0 + bsiflx0500(:,:) = 0.0 + bsiflx1000(:,:) = 0.0 + bsiflx2000(:,:) = 0.0 + bsiflx4000(:,:) = 0.0 + bsiflx_bot(:,:) = 0.0 + + + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable calflx* ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + ENDIF + + ALLOCATE (calflx0100(kpie,kpje),stat=errstat) + ALLOCATE (calflx0500(kpie,kpje),stat=errstat) + ALLOCATE (calflx1000(kpie,kpje),stat=errstat) + ALLOCATE (calflx2000(kpie,kpje),stat=errstat) + ALLOCATE (calflx4000(kpie,kpje),stat=errstat) + ALLOCATE (calflx_bot(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory bsiflx*' + calflx0100(:,:) = 0.0 + calflx0500(:,:) = 0.0 + calflx1000(:,:) = 0.0 + calflx2000(:,:) = 0.0 + calflx4000(:,:) = 0.0 + calflx_bot(:,:) = 0.0 + + + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable phosy3d ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',kpke + ENDIF + + ALLOCATE (phosy3d(kpie,kpje,kpke),stat=errstat) + if(errstat.ne.0) stop 'not enough memory phosy3d' + phosy3d(:,:,:) = 0.0 + + 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 (bsiflx0100(kpie,kpje),stat=errstat) - ALLOCATE (bsiflx0500(kpie,kpje),stat=errstat) - ALLOCATE (bsiflx1000(kpie,kpje),stat=errstat) - ALLOCATE (bsiflx2000(kpie,kpje),stat=errstat) - ALLOCATE (bsiflx4000(kpie,kpje),stat=errstat) - ALLOCATE (bsiflx_bot(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory bsiflx*' - bsiflx0100(:,:) = 0.0 - bsiflx0500(:,:) = 0.0 - bsiflx1000(:,:) = 0.0 - bsiflx2000(:,:) = 0.0 - bsiflx4000(:,:) = 0.0 - bsiflx_bot(:,:) = 0.0 + 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 calflx* ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + 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 (calflx0100(kpie,kpje),stat=errstat) - ALLOCATE (calflx0500(kpie,kpje),stat=errstat) - ALLOCATE (calflx1000(kpie,kpje),stat=errstat) - ALLOCATE (calflx2000(kpie,kpje),stat=errstat) - ALLOCATE (calflx4000(kpie,kpje),stat=errstat) - ALLOCATE (calflx_bot(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory bsiflx*' - calflx0100(:,:) = 0.0 - calflx0500(:,:) = 0.0 - calflx1000(:,:) = 0.0 - calflx2000(:,:) = 0.0 - calflx4000(:,:) = 0.0 - calflx_bot(:,:) = 0.0 + 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 + + if (use_BROMO) then IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable phosy3d ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',kpke + 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 (phosy3d(kpie,kpje,kpke),stat=errstat) - if(errstat.ne.0) stop 'not enough memory phosy3d' - phosy3d(:,:,:) = 0.0 - - 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 - endif - - 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 - endif - -!****************************************************************************** - END SUBROUTINE ALLOC_MEM_BIOMOD - - END MODULE mo_biomod + 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 + + !****************************************************************************** + END SUBROUTINE ALLOC_MEM_BIOMOD + +END MODULE mo_biomod diff --git a/hamocc/mo_boxatm.F90 b/hamocc/mo_boxatm.F90 index fa3a50ac..17ea61ff 100644 --- a/hamocc/mo_boxatm.F90 +++ b/hamocc/mo_boxatm.F90 @@ -18,152 +18,152 @@ module mo_boxatm -!****************************************************************************** -! A. Moree, *GFI, Bergen* Oct 2019 -! -! -! Modified -! -------- -! 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 -! - ported into NorESM2 code, no functional changes -! -! -! Purpose -! ------- -! - 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 -! production term corresponding to the total decay in the ocean (plus sediment -! if activated) is assumed. -! -! -!****************************************************************************** + !****************************************************************************** + ! A. Moree, *GFI, Bergen* Oct 2019 + ! + ! + ! Modified + ! -------- + ! 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 + ! - ported into NorESM2 code, no functional changes + ! + ! + ! Purpose + ! ------- + ! - 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 + ! production term corresponding to the total decay in the ocean (plus sediment + ! if activated) is assumed. + ! + ! + !****************************************************************************** contains -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_cisonew, use_sedbypass - use mo_carbch, only: atmflx, atm, ocetra - use mo_param_bgc, only: rcar,c14dec - use mo_param1_bgc, only: iatmco2,iatmc13,iatmc14,isco214,idet14,icalc14,idoc14, & - iphy14,izoo14,ipowc14,issso14,isssc14 - use mo_sedmnt, only: powtra,sedlay,seddw,porwat,porsol - - 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, 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 - 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] - ztmp1(:,:) = 0.0 - DO j=1,kpje - DO i=1,kpie - ztmp1(i,j) = atmflx(i,j,iatmco2)*pdlxp(i,j)*pdlyp(i,j) ![kmol CO2/ m2] * [m] * [m] - ENDDO - ENDDO - - CALL xcsum(co2flux,ztmp1,ips) - - ! Convert global CO2 flux to ppm - co2flux_ppm = co2flux*12.*1.e-12*pg2ppm ! [kmol C] -> [ppm] - - ! Update atmospheric pCO2 - DO j=1,kpje - DO i=1,kpie - atm(i,j,iatmco2)=atm(i,j,iatmco2) + co2flux_ppm - ENDDO - ENDDO - - 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) - 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 + 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_cisonew, use_sedbypass + use mo_carbch, only: atmflx, atm, ocetra + use mo_param_bgc, only: rcar,c14dec + use mo_param1_bgc, only: iatmco2,iatmc13,iatmc14,isco214,idet14,icalc14,idoc14, & + iphy14,izoo14,ipowc14,issso14,isssc14 + use mo_sedmnt, only: powtra,sedlay,seddw,porwat,porsol + + 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, 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 + 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] + ztmp1(:,:) = 0.0 + DO j=1,kpje + DO i=1,kpie + ztmp1(i,j) = atmflx(i,j,iatmco2)*pdlxp(i,j)*pdlyp(i,j) ![kmol CO2/ m2] * [m] * [m] + ENDDO + ENDDO + + CALL xcsum(co2flux,ztmp1,ips) + + ! Convert global CO2 flux to ppm + co2flux_ppm = co2flux*12.*1.e-12*pg2ppm ! [kmol C] -> [ppm] + + ! Update atmospheric pCO2 + DO j=1,kpje + DO i=1,kpie + atm(i,j,iatmco2)=atm(i,j,iatmco2) + co2flux_ppm + ENDDO + ENDDO + + 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) + 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 - endif ! end of use_cisonew + endif ! end of use_cisonew -end subroutine update_boxatm + end subroutine update_boxatm end module mo_boxatm diff --git a/hamocc/mo_carbch.F90 b/hamocc/mo_carbch.F90 index fbd54bef..6be0e493 100644 --- a/hamocc/mo_carbch.F90 +++ b/hamocc/mo_carbch.F90 @@ -4,419 +4,419 @@ ! 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_carbch -!*********************************************************************** -! -! MODULE mo_carbch - Variables for inorganic carbon cycle. -! -! S.Legutke, *MPI-MaD, HH* 31.10.01 -! -! Modified -! -------- -! -! Patrick Wetzel *MPI-Met, HH* 16.04.02 -! - new: atm, atdifv, suppco2 -! - changed: chemc(:,:,:) to chemcm(:,:,:,:) -! - new: bgcmean(:,:,:,:) -! -! J. Schwinger *UiB-GfI, Bergen* 04.05.12 -! - added initialisation of all vars after allocation -! -! J.Schwinger, *Uni Research, Bergen* 2018-04-12 -! - moved accumulation of all output fields to seperate subroutine, -! new global fields for output defined here -! - added OmegaA -! -! Purpose -! ------- -! - declaration and memory allocation -! -! Description: -! ------------ -! Public routines and variable of this module: -! -! -subroutine alloc_mem_carbch -! Allocate memory for inorganic carbon variables -! -! -!********************************************************************** - implicit none - - REAL, DIMENSION (:,:,:,:), ALLOCATABLE :: ocetra - REAL, DIMENSION (:,:,:), ALLOCATABLE :: atm - REAL, DIMENSION (:,:,:), ALLOCATABLE :: atmflx - REAL, DIMENSION (:,:), ALLOCATABLE :: ndepflx - REAL, DIMENSION (:,:), ALLOCATABLE :: oalkflx - REAL, DIMENSION (:,:,:), ALLOCATABLE :: rivinflx - REAL, DIMENSION (:,:,:), ALLOCATABLE :: co3 - REAL, DIMENSION (:,:,:), ALLOCATABLE :: co2star - REAL, DIMENSION (:,:,:), ALLOCATABLE :: hi - REAL, DIMENSION (:,:,:), ALLOCATABLE :: OmegaA - REAL, DIMENSION (:,:,:), ALLOCATABLE :: OmegaC - REAL, DIMENSION (:,:,:), ALLOCATABLE :: keqb - - REAL, DIMENSION (:,:,:), ALLOCATABLE :: satoxy - REAL, DIMENSION (:,:), ALLOCATABLE :: satn2o - REAL, DIMENSION (:,:), ALLOCATABLE :: atdifv - REAL, DIMENSION (:,:), ALLOCATABLE :: suppco2 - REAL, DIMENSION (:,:,:), ALLOCATABLE :: sedfluxo - - REAL, DIMENSION (:,:), ALLOCATABLE :: pco2d - REAL, DIMENSION (:,:), ALLOCATABLE :: pco2m - REAL, DIMENSION (:,:), ALLOCATABLE :: kwco2sol - REAL, DIMENSION (:,:), ALLOCATABLE :: kwco2d - REAL, DIMENSION (:,:), ALLOCATABLE :: co2sold - REAL, DIMENSION (:,:), ALLOCATABLE :: co2solm - REAL, DIMENSION (:,:), ALLOCATABLE :: co2fxd - REAL, DIMENSION (:,:), ALLOCATABLE :: co2fxu - REAL, DIMENSION (:,:), ALLOCATABLE :: co213fxd - REAL, DIMENSION (:,:), ALLOCATABLE :: co213fxu - REAL, DIMENSION (:,:), ALLOCATABLE :: co214fxd - REAL, DIMENSION (:,:), ALLOCATABLE :: co214fxu - REAL, DIMENSION (:,:), ALLOCATABLE :: natpco2d - REAL, DIMENSION (:,:,:), ALLOCATABLE :: nathi - REAL, DIMENSION (:,:,:), ALLOCATABLE :: natco3 - REAL, DIMENSION (:,:,:), ALLOCATABLE :: natOmegaA - REAL, DIMENSION (:,:,:), ALLOCATABLE :: natOmegaC - - REAL :: atm_co2 - REAL :: atm_cfc11_nh,atm_cfc11_sh - REAL :: atm_cfc12_nh,atm_cfc12_sh - REAL :: atm_sf6_nh,atm_sf6_sh - - CONTAINS - - SUBROUTINE ALLOC_MEM_CARBCH(kpie,kpje,kpke) -!****************************************************************************** -! ALLOC_MEM_CARBCH - Allocate variables in this module -!****************************************************************************** - 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 +MODULE mo_carbch + !*********************************************************************** + ! + ! MODULE mo_carbch - Variables for inorganic carbon cycle. + ! + ! S.Legutke, *MPI-MaD, HH* 31.10.01 + ! + ! Modified + ! -------- + ! + ! Patrick Wetzel *MPI-Met, HH* 16.04.02 + ! - new: atm, atdifv, suppco2 + ! - changed: chemc(:,:,:) to chemcm(:,:,:,:) + ! - new: bgcmean(:,:,:,:) + ! + ! J. Schwinger *UiB-GfI, Bergen* 04.05.12 + ! - added initialisation of all vars after allocation + ! + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - moved accumulation of all output fields to seperate subroutine, + ! new global fields for output defined here + ! - added OmegaA + ! + ! Purpose + ! ------- + ! - declaration and memory allocation + ! + ! Description: + ! ------------ + ! Public routines and variable of this module: + ! + ! -subroutine alloc_mem_carbch + ! Allocate memory for inorganic carbon variables + ! + ! + !********************************************************************** + implicit none + + REAL, DIMENSION (:,:,:,:), ALLOCATABLE :: ocetra + REAL, DIMENSION (:,:,:), ALLOCATABLE :: atm + REAL, DIMENSION (:,:,:), ALLOCATABLE :: atmflx + REAL, DIMENSION (:,:), ALLOCATABLE :: ndepflx + REAL, DIMENSION (:,:), ALLOCATABLE :: oalkflx + REAL, DIMENSION (:,:,:), ALLOCATABLE :: rivinflx + REAL, DIMENSION (:,:,:), ALLOCATABLE :: co3 + REAL, DIMENSION (:,:,:), ALLOCATABLE :: co2star + REAL, DIMENSION (:,:,:), ALLOCATABLE :: hi + REAL, DIMENSION (:,:,:), ALLOCATABLE :: OmegaA + REAL, DIMENSION (:,:,:), ALLOCATABLE :: OmegaC + REAL, DIMENSION (:,:,:), ALLOCATABLE :: keqb + + REAL, DIMENSION (:,:,:), ALLOCATABLE :: satoxy + REAL, DIMENSION (:,:), ALLOCATABLE :: satn2o + REAL, DIMENSION (:,:), ALLOCATABLE :: atdifv + REAL, DIMENSION (:,:), ALLOCATABLE :: suppco2 + REAL, DIMENSION (:,:,:), ALLOCATABLE :: sedfluxo + + REAL, DIMENSION (:,:), ALLOCATABLE :: pco2d + REAL, DIMENSION (:,:), ALLOCATABLE :: pco2m + REAL, DIMENSION (:,:), ALLOCATABLE :: kwco2sol + REAL, DIMENSION (:,:), ALLOCATABLE :: kwco2d + REAL, DIMENSION (:,:), ALLOCATABLE :: co2sold + REAL, DIMENSION (:,:), ALLOCATABLE :: co2solm + REAL, DIMENSION (:,:), ALLOCATABLE :: co2fxd + REAL, DIMENSION (:,:), ALLOCATABLE :: co2fxu + REAL, DIMENSION (:,:), ALLOCATABLE :: co213fxd + REAL, DIMENSION (:,:), ALLOCATABLE :: co213fxu + REAL, DIMENSION (:,:), ALLOCATABLE :: co214fxd + REAL, DIMENSION (:,:), ALLOCATABLE :: co214fxu + REAL, DIMENSION (:,:), ALLOCATABLE :: natpco2d + REAL, DIMENSION (:,:,:), ALLOCATABLE :: nathi + REAL, DIMENSION (:,:,:), ALLOCATABLE :: natco3 + REAL, DIMENSION (:,:,:), ALLOCATABLE :: natOmegaA + REAL, DIMENSION (:,:,:), ALLOCATABLE :: natOmegaC + + REAL :: atm_co2 + REAL :: atm_cfc11_nh,atm_cfc11_sh + REAL :: atm_cfc12_nh,atm_cfc12_sh + REAL :: atm_sf6_nh,atm_sf6_sh + +CONTAINS + + SUBROUTINE ALLOC_MEM_CARBCH(kpie,kpje,kpke) + !****************************************************************************** + ! ALLOC_MEM_CARBCH - Allocate variables in this module + !****************************************************************************** + 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,*)' ' WRITE(io_stdo_bgc,*)'***************************************************' WRITE(io_stdo_bgc,*)'Memory allocation for carbon chemistry module :' WRITE(io_stdo_bgc,*)' ' - ENDIF + ENDIF - IF (mnproc.eq.1) THEN + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable ocetra ...' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje WRITE(io_stdo_bgc,*)'Third dimension : ',kpke WRITE(io_stdo_bgc,*)'Forth dimension : ',nocetra - ENDIF + ENDIF - ALLOCATE (ocetra(kpie,kpje,kpke,nocetra),stat=errstat) - if(errstat.ne.0) stop 'not enough memory ocetra' - ocetra(:,:,:,:) = 0.0 + ALLOCATE (ocetra(kpie,kpje,kpke,nocetra),stat=errstat) + if(errstat.ne.0) stop 'not enough memory ocetra' + ocetra(:,:,:,:) = 0.0 - IF (mnproc.eq.1) THEN + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable hi ...' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje WRITE(io_stdo_bgc,*)'Third dimension : ',kpke - ENDIF + ENDIF - ALLOCATE (hi(kpie,kpje,kpke),stat=errstat) - if(errstat.ne.0) stop 'not enough memory hi' - hi(:,:,:) = 0.0 + ALLOCATE (hi(kpie,kpje,kpke),stat=errstat) + if(errstat.ne.0) stop 'not enough memory hi' + hi(:,:,:) = 0.0 - IF (mnproc.eq.1) THEN + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable co3 ...' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje WRITE(io_stdo_bgc,*)'Third dimension : ',kpke - ENDIF + ENDIF - ALLOCATE (co3(kpie,kpje,kpke),stat=errstat) - if(errstat.ne.0) stop 'not enough memory co3' - co3(:,:,:) = 0.0 + ALLOCATE (co3(kpie,kpje,kpke),stat=errstat) + if(errstat.ne.0) stop 'not enough memory co3' + co3(:,:,:) = 0.0 - IF (mnproc.eq.1) THEN + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable co2star ...' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje WRITE(io_stdo_bgc,*)'Third dimension : ',kpke - ENDIF + ENDIF - ALLOCATE (co2star(kpie,kpje,kpke),stat=errstat) - if(errstat.ne.0) stop 'not enough memory co2star' - co2star(:,:,:) = 0.0 + ALLOCATE (co2star(kpie,kpje,kpke),stat=errstat) + if(errstat.ne.0) stop 'not enough memory co2star' + co2star(:,:,:) = 0.0 - IF (mnproc.eq.1) THEN + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable OmegaA, OmegaC ...' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje WRITE(io_stdo_bgc,*)'Third dimension : ',kpke + ENDIF + + ALLOCATE (OmegaA(kpie,kpje,kpke),stat=errstat) + ALLOCATE (OmegaC(kpie,kpje,kpke),stat=errstat) + if(errstat.ne.0) stop 'not enough memory OmegaA, OmegaC' + OmegaA(:,:,:) = 0.0 + OmegaC(:,:,:) = 0.0 + + 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 (OmegaA(kpie,kpje,kpke),stat=errstat) - ALLOCATE (OmegaC(kpie,kpje,kpke),stat=errstat) - if(errstat.ne.0) stop 'not enough memory OmegaA, OmegaC' - OmegaA(:,:,:) = 0.0 - OmegaC(:,:,:) = 0.0 - - 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 - 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 (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable sedfluxo ..' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje WRITE(io_stdo_bgc,*)'Third dimension : ',npowtra - ENDIF + ENDIF - ALLOCATE (sedfluxo(kpie,kpje,npowtra),stat=errstat) - if(errstat.ne.0) stop 'not enough memory sedfluxo' - sedfluxo(:,:,:) = 0.0 + ALLOCATE (sedfluxo(kpie,kpje,npowtra),stat=errstat) + if(errstat.ne.0) stop 'not enough memory sedfluxo' + sedfluxo(:,:,:) = 0.0 - IF (mnproc.eq.1) THEN + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable satn2o ...' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF + ENDIF - ALLOCATE (satn2o(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory satn2o' - satn2o(:,:) = 0.0 + ALLOCATE (satn2o(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory satn2o' + satn2o(:,:) = 0.0 - IF (mnproc.eq.1) THEN + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable keqb ...' WRITE(io_stdo_bgc,*)'First dimension : ',11 WRITE(io_stdo_bgc,*)'Second dimension : ',kpie WRITE(io_stdo_bgc,*)'Third dimension : ',kpje - ENDIF + ENDIF - ALLOCATE (keqb(11,kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory keqb' - keqb(:,:,:) = 0.0 + ALLOCATE (keqb(11,kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory keqb' + keqb(:,:,:) = 0.0 - IF (mnproc.eq.1) THEN + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable satoxy ...' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje WRITE(io_stdo_bgc,*)'Third dimension : ',kpke - ENDIF + ENDIF - ALLOCATE (satoxy(kpie,kpje,kpke),stat=errstat) - if(errstat.ne.0) stop 'not enough memory satoxy' - satoxy(:,:,:) = 0.0 + ALLOCATE (satoxy(kpie,kpje,kpke),stat=errstat) + if(errstat.ne.0) stop 'not enough memory satoxy' + satoxy(:,:,:) = 0.0 - IF (mnproc.eq.1) THEN + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable atm ...' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje WRITE(io_stdo_bgc,*)'Third dimension : ',natm - ENDIF + ENDIF - ALLOCATE (atm(kpie,kpje,natm),stat=errstat) - if(errstat.ne.0) stop 'not enough memory atm' - atm(:,:,:) = 0.0 + ALLOCATE (atm(kpie,kpje,natm),stat=errstat) + if(errstat.ne.0) stop 'not enough memory atm' + atm(:,:,:) = 0.0 - IF (mnproc.eq.1) THEN + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable atmflx ...' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje WRITE(io_stdo_bgc,*)'Third dimension : ',natm - ENDIF + ENDIF - ALLOCATE (atmflx(kpie,kpje,natm),stat=errstat) - if(errstat.ne.0) stop 'not enough memory atmflx' - atmflx(:,:,:) = 0.0 + ALLOCATE (atmflx(kpie,kpje,natm),stat=errstat) + if(errstat.ne.0) stop 'not enough memory atmflx' + atmflx(:,:,:) = 0.0 - ! Allocate field to hold N-deposition fluxes per timestep for inventory calculations and output - IF (mnproc.eq.1) THEN + ! Allocate field to hold N-deposition fluxes per timestep for inventory calculations and output + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable ndepflx ...' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF + ENDIF - ALLOCATE (ndepflx(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory ndepflx' - ndepflx(:,:) = 0.0 + ALLOCATE (ndepflx(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory ndepflx' + ndepflx(:,:) = 0.0 - ! Allocate field to hold OA alkalinity fluxes per timestep for inventory calculations and output - IF (mnproc.eq.1) THEN + ! Allocate field to hold OA alkalinity fluxes per timestep for inventory calculations and output + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable oalkflx ...' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF + ENDIF - ALLOCATE (oalkflx(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory oalkflx' - oalkflx(:,:) = 0.0 + ALLOCATE (oalkflx(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory oalkflx' + oalkflx(:,:) = 0.0 - ! Allocate field to hold riverine fluxes per timestep for inventory calculations - IF (mnproc.eq.1) THEN + ! Allocate field to hold riverine fluxes per timestep for inventory calculations + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable rivinflx ...' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje WRITE(io_stdo_bgc,*)'Third dimension : ',nriv - ENDIF - - ALLOCATE(rivinflx(kpie,kpje,nriv),stat=errstat) - if(errstat.ne.0) stop 'not enough memory rivinflx' - rivinflx(:,:,:) = 0.0 + ENDIF - IF (mnproc.eq.1) THEN + ALLOCATE(rivinflx(kpie,kpje,nriv),stat=errstat) + if(errstat.ne.0) stop 'not enough memory rivinflx' + rivinflx(:,:,:) = 0.0 + + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable pco2d ...' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF + ENDIF - ALLOCATE (pco2d(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory pco2d' - pco2d(:,:) = 0.0 + ALLOCATE (pco2d(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory pco2d' + pco2d(:,:) = 0.0 - IF (mnproc.eq.1) THEN + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable pco2m ...' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF + ENDIF - ALLOCATE (pco2m(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory pco2m' - pco2m(:,:) = 0.0 + ALLOCATE (pco2m(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory pco2m' + pco2m(:,:) = 0.0 - IF (mnproc.eq.1) THEN + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable kwco2d ...' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF + ENDIF - ALLOCATE (kwco2d(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory kwco2d' - kwco2d(:,:) = 0.0 + ALLOCATE (kwco2d(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory kwco2d' + kwco2d(:,:) = 0.0 - IF (mnproc.eq.1) THEN + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable kwco2sol ...' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF - - IF (mnproc.eq.1) THEN + ENDIF + + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable co2sold ...' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF + ENDIF - ALLOCATE (co2sold(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory co2sold' - co2sold(:,:) = 0.0 - - IF (mnproc.eq.1) THEN + ALLOCATE (co2sold(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory co2sold' + co2sold(:,:) = 0.0 + + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable co2solm ...' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF + ENDIF - ALLOCATE (co2solm(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory co2solm' - co2solm(:,:) = 0.0 + ALLOCATE (co2solm(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory co2solm' + co2solm(:,:) = 0.0 - ALLOCATE (kwco2sol(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory co2fxd,co2fxu' - kwco2sol(:,:) = 0.0 + ALLOCATE (kwco2sol(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory co2fxd,co2fxu' + kwco2sol(:,:) = 0.0 - IF (mnproc.eq.1) THEN + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable co2fxd, co2fxu ...' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + ENDIF + + ALLOCATE (co2fxd(kpie,kpje),stat=errstat) + ALLOCATE (co2fxu(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory co2fxd,co2fxu' + co2fxd(:,:) = 0.0 + co2fxu(:,:) = 0.0 + + 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 (co2fxd(kpie,kpje),stat=errstat) - ALLOCATE (co2fxu(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory co2fxd,co2fxu' - co2fxd(:,:) = 0.0 - co2fxu(:,:) = 0.0 - - 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 - endif - -!****************************************************************************** - END SUBROUTINE ALLOC_MEM_CARBCH - - END MODULE mo_carbch + 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 + + !****************************************************************************** + END SUBROUTINE ALLOC_MEM_CARBCH + +END MODULE mo_carbch diff --git a/hamocc/mo_chemcon.F90 b/hamocc/mo_chemcon.F90 index 7b666856..041c6ac4 100644 --- a/hamocc/mo_chemcon.F90 +++ b/hamocc/mo_chemcon.F90 @@ -3,202 +3,202 @@ ! 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_chemcon -!********************************************************************** -! -!**** *MODULE mo_chemcon* - Parameter definitions for chemical formulas -! -! J. Schwinger, *UiB-GfI, Bergen* 2013-08-21 -! -! Modified -! -------- -! J.Schwinger, *Uni Research, Bergen* 2018-04-12 -! - added constants for Kh CO2 w.r.t. dry air (Weiss, 1974) -! -! -! Purpose -! ------- -! - declare chemical parameters previously defined in -! subroutine chemcon -! -!********************************************************************** - - - implicit none - - -! real, parameter :: ZERO=0. -! real, parameter :: TENM7=10.**(-7.0) -! real, parameter :: SMICR=1.E-6 -! real, parameter :: THOUSI=1./1000. -! real, parameter :: PERC=0.01 -! real, parameter :: FOURTH=0.25 -! real, parameter :: THIRD=1./3. -! real, parameter :: HALF=0.5 -! real, parameter :: ONE=1. -! real, parameter :: TWO=2. -! real, parameter :: TEN=10. - - -! ----------------------------------------------------------------- -!* BORON CONCENTRATION IN SEA WATER IN G/KG PER O/OO CL -! (RILEY AND SKIRROW, 1965, P.250) -! - real, parameter :: BOR1=0.000232 - - -! ----------------------------------------------------------------- -!* INVERSE OF ATOMIC WEIGHT OF BORON [G**-1] -! (USED TO CONVERT SPECIFIC TOTAL BORAT INTO CONCENTRATIONS) -! - real, parameter :: BOR2=1./10.811 - - -! ----------------------------------------------------------------- -!* CONVERSION FACTOR SALINITY -> CHLORINITY -! (AFTER WOOSTER ET AL., 1969) -! - real, parameter :: SALCHL=1./1.80655 - real, parameter :: rrrcl=salchl*1.025*bor1*bor2 - - -! ----------------------------------------------------------------- -!* ZERO DEG CENTIGRADE AT KELVIN SCALE -! - real, parameter :: tzero=273.15 - - -! ----------------------------------------------------------------- -!* SET MEAN TOTAL [CA++] IN SEAWATER (MOLES/KG) (SEE BROECKER -! A. PENG, 1982, P. 26; [CA++](MOLES/KG)=1.028E-2*(S/35.); Value -! taken from Sarmiento and Gruber, 2006, p. 365 -! - real, parameter :: CALCON=0.01028 - - -! ----------------------------------------------------------------- -!* INVERS OF NORMAL MOLAL VOLUME OF AN IDEAL GAS [mol/ml] at 0C -! - real, parameter :: OXYCO=1./22414.4 - - -! ----------------------------------------------------------------- -!* VOLUMETRIC SOLUBILITY CONSTANTS FOR O2 IN ML/L from moist air at -! one atm total pressure. Table 2 in WEISS, R. F. (1970) THE -! SOLUBILITY OF NITROGEN OXYGEN AND ARGON IN WATER AND SEAWATER. -! DEEP-SEA RESEARCH, VOL. 17, 721-735. -! - real, parameter :: OX0=-173.4292 - real, parameter :: OX1=249.6339 - real, parameter :: OX2=143.3483 - real, parameter :: OX3=-21.8492 - real, parameter :: OX4=-0.033096 - real, parameter :: OX5=0.014259 - real, parameter :: OX6=-0.0017 - - -! ----------------------------------------------------------------- -!* VOLUMETRIC SOLUBILITY CONSTANTS FOR N2 IN ML/L from moist air at -! one atm total pressure. Table 2 in WEISS, R. F. (1970) THE -! SOLUBILITY OF NITROGEN OXYGEN AND ARGON IN WATER AND SEAWATER. -! DEEP-SEA RESEARCH, VOL. 17, 721-735. -! - real, parameter :: AN0=-172.4965 - real, parameter :: AN1=248.4262 - real, parameter :: AN2=143.0738 - real, parameter :: AN3=-21.7120 - real, parameter :: AN4=-0.049781 - real, parameter :: AN5=0.025018 - real, parameter :: AN6=-0.0034861 - - -! ----------------------------------------------------------------- -! Constants for CO2 solubility in mol/kg/atm from moist -! air at one atm total pressure. Table 6 in WEISS, R.F., -! NITROUS OXIDE SOLUBILITY IN WATER AND SEAWATER, -! Marine Chemistry, 8, 347-359, 1980 -! - real, parameter :: ac1= -162.8301 - real, parameter :: ac2= 218.2968 - real, parameter :: ac3= 90.9241 - real, parameter :: ac4= -1.47696 - real, parameter :: bc1= 0.025695 - real, parameter :: bc2= -0.025225 - real, parameter :: bc3= 0.0049867 - - -! ----------------------------------------------------------------- -! Constants for CO2 solubility in mol/kg/atm for dry -! air at one atm total pressure. Table 1 in WEISS, R.F., -! CARBON DIOXIDE IN WATER AND SEAWATER: THE SOLUBILITY OF -! A NON - IDEAL GAS, Marine Chemistry, 2, 203-215, 1974 -! - real, parameter :: ad1= -60.2409 - real, parameter :: ad2= 93.4517 - real, parameter :: ad3= 23.3585 - real, parameter :: bd1= 0.023517 - real, parameter :: bd2= -0.023656 - real, parameter :: bd3= 0.0047036 - - -! ----------------------------------------------------------------- -! Constants for laughing gas solubility in mol/l/atm from moist -! air at one atm total pressure. Table 2 in WEISS, R.F., -! NITROUS OXIDE SOLUBILITY IN WATER AND SEAWATER, -! Marine Chemistry, 8, 347-359, 1980 -! - real, parameter :: al1= -165.8806 - real, parameter :: al2= 222.8743 - real, parameter :: al3= 92.0792 - real, parameter :: al4= -1.48425 - real, parameter :: bl1= -0.056235 - real, parameter :: bl2= 0.031619 - real, parameter :: bl3= -0.0048472 - - -! ----------------------------------------------------------------- -! Atmospheric mixing ratio of N2O around 1980 300 ppb -! - real, parameter :: atn2o=3.e-7 - - - -! ----------------------------------------------------------------- -! Constants needed for pressure correction of equilibrium constants -! F. Millero, Thermodynamics of the carbon dioxide system in the oceans, -! Geochimica et Cosmochimica Acta, Vol. 59, No. 4, pp. 661-677, 1995 - REAL, DIMENSION(11) :: a0, a1, a2, b0, b1, b2 - DATA a0 /-25.5, -15.82, -29.48, -25.60, -18.03, -9.78, -48.76, & - -46., -14.51, -23.12, -26.57/ - DATA a1 /0.1271, -0.0219, 0.1622, 0.2324, 0.0466, -0.0090, & - 0.5304, 0.5304, 0.1211, 0.1758, 0.2020/ - DATA a2 /0.0, 0.0, 2.608e-3, -3.6246e-3, 0.316e-3, & - -0.942e-3, 0.0, 0.0, -0.321e-3, -2.647e-3, -3.042e-3/ - DATA b0 /-3.08e-3, 1.13e-3, -2.84e-3, -5.13e-3, -4.53e-3, & - -3.91e-3, -11.76e-3, -11.76e-3, -2.67e-3, -5.15e-3, & - -4.08e-3/ - DATA b1 /0.0877e-3, -0.1475e-3, 0.0, 0.0794e-3, 0.09e-3, & - 0.054e-3, 0.3692e-3, 0.3692e-3, 0.0427e-3, & - 0.09e-3, 0.0714e-3/ - DATA b2 /0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/ - -! ----------------------------------------------------------------- -! Gas constant, value as used by Millero (1995) - - real, parameter :: rgas = 83.131 - - - END MODULE mo_chemcon +MODULE mo_chemcon + !********************************************************************** + ! + !**** *MODULE mo_chemcon* - Parameter definitions for chemical formulas + ! + ! J. Schwinger, *UiB-GfI, Bergen* 2013-08-21 + ! + ! Modified + ! -------- + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - added constants for Kh CO2 w.r.t. dry air (Weiss, 1974) + ! + ! + ! Purpose + ! ------- + ! - declare chemical parameters previously defined in + ! subroutine chemcon + ! + !********************************************************************** + + + implicit none + + + ! real, parameter :: ZERO=0. + ! real, parameter :: TENM7=10.**(-7.0) + ! real, parameter :: SMICR=1.E-6 + ! real, parameter :: THOUSI=1./1000. + ! real, parameter :: PERC=0.01 + ! real, parameter :: FOURTH=0.25 + ! real, parameter :: THIRD=1./3. + ! real, parameter :: HALF=0.5 + ! real, parameter :: ONE=1. + ! real, parameter :: TWO=2. + ! real, parameter :: TEN=10. + + + ! ----------------------------------------------------------------- + !* BORON CONCENTRATION IN SEA WATER IN G/KG PER O/OO CL + ! (RILEY AND SKIRROW, 1965, P.250) + ! + real, parameter :: BOR1=0.000232 + + + ! ----------------------------------------------------------------- + !* INVERSE OF ATOMIC WEIGHT OF BORON [G**-1] + ! (USED TO CONVERT SPECIFIC TOTAL BORAT INTO CONCENTRATIONS) + ! + real, parameter :: BOR2=1./10.811 + + + ! ----------------------------------------------------------------- + !* CONVERSION FACTOR SALINITY -> CHLORINITY + ! (AFTER WOOSTER ET AL., 1969) + ! + real, parameter :: SALCHL=1./1.80655 + real, parameter :: rrrcl=salchl*1.025*bor1*bor2 + + + ! ----------------------------------------------------------------- + !* ZERO DEG CENTIGRADE AT KELVIN SCALE + ! + real, parameter :: tzero=273.15 + + + ! ----------------------------------------------------------------- + !* SET MEAN TOTAL [CA++] IN SEAWATER (MOLES/KG) (SEE BROECKER + ! A. PENG, 1982, P. 26; [CA++](MOLES/KG)=1.028E-2*(S/35.); Value + ! taken from Sarmiento and Gruber, 2006, p. 365 + ! + real, parameter :: CALCON=0.01028 + + + ! ----------------------------------------------------------------- + !* INVERS OF NORMAL MOLAL VOLUME OF AN IDEAL GAS [mol/ml] at 0C + ! + real, parameter :: OXYCO=1./22414.4 + + + ! ----------------------------------------------------------------- + !* VOLUMETRIC SOLUBILITY CONSTANTS FOR O2 IN ML/L from moist air at + ! one atm total pressure. Table 2 in WEISS, R. F. (1970) THE + ! SOLUBILITY OF NITROGEN OXYGEN AND ARGON IN WATER AND SEAWATER. + ! DEEP-SEA RESEARCH, VOL. 17, 721-735. + ! + real, parameter :: OX0=-173.4292 + real, parameter :: OX1=249.6339 + real, parameter :: OX2=143.3483 + real, parameter :: OX3=-21.8492 + real, parameter :: OX4=-0.033096 + real, parameter :: OX5=0.014259 + real, parameter :: OX6=-0.0017 + + + ! ----------------------------------------------------------------- + !* VOLUMETRIC SOLUBILITY CONSTANTS FOR N2 IN ML/L from moist air at + ! one atm total pressure. Table 2 in WEISS, R. F. (1970) THE + ! SOLUBILITY OF NITROGEN OXYGEN AND ARGON IN WATER AND SEAWATER. + ! DEEP-SEA RESEARCH, VOL. 17, 721-735. + ! + real, parameter :: AN0=-172.4965 + real, parameter :: AN1=248.4262 + real, parameter :: AN2=143.0738 + real, parameter :: AN3=-21.7120 + real, parameter :: AN4=-0.049781 + real, parameter :: AN5=0.025018 + real, parameter :: AN6=-0.0034861 + + + ! ----------------------------------------------------------------- + ! Constants for CO2 solubility in mol/kg/atm from moist + ! air at one atm total pressure. Table 6 in WEISS, R.F., + ! NITROUS OXIDE SOLUBILITY IN WATER AND SEAWATER, + ! Marine Chemistry, 8, 347-359, 1980 + ! + real, parameter :: ac1= -162.8301 + real, parameter :: ac2= 218.2968 + real, parameter :: ac3= 90.9241 + real, parameter :: ac4= -1.47696 + real, parameter :: bc1= 0.025695 + real, parameter :: bc2= -0.025225 + real, parameter :: bc3= 0.0049867 + + + ! ----------------------------------------------------------------- + ! Constants for CO2 solubility in mol/kg/atm for dry + ! air at one atm total pressure. Table 1 in WEISS, R.F., + ! CARBON DIOXIDE IN WATER AND SEAWATER: THE SOLUBILITY OF + ! A NON - IDEAL GAS, Marine Chemistry, 2, 203-215, 1974 + ! + real, parameter :: ad1= -60.2409 + real, parameter :: ad2= 93.4517 + real, parameter :: ad3= 23.3585 + real, parameter :: bd1= 0.023517 + real, parameter :: bd2= -0.023656 + real, parameter :: bd3= 0.0047036 + + + ! ----------------------------------------------------------------- + ! Constants for laughing gas solubility in mol/l/atm from moist + ! air at one atm total pressure. Table 2 in WEISS, R.F., + ! NITROUS OXIDE SOLUBILITY IN WATER AND SEAWATER, + ! Marine Chemistry, 8, 347-359, 1980 + ! + real, parameter :: al1= -165.8806 + real, parameter :: al2= 222.8743 + real, parameter :: al3= 92.0792 + real, parameter :: al4= -1.48425 + real, parameter :: bl1= -0.056235 + real, parameter :: bl2= 0.031619 + real, parameter :: bl3= -0.0048472 + + + ! ----------------------------------------------------------------- + ! Atmospheric mixing ratio of N2O around 1980 300 ppb + ! + real, parameter :: atn2o=3.e-7 + + + + ! ----------------------------------------------------------------- + ! Constants needed for pressure correction of equilibrium constants + ! F. Millero, Thermodynamics of the carbon dioxide system in the oceans, + ! Geochimica et Cosmochimica Acta, Vol. 59, No. 4, pp. 661-677, 1995 + REAL, DIMENSION(11) :: a0, a1, a2, b0, b1, b2 + DATA a0 /-25.5, -15.82, -29.48, -25.60, -18.03, -9.78, -48.76, & + -46., -14.51, -23.12, -26.57/ + DATA a1 /0.1271, -0.0219, 0.1622, 0.2324, 0.0466, -0.0090, & + 0.5304, 0.5304, 0.1211, 0.1758, 0.2020/ + DATA a2 /0.0, 0.0, 2.608e-3, -3.6246e-3, 0.316e-3, & + -0.942e-3, 0.0, 0.0, -0.321e-3, -2.647e-3, -3.042e-3/ + DATA b0 /-3.08e-3, 1.13e-3, -2.84e-3, -5.13e-3, -4.53e-3, & + -3.91e-3, -11.76e-3, -11.76e-3, -2.67e-3, -5.15e-3, & + -4.08e-3/ + DATA b1 /0.0877e-3, -0.1475e-3, 0.0, 0.0794e-3, 0.09e-3, & + 0.054e-3, 0.3692e-3, 0.3692e-3, 0.0427e-3, & + 0.09e-3, 0.0714e-3/ + DATA b2 /0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/ + + ! ----------------------------------------------------------------- + ! Gas constant, value as used by Millero (1995) + + real, parameter :: rgas = 83.131 + + +END MODULE mo_chemcon diff --git a/hamocc/mo_clim_swa.F90 b/hamocc/mo_clim_swa.F90 index 5e15614e..0cee6ba0 100644 --- a/hamocc/mo_clim_swa.F90 +++ b/hamocc/mo_clim_swa.F90 @@ -1,42 +1,42 @@ -! Copyright (C) 2021 J. Tjiputra +! Copyright (C) 2021 J. Tjiputra ! ! 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_clim_swa -!****************************************************************************** -! -! MODULE mo_clim_swa - Variables and routines for climatology short-wave fields -! -! J.Tjiputra, *NORCE Climate, Bergen* 2021-04-15 -! -! Modified -! -------- -! -! Purpose -! ------- -! Declaration, memory allocation, and routines related to swa_clim fields -! -!****************************************************************************** + !****************************************************************************** + ! + ! MODULE mo_clim_swa - Variables and routines for climatology short-wave fields + ! + ! J.Tjiputra, *NORCE Climate, Bergen* 2021-04-15 + ! + ! Modified + ! -------- + ! + ! Purpose + ! ------- + ! Declaration, memory allocation, and routines related to swa_clim fields + ! + !****************************************************************************** implicit none private public :: ini_swa_clim, swaclimfile, swa_clim - ! File name (incl. full path) for input data, set through namelist + ! File name (incl. full path) for input data, set through namelist ! in hamocc_init.F character(len=512), save :: swaclimfile='' ! Array to store swa flux after reading from file @@ -44,101 +44,100 @@ module mo_clim_swa contains -!****************************************************************************** - - - -subroutine ini_swa_clim(kpie,kpje,omask) -!****************************************************************************** -! -! INI_SWA_CLIM - initialise the climatology SWA field module. -! -! J.Tjiputra *NORCE Climate, Bergen* 2021-04-15 -! -! Purpose -! ------- -! Initialise the climatology swa module, read in the swa (short-wave radiation) data set. -! -! Parameter list: -! --------------- -! *INTEGER* *kpie* - 1st dimension of model grid. -! *INTEGER* *kpje* - 2nd dimension of model grid. -! *REAL* *omask* - land/ocean mask (1=ocean) -! -!****************************************************************************** - use netcdf, only: nf90_noerr,nf90_nowrite,nf90_close,nf90_open - use mod_xc, only: mnproc,xchalt - use mo_control_bgc, only: io_stdo_bgc + !****************************************************************************** + + + + subroutine ini_swa_clim(kpie,kpje,omask) + !****************************************************************************** + ! + ! INI_SWA_CLIM - initialise the climatology SWA field module. + ! + ! J.Tjiputra *NORCE Climate, Bergen* 2021-04-15 + ! + ! Purpose + ! ------- + ! Initialise the climatology swa module, read in the swa (short-wave radiation) data set. + ! + ! Parameter list: + ! --------------- + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! *REAL* *omask* - land/ocean mask (1=ocean) + ! + !****************************************************************************** + use netcdf, only: nf90_noerr,nf90_nowrite,nf90_close,nf90_open + use mod_xc, only: mnproc,xchalt + use mo_control_bgc, only: io_stdo_bgc + + implicit none + + integer, intent(in) :: kpie,kpje + real, intent(in) :: omask(kpie,kpje) + + integer :: i,j + integer :: ncid,ncstat,ncvarid,errstat + + + ! allocate field to hold swa fields + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)' ' + WRITE(io_stdo_bgc,*)'***************************************************' + WRITE(io_stdo_bgc,*)'iHAMOCC: Initialization of module mo_clim_swa:' + WRITE(io_stdo_bgc,*)' ' + ENDIF + + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable swa_clim ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + ENDIF + + ALLOCATE (swa_clim(kpie,kpje,1),stat=errstat) + if(errstat.ne.0) stop 'not enough memory swa_clim' + swa_clim(:,:,1) = 0.0 + + ! Open netCDF data file + IF(mnproc==1) THEN + ncstat = NF90_OPEN(trim(swaclimfile),NF90_NOWRITE, ncid) + IF (ncstat.NE.NF90_NOERR ) THEN + CALL xchalt('(ini_swa_clim: Problem with netCDF1)') + stop '(ini_swa_clim: Problem with netCDF1)' + END IF + END IF - implicit none + ! Read data + call read_netcdf_var(ncid,'swa',swa_clim(1,1,1),1,1,0) - integer, intent(in) :: kpie,kpje - real, intent(in) :: omask(kpie,kpje) - - integer :: i,j - integer :: ncid,ncstat,ncvarid,errstat - - - ! allocate field to hold swa fields - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'***************************************************' - WRITE(io_stdo_bgc,*)'iHAMOCC: Initialization of module mo_clim_swa:' - WRITE(io_stdo_bgc,*)' ' - ENDIF - - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable swa_clim ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF - - ALLOCATE (swa_clim(kpie,kpje,1),stat=errstat) - if(errstat.ne.0) stop 'not enough memory swa_clim' - swa_clim(:,:,1) = 0.0 - - ! Open netCDF data file - IF(mnproc==1) THEN - ncstat = NF90_OPEN(trim(swaclimfile),NF90_NOWRITE, ncid) - IF (ncstat.NE.NF90_NOERR ) THEN - CALL xchalt('(ini_swa_clim: Problem with netCDF1)') - stop '(ini_swa_clim: Problem with netCDF1)' - END IF - END IF - - ! Read data - call read_netcdf_var(ncid,'swa',swa_clim(1,1,1),1,1,0) - - ! Close file - IF(mnproc==1) THEN - ncstat = NF90_CLOSE(ncid) - IF ( ncstat .NE. NF90_NOERR ) THEN - CALL xchalt('(ini_swa_clim: Problem with netCDF200)') - stop '(ini_swa_clim: Problem with netCDF200)' + ! Close file + IF(mnproc==1) THEN + ncstat = NF90_CLOSE(ncid) + IF ( ncstat .NE. NF90_NOERR ) THEN + CALL xchalt('(ini_swa_clim: Problem with netCDF200)') + stop '(ini_swa_clim: Problem with netCDF200)' + END IF END IF - END IF - if (mnproc.eq.1) then - write(io_stdo_bgc,*) '' - write(io_stdo_bgc,*) 'ini_swa_clim: Using climatology swa file '//trim(swaclimfile) - endif + if (mnproc.eq.1) then + write(io_stdo_bgc,*) '' + write(io_stdo_bgc,*) 'ini_swa_clim: Using climatology swa file '//trim(swaclimfile) + endif - ! set flux to zero over land - do j=1,kpje - do i=1,kpie + ! set flux to zero over land + do j=1,kpje + do i=1,kpie - if(omask(i,j).lt.0.5) swa_clim(i,j,1) = 0.0 - + if(omask(i,j).lt.0.5) swa_clim(i,j,1) = 0.0 + + enddo enddo - enddo - RETURN + RETURN -!****************************************************************************** -end subroutine ini_swa_clim + !****************************************************************************** + end subroutine ini_swa_clim -!****************************************************************************** + !****************************************************************************** end module mo_clim_swa - diff --git a/hamocc/mo_control_bgc.F90 b/hamocc/mo_control_bgc.F90 index c2392b44..38e69b6f 100644 --- a/hamocc/mo_control_bgc.F90 +++ b/hamocc/mo_control_bgc.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/. MODULE mo_control_bgc @@ -27,7 +27,7 @@ MODULE mo_control_bgc ! -------- ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 ! - removed unused variables - ! + ! ! Purpose ! ------- ! - declaration @@ -57,7 +57,7 @@ MODULE mo_control_bgc REAL :: rmasks = 0.0 ! value at wet cells in sediment. REAL :: rmasko = 99999.00 ! value at wet cells in ocean. - ! Logical switches set via namelist + ! 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 @@ -92,20 +92,20 @@ subroutine get_bgc_namelist 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 + 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 diff --git a/hamocc/mo_ini_fields.F90 b/hamocc/mo_ini_fields.F90 index e857a134..8a848fa5 100644 --- a/hamocc/mo_ini_fields.F90 +++ b/hamocc/mo_ini_fields.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_ini_fields @@ -24,7 +24,7 @@ module mo_ini_fields public :: ini_fields_ocean,ini_fields_atm - contains +contains !--------------------------------------------------------------------------------------------------------------------------------- subroutine ini_fields_atm(kpie,kpje) @@ -46,205 +46,205 @@ subroutine ini_fields_atm(kpie,kpje) INTEGER :: i,j DO j=1,kpje - DO i=1,kpie - atm(i,j,iatmco2) = atm_co2 - atm(i,j,iatmo2) = atm_o2 - atm(i,j,iatmn2) = atm_n2 - if (use_natDIC) then - atm(i,j,iatmnco2) = atm_co2_nat - endif - if (use_cisonew) then - atm(i,j,iatmc13) = atm_c13 - atm(i,j,iatmc14) = atm_c14/c14fac - endif - if (use_BROMO) then - atm(i,j,iatmbromo)= atm_bromo - endif - ENDDO + DO i=1,kpie + atm(i,j,iatmco2) = atm_co2 + atm(i,j,iatmo2) = atm_o2 + atm(i,j,iatmn2) = atm_n2 + if (use_natDIC) then + atm(i,j,iatmnco2) = atm_co2_nat + endif + if (use_cisonew) then + atm(i,j,iatmc13) = atm_c13 + atm(i,j,iatmc14) = atm_c14/c14fac + endif + if (use_BROMO) then + atm(i,j,iatmbromo)= atm_bromo + endif + ENDDO ENDDO end subroutine ini_fields_atm SUBROUTINE ini_fields_ocean(kpaufr,kpie,kpje,kpke,kbnd,pddpo,prho,omask,pglon,pglat) -!****************************************************************************** -! -! BELEG_VARS - initialize bgc variables. -! -! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 -! -! Modified -! -------- -! J.Schwinger, *NORCE Climate, Bergen* 2020-05-19 -! -split the original BELEG_BGC in two parts, BELEG_PARM (NOW MO_PARAM_BGC) and BELEG_VARS -! -! -! Purpose -! ------- -! - set initial values for bgc variables. -! -! -! Parameter list: -! --------------- -! *INTEGER* *kpaufr* - 1/0 flag, 1 indicating a restart run -! *INTEGER* *kpie* - 1st dimension of model grid. -! *INTEGER* *kpje* - 2nd dimension of model grid. -! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. -! *INTEGER* *kbnd* - nb of halo grid points -! *REAL* *pddpo* - size of grid cell (3rd dimension) [m]. -! *REAL* *prho* - density [g/cm^3]. -! *REAL* *omask* - ocean mask. -! *REAL* *pglon* - longitude of grid cell [deg]. -! *REAL* *pglat* - latitude of grid cell [deg]. -! -! -!****************************************************************************** + !****************************************************************************** + ! + ! BELEG_VARS - initialize bgc variables. + ! + ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 + ! + ! Modified + ! -------- + ! J.Schwinger, *NORCE Climate, Bergen* 2020-05-19 + ! -split the original BELEG_BGC in two parts, BELEG_PARM (NOW MO_PARAM_BGC) and BELEG_VARS + ! + ! + ! Purpose + ! ------- + ! - set initial values for bgc variables. + ! + ! + ! Parameter list: + ! --------------- + ! *INTEGER* *kpaufr* - 1/0 flag, 1 indicating a restart run + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. + ! *INTEGER* *kbnd* - nb of halo grid points + ! *REAL* *pddpo* - size of grid cell (3rd dimension) [m]. + ! *REAL* *prho* - density [g/cm^3]. + ! *REAL* *omask* - ocean mask. + ! *REAL* *pglon* - longitude of grid cell [deg]. + ! *REAL* *pglat* - latitude of grid cell [deg]. + ! + ! + !****************************************************************************** - use mo_carbch, only: co2star,co3,hi,ocetra - use mo_param_bgc, only: fesoly,cellmass,fractdim,bifr13,bifr14,c14fac,re1312,re14to - use mo_biomod, only: abs_oce - 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, & - 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 - use mo_carbch, only: nathi,natco3 - use mo_sedmnt, only: sedhpl,burial,powtra,sedlay + use mo_carbch, only: co2star,co3,hi,ocetra + use mo_param_bgc, only: fesoly,cellmass,fractdim,bifr13,bifr14,c14fac,re1312,re14to + use mo_biomod, only: abs_oce + 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, & + 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 + use mo_carbch, only: nathi,natco3 + use mo_sedmnt, only: sedhpl,burial,powtra,sedlay - implicit none + implicit none - INTEGER, intent(in) :: kpaufr,kpie,kpje,kpke,kbnd - REAL, intent(in) :: pddpo(kpie,kpje,kpke) - REAL, intent(in) :: prho (kpie,kpje,kpke) - REAL, intent(in) :: omask(kpie,kpje) - REAL, intent(in) :: pglon(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - REAL, intent(in) :: pglat(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) + INTEGER, intent(in) :: kpaufr,kpie,kpje,kpke,kbnd + REAL, intent(in) :: pddpo(kpie,kpje,kpke) + REAL, intent(in) :: prho (kpie,kpje,kpke) + REAL, intent(in) :: omask(kpie,kpje) + REAL, intent(in) :: pglon(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) + REAL, intent(in) :: pglat(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - ! local variables - INTEGER :: i,j,k,l - REAL :: rco213,rco214,beta13,beta14 ! cisonew - REAL :: snow ! AGG + ! local variables + INTEGER :: i,j,k,l + 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 + 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 - endif -! -! Initialisation of ocean tracers and sediment -! + ENDDO + ENDDO + ENDDO + endif + ! + ! Initialisation of ocean tracers and sediment + ! -! Initialise ocean tracers with WOA and GLODAP data. This is done even in case -! of a restart since some tracers (e.g. C-isotopes) might not be in the restart -! file and aufr.f90 instead expects an initialised field. - call profile_gd(kpie,kpje,kpke,kbnd,pglon,pglat,omask) + ! Initialise ocean tracers with WOA and GLODAP data. This is done even in case + ! of a restart since some tracers (e.g. C-isotopes) might not be in the restart + ! file and aufr.f90 instead expects an initialised field. + call profile_gd(kpie,kpje,kpke,kbnd,pglon,pglat,omask) -! If this is a restart run initialisation is done in aufr.F90 - IF(kpaufr.EQ.1) RETURN + ! If this is a restart run initialisation is done in aufr.F90 + IF(kpaufr.EQ.1) RETURN - DO k=1,kpke + DO k=1,kpke DO j=1,kpje - DO i=1,kpie - IF (omask(i,j) .GT. 0.5 ) THEN - ! convert WOA tracers kmol/m^3 -> mol/kg; GLODAP dic and alk - ! are already in mol/kg. We need these units here, since after - ! initialisation the tracer field is passed to the ocean model - ! first where units are mol/kg. - ocetra(i,j,k,iphosph) = ocetra(i,j,k,iphosph)/prho(i,j,k) - 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) - 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) + DO i=1,kpie + IF (omask(i,j) .GT. 0.5 ) THEN + ! convert WOA tracers kmol/m^3 -> mol/kg; GLODAP dic and alk + ! are already in mol/kg. We need these units here, since after + ! initialisation the tracer field is passed to the ocean model + ! first where units are mol/kg. + ocetra(i,j,k,iphosph) = ocetra(i,j,k,iphosph)/prho(i,j,k) + 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) + 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 - ENDIF - ENDDO - ENDDO + ! 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 + ENDIF + ENDDO ENDDO + ENDDO -! Initialise remaining ocean tracers - DO k=1,kpke + ! Initialise remaining ocean tracers + DO k=1,kpke DO j=1,kpje - DO i=1,kpie - IF(omask(i,j) .GT. 0.5) THEN - ocetra(i,j,k,igasnit)=1.e-10 - ocetra(i,j,k,idoc) =1.e-8 - ocetra(i,j,k,iphy) =1.e-8 - ocetra(i,j,k,izoo) =1.e-8 - ocetra(i,j,k,idet) =1.e-8 - ocetra(i,j,k,icalc) =0. - ocetra(i,j,k,iopal) =1.e-8 - ocetra(i,j,k,ian2o) =0. - ocetra(i,j,k,idms) =0. - ocetra(i,j,k,ifdust) =0. - ocetra(i,j,k,iiron) =fesoly - ocetra(i,j,k,iprefo2)=0. - ocetra(i,j,k,iprefpo4)=0. - ocetra(i,j,k,iprefalk)=0. - ocetra(i,j,k,iprefdic)=0. - ocetra(i,j,k,idicsat)=1.e-8 - hi(i,j,k) =1.e-8 - co3(i,j,k) =0. - co2star(i,j,k) =20.e-6 - 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. - endif - if (use_CFC) then - ocetra(i,j,k,icfc11) =0. - ocetra(i,j,k,icfc12) =0. - ocetra(i,j,k,isf6) =0. - endif - if (use_natDIC) then - nathi(i,j,k) =1.e-8 - natco3(i,j,k) =0. - ocetra(i,j,k,inatcalc) =0. - endif - 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 - endif - 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) - endif - ENDIF ! omask > 0.5 - ENDDO - ENDDO + DO i=1,kpie + IF(omask(i,j) .GT. 0.5) THEN + ocetra(i,j,k,igasnit)=1.e-10 + ocetra(i,j,k,idoc) =1.e-8 + ocetra(i,j,k,iphy) =1.e-8 + ocetra(i,j,k,izoo) =1.e-8 + ocetra(i,j,k,idet) =1.e-8 + ocetra(i,j,k,icalc) =0. + ocetra(i,j,k,iopal) =1.e-8 + ocetra(i,j,k,ian2o) =0. + ocetra(i,j,k,idms) =0. + ocetra(i,j,k,ifdust) =0. + ocetra(i,j,k,iiron) =fesoly + ocetra(i,j,k,iprefo2)=0. + ocetra(i,j,k,iprefpo4)=0. + ocetra(i,j,k,iprefalk)=0. + ocetra(i,j,k,iprefdic)=0. + ocetra(i,j,k,idicsat)=1.e-8 + hi(i,j,k) =1.e-8 + co3(i,j,k) =0. + co2star(i,j,k) =20.e-6 + 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. + endif + if (use_CFC) then + ocetra(i,j,k,icfc11) =0. + ocetra(i,j,k,icfc12) =0. + ocetra(i,j,k,isf6) =0. + endif + if (use_natDIC) then + nathi(i,j,k) =1.e-8 + natco3(i,j,k) =0. + ocetra(i,j,k,inatcalc) =0. + endif + 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 + endif + 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) + endif + ENDIF ! omask > 0.5 + ENDDO ENDDO + ENDDO -! Initialise preformed tracers in the mixed layer; note that the -! whole field has been initialised to zero above - DO j=1,kpje + ! Initialise preformed tracers in the mixed layer; note that the + ! whole field has been initialised to zero above + DO j=1,kpje DO i=1,kpie IF(omask(i,j) .GT. 0.5) THEN ocetra(i,j,1:kmle(i,j),iprefo2) = ocetra(i,j,1:kmle(i,j),ioxygen) @@ -253,76 +253,76 @@ SUBROUTINE ini_fields_ocean(kpaufr,kpie,kpje,kpke,kbnd,pddpo,prho,omask,pglon,pg ocetra(i,j,1:kmle(i,j),iprefdic) = ocetra(i,j,1:kmle(i,j),isco212) ENDIF ENDDO - ENDDO + ENDDO -! Initial values for sediment - if (.not. use_sedbypass) then - DO k=1,ks - DO j=1,kpje - DO i=1,kpie + ! Initial values for sediment + 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 - endif + 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 + 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 - 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 - endif + 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 + endif ENDIF - ENDDO - ENDDO - ENDDO + ENDDO + ENDDO + ENDDO - ! last and final sediment layer - DO l=1,nsedtra - DO j=1,kpje - DO i=1,kpie + ! 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 + ENDDO + ENDDO + ENDDO + endif - return -!****************************************************************************** + return + !****************************************************************************** end subroutine ini_fields_ocean end module mo_ini_fields diff --git a/hamocc/mo_intfcblom.F90 b/hamocc/mo_intfcblom.F90 index f038c6ff..c618f07a 100644 --- a/hamocc/mo_intfcblom.F90 +++ b/hamocc/mo_intfcblom.F90 @@ -3,66 +3,66 @@ ! 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_intfcblom -!****************************************************************************** -! -! MODULE mo_intfcblom - Variables for BLOM-iHAMOCC interface -! -! J.Schwinger, *NORCE Climate, Bergen* 2020-05-19 -! -! Modified -! -------- -! -! Purpose -! ------- -! Declaration and memory allocation related to the BLOM-iHAMOCC interface. -! This includes 2-time-level copies of sediment and amospheric fields. -! -! Description: -! ------------ -! Public routines and variable of this module: -! -! -subroutine alloc_mem_intfcblom -! Allocate memory for BLOM interface variables -! -! -subroutine blom2hamocc -! Transfer fields from BLOM to HAMOCC -! -! -subroutine hamocc2blom -! Transfer fields from HAMOCC to BLOM -! -! -! *nphys* *INTEGER* - number of bgc timesteps per ocean timestep. -! *bgc_dx* *REAL* - size of grid cell (longitudinal) [m]. -! *bgc_dx* *REAL* - size of grid cell (latitudinal) [m]. -! *bgc_dp* *REAL* - size of grid cell (depth) [m]. -! *bgc_rho* *REAL* - sea water density [kg/m^3]. -! *omask* *REAL* - land ocean mask. -! -! The following arrays are used to keep a two time-level copy of sediment -! and prognostic atmosphere fields. These arrays are copied back and forth -! in blom2hamocc.F and hamocc2blom.F in the same manner as the tracer field. -! Also, they written/read to and from restart files: -! -! *sedlay2* *REAL* - two time-level copy of sedlay -! *powtra2* *REAL* - two time-level copy of powtra -! *burial2* *REAL* - two time-level copy of burial -! *atm2* *REAL* - two time-level copy of atm -! -!****************************************************************************** + !****************************************************************************** + ! + ! MODULE mo_intfcblom - Variables for BLOM-iHAMOCC interface + ! + ! J.Schwinger, *NORCE Climate, Bergen* 2020-05-19 + ! + ! Modified + ! -------- + ! + ! Purpose + ! ------- + ! Declaration and memory allocation related to the BLOM-iHAMOCC interface. + ! This includes 2-time-level copies of sediment and amospheric fields. + ! + ! Description: + ! ------------ + ! Public routines and variable of this module: + ! + ! -subroutine alloc_mem_intfcblom + ! Allocate memory for BLOM interface variables + ! + ! -subroutine blom2hamocc + ! Transfer fields from BLOM to HAMOCC + ! + ! -subroutine hamocc2blom + ! Transfer fields from HAMOCC to BLOM + ! + ! + ! *nphys* *INTEGER* - number of bgc timesteps per ocean timestep. + ! *bgc_dx* *REAL* - size of grid cell (longitudinal) [m]. + ! *bgc_dx* *REAL* - size of grid cell (latitudinal) [m]. + ! *bgc_dp* *REAL* - size of grid cell (depth) [m]. + ! *bgc_rho* *REAL* - sea water density [kg/m^3]. + ! *omask* *REAL* - land ocean mask. + ! + ! The following arrays are used to keep a two time-level copy of sediment + ! and prognostic atmosphere fields. These arrays are copied back and forth + ! in blom2hamocc.F and hamocc2blom.F in the same manner as the tracer field. + ! Also, they written/read to and from restart files: + ! + ! *sedlay2* *REAL* - two time-level copy of sedlay + ! *powtra2* *REAL* - two time-level copy of powtra + ! *burial2* *REAL* - two time-level copy of burial + ! *atm2* *REAL* - two time-level copy of atm + ! + !****************************************************************************** use mo_control_bgc, only: use_sedbypass,use_BOXATM implicit none @@ -84,464 +84,464 @@ module mo_intfcblom real, allocatable :: atm2(:,:,:,:) contains -!****************************************************************************** + !****************************************************************************** -subroutine alloc_mem_intfcblom(kpie,kpje,kpke) -!****************************************************************************** -! -! ALLOC_MEM_VGRID - Allocate variables in this module -! -! J.Schwinger *NORCE Climate, Bergen* 2020-05-19 -! -!****************************************************************************** - use mod_xc, only: mnproc - use mo_control_bgc, only: io_stdo_bgc - use mo_param1_bgc, only: ks,nsedtra,npowtra,natm + subroutine alloc_mem_intfcblom(kpie,kpje,kpke) + !****************************************************************************** + ! + ! ALLOC_MEM_VGRID - Allocate variables in this module + ! + ! J.Schwinger *NORCE Climate, Bergen* 2020-05-19 + ! + !****************************************************************************** + use mod_xc, only: mnproc + use mo_control_bgc, only: io_stdo_bgc + use mo_param1_bgc, only: ks,nsedtra,npowtra,natm - INTEGER, intent(in) :: kpie,kpje,kpke - INTEGER :: errstat + INTEGER, intent(in) :: kpie,kpje,kpke + INTEGER :: errstat - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'***************************************************' - WRITE(io_stdo_bgc,*)'Memory allocation for module mo_intfcblom :' - WRITE(io_stdo_bgc,*)' ' - ENDIF + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)' ' + WRITE(io_stdo_bgc,*)'***************************************************' + WRITE(io_stdo_bgc,*)'Memory allocation for module mo_intfcblom :' + WRITE(io_stdo_bgc,*)' ' + ENDIF - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable bgc_dx, bgc_dy ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable bgc_dx, bgc_dy ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + ENDIF - ALLOCATE (bgc_dx(kpie,kpje),stat=errstat) - ALLOCATE (bgc_dy(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory bgc_dx, bgc_dy' - bgc_dx(:,:) = 0.0 - bgc_dy(:,:) = 0.0 + ALLOCATE (bgc_dx(kpie,kpje),stat=errstat) + ALLOCATE (bgc_dy(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory bgc_dx, bgc_dy' + bgc_dx(:,:) = 0.0 + bgc_dy(:,:) = 0.0 - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable bgc_dp ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',kpke - ENDIF + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable bgc_dp ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',kpke + ENDIF - ALLOCATE (bgc_dp(kpie,kpje,kpke),stat=errstat) - if(errstat.ne.0) stop 'not enough memory bgc_dp' - bgc_dp(:,:,:) = 0.0 + ALLOCATE (bgc_dp(kpie,kpje,kpke),stat=errstat) + if(errstat.ne.0) stop 'not enough memory bgc_dp' + bgc_dp(:,:,:) = 0.0 - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable bgc_rho ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',kpke - ENDIF + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable bgc_rho ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',kpke + ENDIF - ALLOCATE (bgc_rho(kpie,kpje,kpke),stat=errstat) - if(errstat.ne.0) stop 'not enough memory bgc_dp' - bgc_rho(:,:,:) = 0.0 + ALLOCATE (bgc_rho(kpie,kpje,kpke),stat=errstat) + if(errstat.ne.0) stop 'not enough memory bgc_dp' + bgc_rho(:,:,:) = 0.0 - IF(mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable omask ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF + IF(mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable omask ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + ENDIF - ALLOCATE(omask(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory omask' - omask(:,:) = 0.0 + ALLOCATE(omask(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory omask' + omask(:,:) = 0.0 - if (.not. use_sedbypass) then - IF(mnproc.eq.1) THEN + 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 + ENDIF - IF(mnproc.eq.1) THEN + 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 + ENDIF - ALLOCATE (powtra2(kpie,kpje,2*ks,npowtra),stat=errstat) - if(errstat.ne.0) stop 'not enough memory powtra2' - powtra2(:,:,:,:) = 0.0 + 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 + 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 + ENDIF - ALLOCATE (burial2(kpie,kpje,2,nsedtra),stat=errstat) - if(errstat.ne.0) stop 'not enough memory burial2' - burial2(:,:,:,:) = 0.0 - endif + ALLOCATE (burial2(kpie,kpje,2,nsedtra),stat=errstat) + if(errstat.ne.0) stop 'not enough memory burial2' + burial2(:,:,:,:) = 0.0 + endif - if (use_BOXATM) then - IF (mnproc.eq.1) THEN + 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 - endif - -end subroutine alloc_mem_intfcblom -!****************************************************************************** - - - -subroutine blom2hamocc(m,n,mm,nn) -!****************************************************************************** -! -!**** *SUBROUTINE blom2hammoc* - Interface between BLOM and HAMOCC. -! -! K. Assmann *GFI, UiB initial version -! J. Schwinger *GFI, UiB 2013-04-22 -! - -! -! Modified -! -------- -! J.Schwinger, *Uni Research, Bergen* 2018-04-12 -! - removed inverse of layer thickness -! - added sediment bypass preprocessor option -! -! M. Bentsen, *NORCE, Bergen* 2020-05-03 -! - changed ocean model from MICOM to BLOM -! -! T. Torsvik, *University of Bergen* 2021-08-26 -! - integrate subroutine into module mo_intfcblom -! -! Purpose -! ------- -! - -! -!****************************************************************************** -! - use mod_constants, only: onem - use mod_xc, only: ii,jdm,jj,kdm,kk,ifp,isp,ilp,idm - use mod_grid, only: scpx,scpy - use mod_state, only: dp,temp,saln - use mod_eos, only: rho,p_alpha - use mod_difest, only: hOBL - use mod_tracers, only: ntrbgc,itrbgc,trc - use mo_param1_bgc, only: ks,nsedtra,npowtra,natm - use mo_carbch, only: ocetra,atm - use mo_sedmnt, only: sedlay,powtra,sedhpl,burial - use mo_vgrid, only: kmle, kmle_static - - implicit none - - integer, intent(in) :: m,n,mm,nn - - integer :: i,j,k,l,nns,kn - real :: p1,p2,ldp,th,s,pa - real :: rp(idm,jdm,kdm+1) - - nns=(n-1)*ks - - rp(:,:,:) = 0.0 - -! --- calculate pressure at interfaces (necesarry since p has -! --- not been calculated at restart) - -!$OMP PARALLEL DO PRIVATE(k,kn,l,i) - do k=1,kk - kn=k+nn - do j=1,jj - do l=1,isp(j) - do i=max(1,ifp(j,l)),min(ii,ilp(j,l)) - rp(i,j,k+1) = rp(i,j,k) + dp(i,j,kn) - enddo - enddo - enddo - enddo -!$OMP END PARALLEL DO - -! --- ------------------------------------------------------------------ -! --- 2D fields -! --- ------------------------------------------------------------------ - -!$OMP PARALLEL DO PRIVATE(i) - do j=1,jj - do i=1,ii -! -! --- - dimension of grid box in meters - bgc_dx(i,j) = scpx(i,j)/1.e2 - bgc_dy(i,j) = scpy(i,j)/1.e2 -! -! --- - index of level above OBL depth -! --- isopycninc coords: hOBL(i,j) = hOBL_static = 3. => kmle(i,j) = 2 -! --- hybrid coords: hOBL defined according to cvmix_kpp_compute_kOBL_depth - kmle(i,j) = nint(hOBL(i,j))-1 - enddo - enddo -!$OMP END PARALLEL DO - -! --- ------------------------------------------------------------------ -! --- 3D fields -! --- ------------------------------------------------------------------ - -!$OMP PARALLEL DO PRIVATE(k,kn,l,i,th,s,p1,p2,ldp,pa) - do k=1,kk - kn=k+nn - do j=1,jj - do l=1,isp(j) - do i=max(1,ifp(j,l)),min(ii,ilp(j,l)) -! -! --- - integrated specific volume - th = temp(i,j,kn) - s = saln(i,j,kn) - p1 = rp(i,j,k) - if(dp(i,j,kn) == 0.0) then - ldp = 1.0 - pa = ldp/rho(p1,th,s) - else if(dp(i,j,kn) < 1.0e-2) then - ldp = dp(i,j,kn) - pa = ldp/rho(p1,th,s) - else - ldp = dp(i,j,kn) - p2 = p1+ldp - pa = p_alpha(p1,p2,th,s) - endif -! -! --- - density in g/cm^3 - bgc_rho(i,j,k)=ldp/pa -! -! --- - layer thickness in meters - bgc_dp(i,j,k) = 0.0 - if(dp(i,j,kn).ne.0.0) bgc_dp(i,j,k) = pa / onem - enddo - enddo - enddo - enddo -!$OMP END PARALLEL DO - -! --- ------------------------------------------------------------------ -! --- - return if restart (HAMOCC fields are not allocated yet) -! --- ------------------------------------------------------------------ - if( .not. allocated(ocetra) ) return - -! --- ------------------------------------------------------------------ -! --- pass tracer fields from ocean model; convert mol/kg -> kmol/m^3 -! --- ------------------------------------------------------------------ - -!$OMP PARALLEL DO PRIVATE(k,kn,l,i) - do k=1,kk - kn=k+nn - do j=1,jj - do l=1,isp(j) - do i=max(1,ifp(j,l)),min(ii,ilp(j,l)) - ocetra(i,j,k,:) = trc(i,j,kn,itrbgc:itrbgc+ntrbgc-1) * bgc_rho(i,j,k) - enddo - enddo - enddo - enddo -!$OMP END PARALLEL DO - -! --- ------------------------------------------------------------------ -! --- pass sediments fields (a two time-level copy of sediment fields -! --- is kept outside HAMOCC) -! --- ------------------------------------------------------------------ - - 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 + ENDIF + + ALLOCATE (atm2(kpie,kpje,2,natm),stat=errstat) + if(errstat.ne.0) stop 'not enough memory atm2' + atm2(:,:,:,:) = 0.0 + endif + + end subroutine alloc_mem_intfcblom + !****************************************************************************** + + + + subroutine blom2hamocc(m,n,mm,nn) + !****************************************************************************** + ! + !**** *SUBROUTINE blom2hammoc* - Interface between BLOM and HAMOCC. + ! + ! K. Assmann *GFI, UiB initial version + ! J. Schwinger *GFI, UiB 2013-04-22 + ! - + ! + ! Modified + ! -------- + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - removed inverse of layer thickness + ! - added sediment bypass preprocessor option + ! + ! M. Bentsen, *NORCE, Bergen* 2020-05-03 + ! - changed ocean model from MICOM to BLOM + ! + ! T. Torsvik, *University of Bergen* 2021-08-26 + ! - integrate subroutine into module mo_intfcblom + ! + ! Purpose + ! ------- + ! - + ! + !****************************************************************************** + ! + use mod_constants, only: onem + use mod_xc, only: ii,jdm,jj,kdm,kk,ifp,isp,ilp,idm + use mod_grid, only: scpx,scpy + use mod_state, only: dp,temp,saln + use mod_eos, only: rho,p_alpha + use mod_difest, only: hOBL + use mod_tracers, only: ntrbgc,itrbgc,trc + use mo_param1_bgc, only: ks,nsedtra,npowtra,natm + use mo_carbch, only: ocetra,atm + use mo_sedmnt, only: sedlay,powtra,sedhpl,burial + use mo_vgrid, only: kmle, kmle_static + + implicit none + + integer, intent(in) :: m,n,mm,nn + + integer :: i,j,k,l,nns,kn + real :: p1,p2,ldp,th,s,pa + real :: rp(idm,jdm,kdm+1) + + nns=(n-1)*ks + + rp(:,:,:) = 0.0 + + ! --- calculate pressure at interfaces (necesarry since p has + ! --- not been calculated at restart) + + !$OMP PARALLEL DO PRIVATE(k,kn,l,i) + do k=1,kk + kn=k+nn + 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,:) + do i=max(1,ifp(j,l)),min(ii,ilp(j,l)) + rp(i,j,k+1) = rp(i,j,k) + dp(i,j,kn) + enddo enddo + enddo + enddo + !$OMP END PARALLEL DO + + ! --- ------------------------------------------------------------------ + ! --- 2D fields + ! --- ------------------------------------------------------------------ + + !$OMP PARALLEL DO PRIVATE(i) + do j=1,jj + do i=1,ii + ! + ! --- - dimension of grid box in meters + bgc_dx(i,j) = scpx(i,j)/1.e2 + bgc_dy(i,j) = scpy(i,j)/1.e2 + ! + ! --- - index of level above OBL depth + ! --- isopycninc coords: hOBL(i,j) = hOBL_static = 3. => kmle(i,j) = 2 + ! --- hybrid coords: hOBL defined according to cvmix_kpp_compute_kOBL_depth + kmle(i,j) = nint(hOBL(i,j))-1 + enddo + enddo + !$OMP END PARALLEL DO + + ! --- ------------------------------------------------------------------ + ! --- 3D fields + ! --- ------------------------------------------------------------------ + + !$OMP PARALLEL DO PRIVATE(k,kn,l,i,th,s,p1,p2,ldp,pa) + do k=1,kk + kn=k+nn + do j=1,jj + do l=1,isp(j) + do i=max(1,ifp(j,l)),min(ii,ilp(j,l)) + ! + ! --- - integrated specific volume + th = temp(i,j,kn) + s = saln(i,j,kn) + p1 = rp(i,j,k) + if(dp(i,j,kn) == 0.0) then + ldp = 1.0 + pa = ldp/rho(p1,th,s) + else if(dp(i,j,kn) < 1.0e-2) then + ldp = dp(i,j,kn) + pa = ldp/rho(p1,th,s) + else + ldp = dp(i,j,kn) + p2 = p1+ldp + pa = p_alpha(p1,p2,th,s) + endif + ! + ! --- - density in g/cm^3 + bgc_rho(i,j,k)=ldp/pa + ! + ! --- - layer thickness in meters + bgc_dp(i,j,k) = 0.0 + if(dp(i,j,kn).ne.0.0) bgc_dp(i,j,k) = pa / onem + enddo enddo + enddo + enddo + !$OMP END PARALLEL DO + + ! --- ------------------------------------------------------------------ + ! --- - return if restart (HAMOCC fields are not allocated yet) + ! --- ------------------------------------------------------------------ + if( .not. allocated(ocetra) ) return + + ! --- ------------------------------------------------------------------ + ! --- pass tracer fields from ocean model; convert mol/kg -> kmol/m^3 + ! --- ------------------------------------------------------------------ + + !$OMP PARALLEL DO PRIVATE(k,kn,l,i) + do k=1,kk + kn=k+nn + do j=1,jj + do l=1,isp(j) + do i=max(1,ifp(j,l)),min(ii,ilp(j,l)) + ocetra(i,j,k,:) = trc(i,j,kn,itrbgc:itrbgc+ntrbgc-1) * bgc_rho(i,j,k) + enddo enddo - enddo - !$OMP END PARALLEL DO - - endif + enddo + enddo + !$OMP END PARALLEL DO + + ! --- ------------------------------------------------------------------ + ! --- pass sediments fields (a two time-level copy of sediment fields + ! --- is kept outside HAMOCC) + ! --- ------------------------------------------------------------------ -! --- ------------------------------------------------------------------ -! --- pass atmosphere fields if required (a two time-level copy of -! --- atmosphere fields is kept outside HAMOCC) -! --- ------------------------------------------------------------------ + if (.not. use_sedbypass) then + nns=(n-1)*ks - 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 - endif + !$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 + !$OMP END PARALLEL DO -end subroutine blom2hamocc -!****************************************************************************** + endif + ! --- ------------------------------------------------------------------ + ! --- pass atmosphere fields if required (a two time-level copy of + ! --- atmosphere fields is kept outside HAMOCC) + ! --- ------------------------------------------------------------------ + 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 + endif + + end subroutine blom2hamocc + !****************************************************************************** + + + + subroutine hamocc2blom(m,n,mm,nn) + !****************************************************************************** + ! + !**** *SUBROUTINE hamocc2blom* - Interface between BLOM and HAMOCC. + ! + ! J. Schwinger *GFI, UiB 2014-05-21 initial version + ! - + ! + ! Modified + ! -------- + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - added sediment bypass preprocessor option + ! + ! M. Bentsen, *NORCE, Bergen* 2020-05-03 + ! - changed ocean model from MICOM to BLOM + ! + ! T. Torsvik, *University of Bergen* 2021-08-26 + ! - integrate subroutine into module mo_intfcblom + ! + ! Purpose + ! ------- + ! Pass flux and tracer fields back from HAMOCC to BLOM. + ! The local HAMOCC arrays are copied back in the appropriate + ! time-level of the tracer field. Note that also sediment fields + ! are copied back, since a two time-level copy of sediment fields + ! is kept outside HAMOCC. For the sediment fields the same time- + ! smothing as for the tracer field (i.e. analog to tmsmt2.F) is + ! performed to avoid a seperation of the two time levels. + ! + !****************************************************************************** + ! + use mod_xc, only: ii,jj,kk,ifp,ilp,isp + use mod_tracers, only: ntrbgc,itrbgc,trc + use mod_tmsmt, only: wts1, wts2 + use mo_carbch, only: ocetra,atm + use mo_param1_bgc, only: ks,nsedtra,npowtra,natm + use mo_sedmnt, only: sedlay,powtra,sedhpl,burial + + implicit none + + integer, intent(in) :: m,n,mm,nn + integer :: i,j,k,l,nns,mms,kn,km + + ! --- ------------------------------------------------------------------ + ! --- pass tracer fields to ocean model; convert kmol/m^3 -> mol/kg + ! --- ------------------------------------------------------------------ + + !$OMP PARALLEL DO PRIVATE(k,kn,l,i) + do k=1,kk + kn=k+nn + do j=1,jj + do l=1,isp(j) + do i=max(1,ifp(j,l)),min(ii,ilp(j,l)) + trc(i,j,kn,itrbgc:itrbgc+ntrbgc-1) = ocetra(i,j,k,:)/bgc_rho(i,j,k) + enddo + enddo + enddo + enddo + !$OMP END PARALLEL DO -subroutine hamocc2blom(m,n,mm,nn) -!****************************************************************************** -! -!**** *SUBROUTINE hamocc2blom* - Interface between BLOM and HAMOCC. -! -! J. Schwinger *GFI, UiB 2014-05-21 initial version -! - -! -! Modified -! -------- -! J.Schwinger, *Uni Research, Bergen* 2018-04-12 -! - added sediment bypass preprocessor option -! -! M. Bentsen, *NORCE, Bergen* 2020-05-03 -! - changed ocean model from MICOM to BLOM -! -! T. Torsvik, *University of Bergen* 2021-08-26 -! - integrate subroutine into module mo_intfcblom -! -! Purpose -! ------- -! Pass flux and tracer fields back from HAMOCC to BLOM. -! The local HAMOCC arrays are copied back in the appropriate -! time-level of the tracer field. Note that also sediment fields -! are copied back, since a two time-level copy of sediment fields -! is kept outside HAMOCC. For the sediment fields the same time- -! smothing as for the tracer field (i.e. analog to tmsmt2.F) is -! performed to avoid a seperation of the two time levels. -! -!****************************************************************************** -! - use mod_xc, only: ii,jj,kk,ifp,ilp,isp - use mod_tracers, only: ntrbgc,itrbgc,trc - use mod_tmsmt, only: wts1, wts2 - use mo_carbch, only: ocetra,atm - use mo_param1_bgc, only: ks,nsedtra,npowtra,natm - use mo_sedmnt, only: sedlay,powtra,sedhpl,burial + ! --- ------------------------------------------------------------------ + ! --- apply time smoothing for sediment fields and pass them back + ! --- ------------------------------------------------------------------ - implicit none + if (.not. use_sedbypass) then + nns=(n-1)*ks + mms=(m-1)*ks - integer, intent(in) :: m,n,mm,nn - integer :: i,j,k,l,nns,mms,kn,km - -! --- ------------------------------------------------------------------ -! --- pass tracer fields to ocean model; convert kmol/m^3 -> mol/kg -! --- ------------------------------------------------------------------ - -!$OMP PARALLEL DO PRIVATE(k,kn,l,i) - do k=1,kk - kn=k+nn - do j=1,jj - do l=1,isp(j) - do i=max(1,ifp(j,l)),min(ii,ilp(j,l)) - trc(i,j,kn,itrbgc:itrbgc+ntrbgc-1) = ocetra(i,j,k,:)/bgc_rho(i,j,k) - enddo - enddo - enddo - enddo -!$OMP END PARALLEL DO - -! --- ------------------------------------------------------------------ -! --- apply time smoothing for sediment fields and pass them back -! --- ------------------------------------------------------------------ - - 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 + !$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 + 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 + enddo + !$OMP END PARALLEL DO - !$OMP PARALLEL DO PRIVATE(k,kn,l,i) - do k=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)) - 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,:) + 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 + !$OMP END PARALLEL DO + + endif ! .not. use_sedbypass + + ! --- ------------------------------------------------------------------ + ! --- apply time smoothing for atmosphere fields if required + ! --- ------------------------------------------------------------------ + + 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 ! .not. use_sedbypass - -! --- ------------------------------------------------------------------ -! --- apply time smoothing for atmosphere fields if required -! --- ------------------------------------------------------------------ - - 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 - -end subroutine hamocc2blom -!****************************************************************************** + enddo + !$OMP END PARALLEL DO + endif + + end subroutine hamocc2blom + !****************************************************************************** end module mo_intfcblom diff --git a/hamocc/mo_param1_bgc.F90 b/hamocc/mo_param1_bgc.F90 index bac7d720..b62c475a 100644 --- a/hamocc/mo_param1_bgc.F90 +++ b/hamocc/mo_param1_bgc.F90 @@ -17,425 +17,425 @@ ! along with BLOM. If not, see https://www.gnu.org/licenses/. - MODULE mo_param1_bgc -!****************************************************************************** -! -! MODULE mo_param1_bgc - bgc tracer parameters. -! -! 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 -! 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 - implicit none - 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 :: 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 - - ! Indices for C-isotope tracers - 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 - - ! Indices for CFCs - integer, protected :: i_cfc - integer, protected :: icfc11 - integer, protected :: icfc12 - integer, protected :: isf6 - - ! Indices for tracers related to aggregation scheme - integer, protected :: i_agg - integer, protected :: inos - integer, protected :: iadust - - ! Indices for tracers related to natural DIC - integer, protected :: i_nat_dic - integer, protected :: inatsco212 - integer, protected :: inatalkali - integer, protected :: inatcalc - - ! Indices for bromoform tracer - 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 - - ! Indices of C-isotope tracers in atm - integer, protected :: i_iso_atm - integer, protected :: iatmc13 - integer, protected :: iatmc14 - - ! Indices of CFCs in atm - integer, protected :: i_cfc_atm - integer, protected :: iatmf11 - integer, protected :: iatmf12 - integer, protected :: iatmsf6 - - ! Indices for tracers related to natDIC scheme in atm - integer, protected :: i_ndic_atm - integer, protected :: iatmnco2 - - ! Indices for bromoform tracer in 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 - ! ------------------ - ! Indices for solid sediment components - integer, protected :: i_sed_base - integer, protected :: issso12 - integer, protected :: isssc12 - integer, protected :: issssil - integer, protected :: issster - - ! Indices for C-isotope tracers in sediment - integer, protected :: i_sed_cisonew - integer, protected :: issso13 - integer, protected :: issso14 - integer, protected :: isssc13 - integer, protected :: isssc14 - integer, protected :: nsedtra - - ! Indices for tracers in sediment pore water - 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 - - ! Indices for C-isotope tracers in sediment pore water - 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 - if (use_cisonew) then - map_por2octra(ipowc13) = isco213 - map_por2octra(ipowc14) = isco214 - endif - end subroutine init_por2octra_mapping - - ! =========================================================================== - subroutine init_indices() - - use mod_xc , only: lp, mnproc - use mo_control_bgc, only: bgc_namelist,get_bgc_namelist, io_stdo_bgc - use mo_control_bgc, only: use_BROMO, use_AGG, use_WLIN, use_natDIC, use_CFC, & - use_cisonew, use_sedbypass, & - use_PBGC_OCNP_TIMESTEP, use_PBGC_CK_TIMESTEP, & - use_FB_BGC_OCE, use_BOXATM - integer :: iounit - - namelist / config_bgc / use_BROMO, use_AGG, use_WLIN, & - use_natDIC, use_CFC, use_cisonew, use_sedbypass, use_PBGC_OCNP_TIMESTEP, & - use_PBGC_CK_TIMESTEP, use_FB_BGC_OCE, use_BOXATM - - io_stdo_bgc = lp ! standard out. - - if(.not. allocated(bgc_namelist)) call get_bgc_namelist() - open (newunit=iounit, file=bgc_namelist, status='old', action='read') - read (unit=iounit, nml=config_bgc) - close (unit=iounit) - - IF (mnproc.eq.1) THEN - write(io_stdo_bgc,*) - write(io_stdo_bgc,*) 'iHAMOCC: reading namelist CONFIG_BGC' - write(io_stdo_bgc,nml=config_bgc) - endif - - ! 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 - endif - 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 - endif - 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 - endif - 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 - endif - 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 - endif - - ! 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 - endif - 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 - endif - 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 - endif - 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 - endif - - ! 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 - endif - 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 - endif - npowtra = i_pow_base + i_pow_cisonew - - allocate(map_por2octra(-1:npowtra)) - - end subroutine init_indices - -!****************************************************************************** - END MODULE mo_param1_bgc +MODULE mo_param1_bgc + !****************************************************************************** + ! + ! MODULE mo_param1_bgc - bgc tracer parameters. + ! + ! 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 + ! 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 + implicit none + 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 :: 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 + + ! Indices for C-isotope tracers + 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 + + ! Indices for CFCs + integer, protected :: i_cfc + integer, protected :: icfc11 + integer, protected :: icfc12 + integer, protected :: isf6 + + ! Indices for tracers related to aggregation scheme + integer, protected :: i_agg + integer, protected :: inos + integer, protected :: iadust + + ! Indices for tracers related to natural DIC + integer, protected :: i_nat_dic + integer, protected :: inatsco212 + integer, protected :: inatalkali + integer, protected :: inatcalc + + ! Indices for bromoform tracer + 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 + + ! Indices of C-isotope tracers in atm + integer, protected :: i_iso_atm + integer, protected :: iatmc13 + integer, protected :: iatmc14 + + ! Indices of CFCs in atm + integer, protected :: i_cfc_atm + integer, protected :: iatmf11 + integer, protected :: iatmf12 + integer, protected :: iatmsf6 + + ! Indices for tracers related to natDIC scheme in atm + integer, protected :: i_ndic_atm + integer, protected :: iatmnco2 + + ! Indices for bromoform tracer in 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 + ! ------------------ + ! Indices for solid sediment components + integer, protected :: i_sed_base + integer, protected :: issso12 + integer, protected :: isssc12 + integer, protected :: issssil + integer, protected :: issster + + ! Indices for C-isotope tracers in sediment + integer, protected :: i_sed_cisonew + integer, protected :: issso13 + integer, protected :: issso14 + integer, protected :: isssc13 + integer, protected :: isssc14 + integer, protected :: nsedtra + + ! Indices for tracers in sediment pore water + 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 + + ! Indices for C-isotope tracers in sediment pore water + 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 + if (use_cisonew) then + map_por2octra(ipowc13) = isco213 + map_por2octra(ipowc14) = isco214 + endif + end subroutine init_por2octra_mapping + + ! =========================================================================== + subroutine init_indices() + + use mod_xc , only: lp, mnproc + use mo_control_bgc, only: bgc_namelist,get_bgc_namelist, io_stdo_bgc + use mo_control_bgc, only: use_BROMO, use_AGG, use_WLIN, use_natDIC, use_CFC, & + use_cisonew, use_sedbypass, & + use_PBGC_OCNP_TIMESTEP, use_PBGC_CK_TIMESTEP, & + use_FB_BGC_OCE, use_BOXATM + integer :: iounit + + namelist / config_bgc / use_BROMO, use_AGG, use_WLIN, & + use_natDIC, use_CFC, use_cisonew, use_sedbypass, use_PBGC_OCNP_TIMESTEP, & + use_PBGC_CK_TIMESTEP, use_FB_BGC_OCE, use_BOXATM + + io_stdo_bgc = lp ! standard out. + + if(.not. allocated(bgc_namelist)) call get_bgc_namelist() + open (newunit=iounit, file=bgc_namelist, status='old', action='read') + read (unit=iounit, nml=config_bgc) + close (unit=iounit) + + IF (mnproc.eq.1) THEN + write(io_stdo_bgc,*) + write(io_stdo_bgc,*) 'iHAMOCC: reading namelist CONFIG_BGC' + write(io_stdo_bgc,nml=config_bgc) + endif + + ! 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 + endif + 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 + endif + 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 + endif + 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 + endif + 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 + endif + + ! 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 + endif + 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 + endif + 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 + endif + 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 + endif + + ! 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 + endif + 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 + endif + npowtra = i_pow_base + i_pow_cisonew + + allocate(map_por2octra(-1:npowtra)) + + end subroutine init_indices + + !****************************************************************************** +END MODULE mo_param1_bgc diff --git a/hamocc/mo_param_bgc.F90 b/hamocc/mo_param_bgc.F90 index fadec14c..f4cf03d1 100644 --- a/hamocc/mo_param_bgc.F90 +++ b/hamocc/mo_param_bgc.F90 @@ -18,35 +18,35 @@ ! along with BLOM. If not, see https://www.gnu.org/licenses/. module mo_param_bgc -!****************************************************************************** -! -! BELEG_PARM - now mo_param_bgc - initialize bgc parameters. -! -! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 -! -! Modified -! -------- -! 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 -! -! Purpose -! ------- -! - set bgc parameter values. -! -! -! Parameter list: -! --------------- -! *INTEGER* *kpie* - 1st dimension of model grid. -! *INTEGER* *kpje* - 2nd dimension of model grid. -! -!****************************************************************************** + !****************************************************************************** + ! + ! BELEG_PARM - now mo_param_bgc - initialize bgc parameters. + ! + ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 + ! + ! Modified + ! -------- + ! 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 + ! + ! Purpose + ! ------- + ! - set bgc parameter values. + ! + ! + ! Parameter list: + ! --------------- + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! + !****************************************************************************** use mo_carbch, only: atm_co2 use mo_control_bgc, only: io_stdo_bgc,bgc_namelist,use_AGG,use_natDIC,use_BROMO,use_cisonew,use_WLIN,use_FB_BGC_OCE, & - & do_ndep,do_oalk,do_rivinpt,do_sedspinup,l_3Dvarsedpor,use_BOXATM,use_CFC,use_PBGC_CK_TIMESTEP, & - & use_sedbypass,with_dmsph,use_PBGC_OCNP_TIMESTEP,ocn_co2_type + & do_ndep,do_oalk,do_rivinpt,do_sedspinup,l_3Dvarsedpor,use_BOXATM,use_CFC,use_PBGC_CK_TIMESTEP, & + & use_sedbypass,with_dmsph,use_PBGC_OCNP_TIMESTEP,ocn_co2_type use mod_xc, only: mnproc implicit none @@ -58,13 +58,13 @@ module mo_param_bgc !Model parameters public :: ini_parambgc public :: ro2ut,rcar,rnit,rnoi,riron,rdnit0,rdnit1,rdnit2,rdn2o1,rdn2o2,atm_n2,atm_o2,atm_co2_nat,atm_bromo,re1312, & - re14to,prei13,prei14,ctochl,atten_w,atten_c,atten_uv,atten_f,fetune,perc_diron,fesoly,relaxfe,phytomi,pi_alpha,bkphy, & - dyphy,bluefix,tf2,tf1,tf0,tff,bifr13,bifr14,c14_t_half,rbro,fbro1,fbro2,grami,bkzoo,grazra,spemor,gammap,gammaz,ecan, & - zinges,epsher,bkopal,rcalc,ropal,calmax,remido,drempoc,dremopal,dremn2o,dremsul,wpoc,wcal,wopal,wmin,wmax,wlin, & - dustd1,dustd2,dustd3,dustsink,wdust,SinkExp, FractDim, Stick, cellmass, cellsink, fsh, fse,alow1, alow2,alow3,alar1, & - alar2,alar3,TSFac,TMFac,vsmall,safe,pupper,plower,zdis,nmldmin,beta13,alpha14,atm_c13,atm_c14,c14fac,c14dec, & - sedict,silsat,disso_poc,disso_sil,disso_caco3,sed_denit,calcwei,opalwei,orgwei,calcdens,opaldens,orgdens,claydens, & - dmsp1,dmsp2,dmsp3,dmsp4,dmsp5,dmsp6,dms_gamma + re14to,prei13,prei14,ctochl,atten_w,atten_c,atten_uv,atten_f,fetune,perc_diron,fesoly,relaxfe,phytomi,pi_alpha,bkphy, & + dyphy,bluefix,tf2,tf1,tf0,tff,bifr13,bifr14,c14_t_half,rbro,fbro1,fbro2,grami,bkzoo,grazra,spemor,gammap,gammaz,ecan, & + zinges,epsher,bkopal,rcalc,ropal,calmax,remido,drempoc,dremopal,dremn2o,dremsul,wpoc,wcal,wopal,wmin,wmax,wlin, & + dustd1,dustd2,dustd3,dustsink,wdust,SinkExp, FractDim, Stick, cellmass, cellsink, fsh, fse,alow1, alow2,alow3,alar1, & + alar2,alar3,TSFac,TMFac,vsmall,safe,pupper,plower,zdis,nmldmin,beta13,alpha14,atm_c13,atm_c14,c14fac,c14dec, & + sedict,silsat,disso_poc,disso_sil,disso_caco3,sed_denit,calcwei,opalwei,orgwei,calcdens,opaldens,orgdens,claydens, & + dmsp1,dmsp2,dmsp3,dmsp4,dmsp5,dmsp6,dms_gamma !................................................................................................................................. !................................................................................................................................. @@ -100,8 +100,8 @@ module mo_param_bgc real, protected :: atm_o2 = 196800. ! atmosphere oxygen concentration real, protected :: atm_co2_nat = 284.32 ! atmosphere CO2 concentration CMIP6 pre-industrial reference real, protected :: atm_bromo = 3.4 ! atmosphere bromophorme concentration - ! For now use 3.4ppt from Hense and Quack (2009; Biogeosciences) NEED TO - !BE UPDATED WITH Ziska et al. (2013) climatology database + ! For now use 3.4ppt from Hense and Quack (2009; Biogeosciences) NEED TO + !BE UPDATED WITH Ziska et al. (2013) climatology database ! set standard carbon isotope ratios real, protected :: re1312 = 0.0112372 real, protected :: re14to = 1.170e-12 ! Karlen et al. 1965 / Orr et al. 2017 @@ -132,7 +132,7 @@ module mo_param_bgc real, protected :: atten_c = 0.03*rcar*(12./ctochl)*1.e6 ! phytoplankton attenuation in 1/m real, protected :: atten_uv = 0.33 real, protected :: atten_f = 0.4 ! fraction of sw-radiation directly absorbed in surface layer - ! (only if FB_BGC_OCE) [feedback bgc-ocean] + ! (only if FB_BGC_OCE) [feedback bgc-ocean] !******************************************************************** ! Dust deposition and iron solubility parameters @@ -243,7 +243,7 @@ module mo_param_bgc real, protected :: dustsink ! sinking speed of dust (used use_AGG) real, protected :: SinkExp, FractDim, Stick, cellmass, fsh, fse,alow1, alow2,alow3,alar1,alar2,alar3,TSFac,TMFac, & - vsmall,safe,pupper,plower,zdis,nmldmin + vsmall,safe,pupper,plower,zdis,nmldmin real, protected :: cellsink = 9999. @@ -256,10 +256,10 @@ module mo_param_bgc real, protected :: silsat = 0.001 ! kmol/m3 Silicate saturation concentration is 1 mol/m3 real, protected :: disso_poc = 0.01 / 86400. ! 1/(kmol O2/m3 s) disso=3.e-5 was quite high - Degradation rate constant of POP real, protected :: disso_sil = 1.e-6 ! 1/(kmol Si(OH)4/m3 s) Dissolution rate constant of opal - ! THIS NEEDS TO BE CHANGED TO disso=3.e-8! THIS IS ONLY KEPT FOR THE MOMENT - ! FOR BACKWARDS COMPATIBILITY - ! disso_sil = 3.e-8*dtbgc ! (2011-01-04) EMR - ! disso_sil = 1.e-6*dtbgc ! test vom 03.03.04 half live sil ca. 20.000 yr + ! THIS NEEDS TO BE CHANGED TO disso=3.e-8! THIS IS ONLY KEPT FOR THE MOMENT + ! FOR BACKWARDS COMPATIBILITY + ! disso_sil = 3.e-8*dtbgc ! (2011-01-04) EMR + ! disso_sil = 1.e-6*dtbgc ! test vom 03.03.04 half live sil ca. 20.000 yr real, protected :: disso_caco3 = 1.e-7 ! 1/(kmol CO3--/m3 s) Dissolution rate constant of CaCO3 real, protected :: sed_denit = 0.01/86400. ! 1/s Denitrification rate constant of POP @@ -270,8 +270,8 @@ module mo_param_bgc real, parameter :: calcwei = 100. ! 40+12+3*16 kg/kmol C real, parameter :: opalwei = 60. ! 28 + 2*16 kg/kmol Si real, parameter :: orgwei = 30. ! from 12 kg/kmol * 2.5 POC[kg]/DW[kg] - ! after Alldredge, 1998: - ! POC(g)/DW(g) = 0.4 of diatom marine snow, size 1mm3 + ! after Alldredge, 1998: + ! POC(g)/DW(g) = 0.4 of diatom marine snow, size 1mm3 ! define densities of opal, caco3, poc [kg/m3] real, parameter :: calcdens = 2600. @@ -285,7 +285,7 @@ module mo_param_bgc ! Module-wide variables used in more than one subroutine real :: beta13, alpha14, d14cat, d13c_atm - contains +contains !--------------------------------------------------------------------------------------------------------------------------------- subroutine ini_parambgc(kpie,kpje) @@ -303,7 +303,7 @@ subroutine ini_parambgc(kpie,kpje) call ini_param_biol() ! initialize biological parameters if (use_AGG) then - call ini_aggregation() ! Initialize aggregation module of Iris Kriest (no NML read thus far) + call ini_aggregation() ! Initialize aggregation module of Iris Kriest (no NML read thus far) endif call read_bgcnamelist() ! read the BGCPARAMS namelist @@ -321,16 +321,16 @@ subroutine calc_param_atm() ! calculate parameters for atmosphere from given parameters ! 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 + 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 calc_param_atm @@ -345,29 +345,29 @@ subroutine ini_param_biol() ! Zooplankton parameters !******************************************************************** if (use_AGG) then - zinges = 0.5 ! dimensionless fraction -assimilation efficiency - epsher = 0.9 ! dimensionless fraction -fraction of grazing egested + 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 + 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 + zinges = 0.6 ! dimensionless fraction -assimilation efficiency + epsher = 0.8 ! dimensionless fraction -fraction of grazing egest endif !******************************************************************** ! Shell production (CaCO3 and opal) parameters !******************************************************************** 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 + 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 + 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 + rcalc = 40. ! iris 40 !calcium carbonate to organic phosphorous production ratio + ropal = 30. ! iris 25 !opal to organic phosphorous production ratio endif @@ -383,8 +383,8 @@ subroutine read_bgcnamelist() 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, & - wmin,wmax,wlin,wpoc,wcal,wopal + remido,drempoc,dremopal,dremn2o,dremsul,fetune,relaxfe, & + wmin,wmax,wlin,wpoc,wcal,wopal open (newunit=iounit, file=bgc_namelist, status='old',action='read') read (unit=iounit, nml=BGCPARAMS) @@ -411,8 +411,8 @@ subroutine calc_param_biol() 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) !m/d + & * (claydens - 1025.) / 1.567 * 1000. & !excess density / dyn. visc. + & * dustd2 * 1.e-4) !m/d end subroutine calc_param_biol @@ -434,7 +434,7 @@ subroutine rates_2_timestep() bluefix = bluefix*dtb ! 1/d if (use_cisonew) then - c14dec = 1.-(log(2.)/c14_t_half)*dtb ! lambda [1/day]; c14dec[-] + c14dec = 1.-(log(2.)/c14_t_half)*dtb ! lambda [1/day]; c14dec[-] endif !******************************************************************** @@ -479,11 +479,11 @@ subroutine rates_2_timestep() wdust = dustsink ! m/d to m/time step Sinking speed dust if(dustsink.gt.cellsink .and. use_AGG) 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 + 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 !******************************************************************** @@ -578,22 +578,22 @@ subroutine write_parambgc() WRITE(io_stdo_bgc,*) '* Values of MO_PARAM_BGC variables : ' 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 + 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 @@ -652,56 +652,56 @@ subroutine write_parambgc() WRITE(io_stdo_bgc,*) '* dmsp5 = ',dmsp5 WRITE(io_stdo_bgc,*) '* dmsp6 = ',dmsp6 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 + 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 (use_WLIN .and. .not. use_AGG) then - WRITE(io_stdo_bgc,*) '* wmin = ',wmin*dtbinv - WRITE(io_stdo_bgc,*) '* wmax = ',wmax*dtbinv - WRITE(io_stdo_bgc,*) '* wlin = ',wlin*dtbinv + WRITE(io_stdo_bgc,*) '* wmin = ',wmin*dtbinv + WRITE(io_stdo_bgc,*) '* wmax = ',wmax*dtbinv + WRITE(io_stdo_bgc,*) '* wlin = ',wlin*dtbinv endif if (.not. use_AGG) then - WRITE(io_stdo_bgc,*) '* dustd1 = ',dustd1 - WRITE(io_stdo_bgc,*) '* dustd2 = ',dustd2 - WRITE(io_stdo_bgc,*) '* dustsink = ',dustsink*dtbinv - WRITE(io_stdo_bgc,*) '* wdust = ',wdust*dtbinv + WRITE(io_stdo_bgc,*) '* dustd1 = ',dustd1 + WRITE(io_stdo_bgc,*) '* dustd2 = ',dustd2 + WRITE(io_stdo_bgc,*) '* dustsink = ',dustsink*dtbinv + 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,*) '****************************************************************' + 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 WRITE(io_stdo_bgc,*) '* ' WRITE(io_stdo_bgc,*) '* Values of MO_PARAM_BGC sediment variables : ' @@ -719,8 +719,8 @@ subroutine write_parambgc() WRITE(io_stdo_bgc,*) '* calcdens = ',calcdens WRITE(io_stdo_bgc,*) '* claydens = ',claydens WRITE(io_stdo_bgc,*) '****************************************************************' - ENDIF + ENDIF - end subroutine write_parambgc + end subroutine write_parambgc end module mo_param_bgc diff --git a/hamocc/mo_read_fedep.F90 b/hamocc/mo_read_fedep.F90 index fed7927f..0e7653ba 100644 --- a/hamocc/mo_read_fedep.F90 +++ b/hamocc/mo_read_fedep.F90 @@ -3,57 +3,57 @@ ! 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_read_fedep -!****************************************************************************** -! -! MODULE mo_read_fedep - routines for reading iron deposition data -! -! -! J.Schwinger, *NORCE Climate, Bergen* 2020-05-27 -! -! Modified -! -------- -! J. Schwinger, *NORCE climate, Bergen* 2022-06-02 -! -revise structure of this module, split into a module for reading the -! data (mo_read_fedep) and a module that applies the fluxes in core -! hamocc (mo_apply_fedep) -! -! Purpose -! ------- -! Declaration, memory allocation, and routines related to reading iron -! deposition input data -! -! Description: -! ------------ -! Public routines and variable of this module: -! -! -subroutine ini_read_fedep -! Initialise the module for reading iron deposition data -! -! -subroutine get_fedep -! Get the iron (dust) deposition for a given month -! -! -!****************************************************************************** + !****************************************************************************** + ! + ! MODULE mo_read_fedep - routines for reading iron deposition data + ! + ! + ! J.Schwinger, *NORCE Climate, Bergen* 2020-05-27 + ! + ! Modified + ! -------- + ! J. Schwinger, *NORCE climate, Bergen* 2022-06-02 + ! -revise structure of this module, split into a module for reading the + ! data (mo_read_fedep) and a module that applies the fluxes in core + ! hamocc (mo_apply_fedep) + ! + ! Purpose + ! ------- + ! Declaration, memory allocation, and routines related to reading iron + ! deposition input data + ! + ! Description: + ! ------------ + ! Public routines and variable of this module: + ! + ! -subroutine ini_read_fedep + ! Initialise the module for reading iron deposition data + ! + ! -subroutine get_fedep + ! Get the iron (dust) deposition for a given month + ! + ! + !****************************************************************************** implicit none private public :: ini_read_fedep,get_fedep,fedepfile - ! File name (incl. full path) for input data, set through namelist + ! File name (incl. full path) for input data, set through namelist ! in hamocc_init.F character(len=512), save :: fedepfile='' ! Array to store dust deposition flux after reading from file @@ -61,135 +61,135 @@ module mo_read_fedep contains -!****************************************************************************** - - - -subroutine ini_read_fedep(kpie,kpje,omask) -!****************************************************************************** -! -! INI_FEDEP - initialise the iron deposition module. -! -! -! J.Schwinger *NORCE Climate, Bergen* 2020-05-19 -! -! Purpose -! ------- -! Initialise the iron deposition module, read in the iron (dust) data set. -! -! Parameter list: -! --------------- -! *INTEGER* *kpie* - 1st dimension of model grid. -! *INTEGER* *kpje* - 2nd dimension of model grid. -! *REAL* *omask* - land/ocean mask (1=ocean) -! -!****************************************************************************** - use netcdf, only: nf90_noerr,nf90_nowrite,nf90_close,nf90_open - use mod_xc, only: mnproc,xchalt - use mo_control_bgc, only: io_stdo_bgc - - implicit none - - integer, intent(in) :: kpie,kpje - real, intent(in) :: omask(kpie,kpje) - - integer :: i,j,l - integer :: ncid,ncstat,ncvarid,errstat - - - ! allocate field to hold iron deposition fluxes - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'***************************************************' - WRITE(io_stdo_bgc,*)'iHAMOCC: Initialization of module mo_fedep:' - WRITE(io_stdo_bgc,*)' ' - ENDIF - - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable dustflx ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : 12' - ENDIF - - ALLOCATE (dustflx(kpie,kpje,12),stat=errstat) - if(errstat.ne.0) stop 'not enough memory dustflx' - dustflx(:,:,:) = 0.0 - - ! Open netCDF data file - IF(mnproc==1) THEN - ncstat = NF90_OPEN(trim(fedepfile),NF90_NOWRITE, ncid) - IF (ncstat.NE.NF90_NOERR ) THEN - CALL xchalt('(get_dust: Problem with netCDF1)') - stop '(get_dust: Problem with netCDF1)' + !****************************************************************************** + + + + subroutine ini_read_fedep(kpie,kpje,omask) + !****************************************************************************** + ! + ! INI_FEDEP - initialise the iron deposition module. + ! + ! + ! J.Schwinger *NORCE Climate, Bergen* 2020-05-19 + ! + ! Purpose + ! ------- + ! Initialise the iron deposition module, read in the iron (dust) data set. + ! + ! Parameter list: + ! --------------- + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! *REAL* *omask* - land/ocean mask (1=ocean) + ! + !****************************************************************************** + use netcdf, only: nf90_noerr,nf90_nowrite,nf90_close,nf90_open + use mod_xc, only: mnproc,xchalt + use mo_control_bgc, only: io_stdo_bgc + + implicit none + + integer, intent(in) :: kpie,kpje + real, intent(in) :: omask(kpie,kpje) + + integer :: i,j,l + integer :: ncid,ncstat,ncvarid,errstat + + + ! allocate field to hold iron deposition fluxes + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)' ' + WRITE(io_stdo_bgc,*)'***************************************************' + WRITE(io_stdo_bgc,*)'iHAMOCC: Initialization of module mo_fedep:' + WRITE(io_stdo_bgc,*)' ' + ENDIF + + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable dustflx ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : 12' + ENDIF + + ALLOCATE (dustflx(kpie,kpje,12),stat=errstat) + if(errstat.ne.0) stop 'not enough memory dustflx' + dustflx(:,:,:) = 0.0 + + ! Open netCDF data file + IF(mnproc==1) THEN + ncstat = NF90_OPEN(trim(fedepfile),NF90_NOWRITE, ncid) + IF (ncstat.NE.NF90_NOERR ) THEN + CALL xchalt('(get_dust: Problem with netCDF1)') + stop '(get_dust: Problem with netCDF1)' + END IF END IF - END IF - ! Read data - call read_netcdf_var(ncid,'DUST',dustflx(1,1,1),12,0,0) + ! Read data + call read_netcdf_var(ncid,'DUST',dustflx(1,1,1),12,0,0) - ! Close file - IF(mnproc==1) THEN - ncstat = NF90_CLOSE(ncid) - IF ( ncstat .NE. NF90_NOERR ) THEN - CALL xchalt('(get_dust: Problem with netCDF200)') - stop '(get_dust: Problem with netCDF200)' + ! Close file + IF(mnproc==1) THEN + ncstat = NF90_CLOSE(ncid) + IF ( ncstat .NE. NF90_NOERR ) THEN + CALL xchalt('(get_dust: Problem with netCDF200)') + stop '(get_dust: Problem with netCDF200)' + END IF END IF - END IF - if (mnproc.eq.1) then - write(io_stdo_bgc,*) '' - write(io_stdo_bgc,*) 'ini_fedep: Using dust deposition file '//trim(fedepfile) - endif + if (mnproc.eq.1) then + write(io_stdo_bgc,*) '' + write(io_stdo_bgc,*) 'ini_fedep: Using dust deposition file '//trim(fedepfile) + endif - ! set flux to zero over land - do l=1,12 - do j=1,kpje - do i=1,kpie + ! set flux to zero over land + do l=1,12 + do j=1,kpje + do i=1,kpie - if(omask(i,j).lt.0.5) dustflx(i,j,l) = 0.0 - - enddo + if(omask(i,j).lt.0.5) dustflx(i,j,l) = 0.0 + + enddo + enddo enddo - enddo - RETURN + RETURN -!****************************************************************************** -end subroutine ini_read_fedep + !****************************************************************************** + end subroutine ini_read_fedep -subroutine get_fedep(kpie,kpje,kplmon,dust) -!****************************************************************************** -! -! GET_FEDEP - get iron (dust) deposition for current month -! -! -! J.Schwinger *NORCE Climate, Bergen* 2020-05-19 -! -! Purpose -! ------- -! Initialise the iron deposition module, read in the iron (dust) data set. -! -! Parameter list: -! --------------- -! *INTEGER* *kpie* - 1st dimension of model grid. -! *INTEGER* *kpje* - 2nd dimension of model grid. -! *INTEGER* *kplmon* - current month. -! *REAL* *dust* - dust flux for current month + subroutine get_fedep(kpie,kpje,kplmon,dust) + !****************************************************************************** + ! + ! GET_FEDEP - get iron (dust) deposition for current month + ! + ! + ! J.Schwinger *NORCE Climate, Bergen* 2020-05-19 + ! + ! Purpose + ! ------- + ! Initialise the iron deposition module, read in the iron (dust) data set. + ! + ! Parameter list: + ! --------------- + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! *INTEGER* *kplmon* - current month. + ! *REAL* *dust* - dust flux for current month -! -!****************************************************************************** - integer, intent(in) :: kpie,kpje,kplmon - real, intent(out) :: dust(kpie,kpje) + ! + !****************************************************************************** + integer, intent(in) :: kpie,kpje,kplmon + real, intent(out) :: dust(kpie,kpje) - dust = dustflx(:,:,kplmon) + dust = dustflx(:,:,kplmon) -!****************************************************************************** -end subroutine get_fedep + !****************************************************************************** + end subroutine get_fedep -!****************************************************************************** + !****************************************************************************** end module mo_read_fedep diff --git a/hamocc/mo_read_ndep.F90 b/hamocc/mo_read_ndep.F90 index cb19e5b4..99b0bd42 100644 --- a/hamocc/mo_read_ndep.F90 +++ b/hamocc/mo_read_ndep.F90 @@ -3,68 +3,68 @@ ! 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_read_ndep -!****************************************************************************** -! -! S.Gao *Gfi, Bergen* 2017-08-19 -! -! Modified -! -------- -! J. Tjiputra, *Uni Research, Bergen* 2017-09-18 -! -add 1 mol [H+], per mol [NO3] deposition, to alkalinity (minus 1 mol) -! -! J. Schwinger, *Uni Research, Bergen* 2018-04-12 -! -re-organised this module into an initialisation routine and a routine that -! does the deposition; introduced logical switch to activate N deposition. -! -! J. Schwinger, *NORCE climate, Bergen* 2020-05-27 -! -put reading of a time-slice of n-deposition data into own subroutine -! -removed default file name -! -! J. Schwinger, *NORCE climate, Bergen* 2022-06-02 -! -revise structure of this module, split into a module for reading the -! data (mo_read_ndep) and a module that applies the fluxes in core -! hamocc (mo_apply_ndep) -! -! -! Purpose -! ------- -! -Routines for reading nitrogen deposition fluxes from netcdf files -! -! -! Description: -! ------------ -! -! The routine get_ndep reads nitrogen deposition from file. The n-deposition -! field is then passed to hamocc4bcm where it is applied to the top-most model -! layer by a call to apply_ndep (mo_apply_ndep). -! -! N deposition is activated through a logical switch 'do_ndep' read from -! HAMOCC's bgcnml namelist. If N deposition is acitvated, a valid filename -! (including the full path) needs to be provided via HAMOCC's bgcnml namelist -! (variable ndepfile). If the input file is not found, an error will be issued. -! The input data must be already pre-interpolated to the ocean grid. -! -! -subroutine ini_read_ndep -! Initialise the module -! -! -subroutine get_ndep -! Read and return n-deposition data for a given month. -! -!****************************************************************************** + !****************************************************************************** + ! + ! S.Gao *Gfi, Bergen* 2017-08-19 + ! + ! Modified + ! -------- + ! J. Tjiputra, *Uni Research, Bergen* 2017-09-18 + ! -add 1 mol [H+], per mol [NO3] deposition, to alkalinity (minus 1 mol) + ! + ! J. Schwinger, *Uni Research, Bergen* 2018-04-12 + ! -re-organised this module into an initialisation routine and a routine that + ! does the deposition; introduced logical switch to activate N deposition. + ! + ! J. Schwinger, *NORCE climate, Bergen* 2020-05-27 + ! -put reading of a time-slice of n-deposition data into own subroutine + ! -removed default file name + ! + ! J. Schwinger, *NORCE climate, Bergen* 2022-06-02 + ! -revise structure of this module, split into a module for reading the + ! data (mo_read_ndep) and a module that applies the fluxes in core + ! hamocc (mo_apply_ndep) + ! + ! + ! Purpose + ! ------- + ! -Routines for reading nitrogen deposition fluxes from netcdf files + ! + ! + ! Description: + ! ------------ + ! + ! The routine get_ndep reads nitrogen deposition from file. The n-deposition + ! field is then passed to hamocc4bcm where it is applied to the top-most model + ! layer by a call to apply_ndep (mo_apply_ndep). + ! + ! N deposition is activated through a logical switch 'do_ndep' read from + ! HAMOCC's bgcnml namelist. If N deposition is acitvated, a valid filename + ! (including the full path) needs to be provided via HAMOCC's bgcnml namelist + ! (variable ndepfile). If the input file is not found, an error will be issued. + ! The input data must be already pre-interpolated to the ocean grid. + ! + ! -subroutine ini_read_ndep + ! Initialise the module + ! + ! -subroutine get_ndep + ! Read and return n-deposition data for a given month. + ! + !****************************************************************************** implicit none private @@ -72,165 +72,165 @@ module mo_read_ndep character(len=512), save :: ndepfile='' real, allocatable, save :: ndepread(:,:) - integer, save :: startyear,endyear + integer, save :: startyear,endyear logical, save :: lini = .false. -!****************************************************************************** + !****************************************************************************** contains -subroutine ini_read_ndep(kpie,kpje) -!****************************************************************************** -! -! S. Gao *Gfi, Bergen* 19.08.2017 -! -! Purpose -! ------- -! -Initialise the module, check existence of input file, allocate array -! for reading the data -! -! Changes: -! -------- -! -! Parameter list: -! --------------- -! *INTEGER* *kpie* - 1st dimension of model grid. -! *INTEGER* *kpje* - 2nd dimension of model grid. -! -!****************************************************************************** - use mod_xc, only: mnproc,xchalt - use mo_control_bgc, only: io_stdo_bgc,do_ndep - use mod_dia, only: iotype - use mod_nctools, only: ncfopn,ncgeti,ncfcls - - implicit none - - integer, intent(in) :: kpie,kpje - - integer :: errstat - logical :: file_exists=.false. - - - ! Return if N deposition is turned off - if (.not. do_ndep) then - if (mnproc.eq.1) then - write(io_stdo_bgc,*) '' - write(io_stdo_bgc,*) 'ini_read_ndep: N deposition is not activated.' - endif - return - endif - - ! Initialise the module - if (.not. lini) then - - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'***************************************************' - WRITE(io_stdo_bgc,*)'iHAMOCC: Initialization of module mo_read_ndep:' - WRITE(io_stdo_bgc,*)' ' - ENDIF - - ! Check if nitrogen deposition file exists. If not, abort. - inquire(file=ndepfile,exist=file_exists) - if (.not. file_exists .and. mnproc.eq.1) then - write(io_stdo_bgc,*) '' - write(io_stdo_bgc,*) 'ini_read_ndep: Cannot find N deposition file... ' - call xchalt('(ini_read_ndep)') - stop '(ini_read_ndep)' - endif - - ! Allocate field to hold N-deposition fluxes - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable ndepread ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF - - ALLOCATE (ndepread(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory ndep' - ndepread(:,:) = 0.0 - - ! read start and end year of n-deposition file - call ncfopn(trim(ndepfile),'r',' ',1,iotype) - call ncgeti('startyear',startyear) - call ncgeti('endyear',endyear) - call ncfcls - - if (mnproc.eq.1) then - write(io_stdo_bgc,*) '' - write(io_stdo_bgc,*) 'ini_read_ndep: Using N deposition file '//trim(ndepfile) + subroutine ini_read_ndep(kpie,kpje) + !****************************************************************************** + ! + ! S. Gao *Gfi, Bergen* 19.08.2017 + ! + ! Purpose + ! ------- + ! -Initialise the module, check existence of input file, allocate array + ! for reading the data + ! + ! Changes: + ! -------- + ! + ! Parameter list: + ! --------------- + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! + !****************************************************************************** + use mod_xc, only: mnproc,xchalt + use mo_control_bgc, only: io_stdo_bgc,do_ndep + use mod_dia, only: iotype + use mod_nctools, only: ncfopn,ncgeti,ncfcls + + implicit none + + integer, intent(in) :: kpie,kpje + + integer :: errstat + logical :: file_exists=.false. + + + ! Return if N deposition is turned off + if (.not. do_ndep) then + if (mnproc.eq.1) then + write(io_stdo_bgc,*) '' + write(io_stdo_bgc,*) 'ini_read_ndep: N deposition is not activated.' + endif + return endif - lini=.true. - - endif - - -!****************************************************************************** -end subroutine ini_read_ndep - - -subroutine get_ndep(kpie,kpje,kplyear,kplmon,omask,ndep) -!****************************************************************************** -! -! S. Gao *Gfi, Bergen* 19.08.2017 -! -! Purpose -! ------- -! -Read and return CMIP6 n-deposition data for a given month. -! -! Parameter list: -! --------------- -! *INTEGER* *kpie* - 1st dimension of model grid. -! *INTEGER* *kpje* - 2nd dimension of model grid. -! *INTEGER* *kplyear* - current year. -! *INTEGER* *kplmon* - current month. -! *REAL* *omask* - land/ocean mask (1=ocean) -! *REAL* *ndep* - N-deposition field for current year and month -! -!****************************************************************************** - use mod_xc, only: mnproc - use netcdf, only: nf90_open,nf90_close,nf90_nowrite - use mo_control_bgc, only: io_stdo_bgc,do_ndep - - implicit none - - integer, intent(in) :: kpie,kpje,kplyear,kplmon - real, intent(in) :: omask(kpie,kpje) - real, intent(out) :: ndep(kpie,kpje) + ! Initialise the module + if (.not. lini) then + + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)' ' + WRITE(io_stdo_bgc,*)'***************************************************' + WRITE(io_stdo_bgc,*)'iHAMOCC: Initialization of module mo_read_ndep:' + WRITE(io_stdo_bgc,*)' ' + ENDIF + + ! Check if nitrogen deposition file exists. If not, abort. + inquire(file=ndepfile,exist=file_exists) + if (.not. file_exists .and. mnproc.eq.1) then + write(io_stdo_bgc,*) '' + write(io_stdo_bgc,*) 'ini_read_ndep: Cannot find N deposition file... ' + call xchalt('(ini_read_ndep)') + stop '(ini_read_ndep)' + endif + + ! Allocate field to hold N-deposition fluxes + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable ndepread ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + ENDIF + + ALLOCATE (ndepread(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory ndep' + ndepread(:,:) = 0.0 + + ! read start and end year of n-deposition file + call ncfopn(trim(ndepfile),'r',' ',1,iotype) + call ncgeti('startyear',startyear) + call ncgeti('endyear',endyear) + call ncfcls + + if (mnproc.eq.1) then + write(io_stdo_bgc,*) '' + write(io_stdo_bgc,*) 'ini_read_ndep: Using N deposition file '//trim(ndepfile) + endif + + lini=.true. - ! local variables - integer :: month_in_file,ncstat,ncid - integer, save :: oldmonth=0 + endif - ! if N-deposition is switched off set ndep to zero and return - if (.not. do_ndep) then - ndep(:,:) = 0.0 - return - endif + !****************************************************************************** + end subroutine ini_read_ndep + + + subroutine get_ndep(kpie,kpje,kplyear,kplmon,omask,ndep) + !****************************************************************************** + ! + ! S. Gao *Gfi, Bergen* 19.08.2017 + ! + ! Purpose + ! ------- + ! -Read and return CMIP6 n-deposition data for a given month. + ! + ! Parameter list: + ! --------------- + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! *INTEGER* *kplyear* - current year. + ! *INTEGER* *kplmon* - current month. + ! *REAL* *omask* - land/ocean mask (1=ocean) + ! *REAL* *ndep* - N-deposition field for current year and month + ! + !****************************************************************************** + use mod_xc, only: mnproc + use netcdf, only: nf90_open,nf90_close,nf90_nowrite + use mo_control_bgc, only: io_stdo_bgc,do_ndep + + implicit none + + integer, intent(in) :: kpie,kpje,kplyear,kplmon + real, intent(in) :: omask(kpie,kpje) + real, intent(out) :: ndep(kpie,kpje) + + ! local variables + integer :: month_in_file,ncstat,ncid + integer, save :: oldmonth=0 + + + ! if N-deposition is switched off set ndep to zero and return + if (.not. do_ndep) then + ndep(:,:) = 0.0 + return + endif - ! read ndep data from file - if (kplmon.ne.oldmonth) then - month_in_file=(max(startyear,min(endyear,kplyear))-startyear)*12+kplmon - if (mnproc.eq.1) then - write(io_stdo_bgc,*) 'Read N deposition month ',month_in_file, & - ' from file ',trim(ndepfile) - endif - ncstat=nf90_open(trim(ndepfile),nf90_nowrite,ncid) - call read_netcdf_var(ncid,'ndep',ndepread,1,month_in_file,0) - ncstat=nf90_close(ncid) - oldmonth=kplmon - endif + ! read ndep data from file + if (kplmon.ne.oldmonth) then + month_in_file=(max(startyear,min(endyear,kplyear))-startyear)*12+kplmon + if (mnproc.eq.1) then + write(io_stdo_bgc,*) 'Read N deposition month ',month_in_file, & + ' from file ',trim(ndepfile) + endif + ncstat=nf90_open(trim(ndepfile),nf90_nowrite,ncid) + call read_netcdf_var(ncid,'ndep',ndepread,1,month_in_file,0) + ncstat=nf90_close(ncid) + oldmonth=kplmon + endif - ndep(:,:) = ndepread + ndep(:,:) = ndepread -!****************************************************************************** -end subroutine get_ndep + !****************************************************************************** + end subroutine get_ndep -!****************************************************************************** + !****************************************************************************** end module mo_read_ndep diff --git a/hamocc/mo_read_oafx.F90 b/hamocc/mo_read_oafx.F90 index bbd2be52..2c4d585a 100644 --- a/hamocc/mo_read_oafx.F90 +++ b/hamocc/mo_read_oafx.F90 @@ -3,86 +3,86 @@ ! 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_read_oafx -!****************************************************************************** -! -! J.Schwinger *NORCE Climate, Bergen* 2022-08-24 -! -! Modified -! -------- -! T. Bourgeois, *NORCE climate, Bergen* 2023-01-31 -! - add ramping-up scenario -! - add ability to define parameters from BLOM namelist -! -! T. Bourgeois, *NORCE climate, Bergen* 2023-02-09 -! - add ability to use an OA input file -! -! Purpose -! ------- -! -Routines for reading ocean alkalinization fluxes from netcdf files -! -! -! Description: -! ------------ -! The routine get_oafx reads a flux of alkalinity from file (or, for simple -! cases, constructs an alkalinity flux field from scratch). The alkalinity -! flux is then passed to hamocc4bcm where it is applied to the top-most model -! layer by a call to apply_oafx (mo_apply_oafx). -! -! Ocean alkalinization is activated through a logical switch 'do_oalk' read -! from HAMOCC's bgcnml namelist. If ocean alkalinization is activated, a valid -! name of an alkalinisation scenario (defined in this module, see below) needs -! to be provided via HAMOCC's bgcnml namelist (variable oalkscen). For the -! 'file' scenario, the file name (including the full path) of the -! corresponding OA-scenario input file needs to be provided (variable -! oalkfile). If the input file is not found, an error will be issued. The -! input data must be already pre-interpolated to the ocean grid. -! -! Currently available ocean alkalinisation scenarios: -! (for 'const' and 'ramp' scenarios, flux and latitude range can be defined in -! the namelist, default values are defined): -! -'const': constant alkalinity flux applied to the surface ocean -! between two latitudes. No input file needed. -! -'ramp': ramping-up alkalinity flux from 0 Pmol yr-1 to a maximum -! value between two specified years and kept constant -! onward, applied to the surface ocean between two -! latitudes. No input file needed. -! -'file': Read monthly 2D field in kmol ALK m-2 yr-1 from a file -! defined with the variable oalkfile. -! -! -subroutine ini_read_oafx -! Initialise the module -! -! -subroutine get_oafx -! Gets the alkalinity flux to apply at a given time. -! -! -!****************************************************************************** + !****************************************************************************** + ! + ! J.Schwinger *NORCE Climate, Bergen* 2022-08-24 + ! + ! Modified + ! -------- + ! T. Bourgeois, *NORCE climate, Bergen* 2023-01-31 + ! - add ramping-up scenario + ! - add ability to define parameters from BLOM namelist + ! + ! T. Bourgeois, *NORCE climate, Bergen* 2023-02-09 + ! - add ability to use an OA input file + ! + ! Purpose + ! ------- + ! -Routines for reading ocean alkalinization fluxes from netcdf files + ! + ! + ! Description: + ! ------------ + ! The routine get_oafx reads a flux of alkalinity from file (or, for simple + ! cases, constructs an alkalinity flux field from scratch). The alkalinity + ! flux is then passed to hamocc4bcm where it is applied to the top-most model + ! layer by a call to apply_oafx (mo_apply_oafx). + ! + ! Ocean alkalinization is activated through a logical switch 'do_oalk' read + ! from HAMOCC's bgcnml namelist. If ocean alkalinization is activated, a valid + ! name of an alkalinisation scenario (defined in this module, see below) needs + ! to be provided via HAMOCC's bgcnml namelist (variable oalkscen). For the + ! 'file' scenario, the file name (including the full path) of the + ! corresponding OA-scenario input file needs to be provided (variable + ! oalkfile). If the input file is not found, an error will be issued. The + ! input data must be already pre-interpolated to the ocean grid. + ! + ! Currently available ocean alkalinisation scenarios: + ! (for 'const' and 'ramp' scenarios, flux and latitude range can be defined in + ! the namelist, default values are defined): + ! -'const': constant alkalinity flux applied to the surface ocean + ! between two latitudes. No input file needed. + ! -'ramp': ramping-up alkalinity flux from 0 Pmol yr-1 to a maximum + ! value between two specified years and kept constant + ! onward, applied to the surface ocean between two + ! latitudes. No input file needed. + ! -'file': Read monthly 2D field in kmol ALK m-2 yr-1 from a file + ! defined with the variable oalkfile. + ! + ! -subroutine ini_read_oafx + ! Initialise the module + ! + ! -subroutine get_oafx + ! Gets the alkalinity flux to apply at a given time. + ! + ! + !****************************************************************************** implicit none private public :: ini_read_oafx,get_oafx,oalkscen,oalkfile,thrh_omegaa - + character(len=128), protected :: oalkscen ='' character(len=512), protected :: oalkfile ='' real,allocatable, protected :: oalkflx(:,:) integer, protected :: startyear,endyear real, parameter :: Pmol2kmol = 1.0e12 - + ! Parameter used in the definition of alkalinization scenarios not based on ! an input file. The following scenarios are defined in this module: ! @@ -95,300 +95,300 @@ module mo_read_oafx ! Values are read from namelist bgcoafx, which overwrites default values set ! here real, protected :: addalk = 0.135 ! Pmol alkalinity/yr added in the - ! scenarios. + ! scenarios. real, protected :: cdrmip_latmax = 70.0 ! Min and max latitude where real, protected :: cdrmip_latmin = -60.0 ! alkalinity is added according - ! to the CDRMIP protocol. + ! to the CDRMIP protocol. integer, protected :: ramp_start = 2025 ! In 'ramp' scenario, start at integer, protected :: ramp_end = 2035 ! 0 Pmol/yr at ramp_start, and - ! arrive at addalk Pmol/yr in - ! year ramp_end + ! arrive at addalk Pmol/yr in + ! year ramp_end ! Parameter used for ALL alkalinization scenarios, read through namelist ! namelist bgcoafx, which overwrites default values set here - real, protected :: thrh_omegaa =-1.0 ! Limit the input of alkalinity by - ! setting alkalinity-flux to zero - ! for grid cells where Omegaa > - ! thrh_omegaa (negative values mean - ! no threshold considered) + real, protected :: thrh_omegaa =-1.0 ! Limit the input of alkalinity by + ! setting alkalinity-flux to zero + ! for grid cells where Omegaa > + ! thrh_omegaa (negative values mean + ! no threshold considered) logical, save :: lini = .false. -!****************************************************************************** + !****************************************************************************** contains -subroutine ini_read_oafx(kpie,kpje,pdlxp,pdlyp,pglat,omask) -!****************************************************************************** -! -! J.Schwinger *NORCE Climate, Bergen* 2021-11-15 -! -! Purpose -! ------- -! -Initialise the alkalinization module. -! -! Changes: -! -------- -! -! Parameter list: -! --------------- -! *INTEGER* *kpie* - 1st dimension of model grid. -! *INTEGER* *kpje* - 2nd dimension of model grid. -! *REAL* *pdlxp* - size of grid cell (longitudinal) [m]. -! *REAL* *pdlyp* - size of grid cell (latitudinal) [m]. -! *REAL* *pglat* - latitude grid cell centres [degree N]. -! *REAL* *omask* - land/ocean mask. -! -!****************************************************************************** - use mod_xc, only: xcsum,xchalt,mnproc,nbdy,ips - use mod_dia, only: iotype - use mod_nctools, only: ncfopn,ncgeti,ncfcls - use mo_control_bgc, only: io_stdo_bgc,do_oalk,bgc_namelist,get_bgc_namelist - - implicit none - - integer, intent(in) :: kpie,kpje - real, intent(in) :: pdlxp(kpie,kpje), pdlyp(kpie,kpje) - real, intent(in) :: pglat(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy) - real, intent(in) :: omask(kpie,kpje) - - integer :: i,j,errstat - logical :: file_exists=.false. - integer :: iounit - real :: avflx,ztotarea - real :: ztmp1(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy) - - namelist /bgcoafx/ oalkscen,oalkfile,addalk,cdrmip_latmax,cdrmip_latmin, & - & ramp_start,ramp_end,thrh_omegaa - - ! Read parameters for alkalinization fluxes from namelist file - if(.not. allocated(bgc_namelist)) call get_bgc_namelist - open (newunit=iounit, file=bgc_namelist, status='old',action='read') - read (unit=iounit, nml=BGCOAFX) - close (unit=iounit) - - ! Return if alkalinization is turned off - if (.not. do_oalk) then - if (mnproc.eq.1) then - write(io_stdo_bgc,*) '' - write(io_stdo_bgc,*) 'ini_read_oafx: ocean alkalinization is not activated.' - endif - return - endif - - ! Initialise the module - if(.not. lini) then - - if(mnproc.eq.1) then - write(io_stdo_bgc,*)' ' - write(io_stdo_bgc,*)'***************************************************' - write(io_stdo_bgc,*)'iHAMOCC: Initialization of module mo_read_oafx:' - write(io_stdo_bgc,*)' ' + subroutine ini_read_oafx(kpie,kpje,pdlxp,pdlyp,pglat,omask) + !****************************************************************************** + ! + ! J.Schwinger *NORCE Climate, Bergen* 2021-11-15 + ! + ! Purpose + ! ------- + ! -Initialise the alkalinization module. + ! + ! Changes: + ! -------- + ! + ! Parameter list: + ! --------------- + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! *REAL* *pdlxp* - size of grid cell (longitudinal) [m]. + ! *REAL* *pdlyp* - size of grid cell (latitudinal) [m]. + ! *REAL* *pglat* - latitude grid cell centres [degree N]. + ! *REAL* *omask* - land/ocean mask. + ! + !****************************************************************************** + use mod_xc, only: xcsum,xchalt,mnproc,nbdy,ips + use mod_dia, only: iotype + use mod_nctools, only: ncfopn,ncgeti,ncfcls + use mo_control_bgc, only: io_stdo_bgc,do_oalk,bgc_namelist,get_bgc_namelist + + implicit none + + integer, intent(in) :: kpie,kpje + real, intent(in) :: pdlxp(kpie,kpje), pdlyp(kpie,kpje) + real, intent(in) :: pglat(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy) + real, intent(in) :: omask(kpie,kpje) + + integer :: i,j,errstat + logical :: file_exists=.false. + integer :: iounit + real :: avflx,ztotarea + real :: ztmp1(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy) + + namelist /bgcoafx/ oalkscen,oalkfile,addalk,cdrmip_latmax,cdrmip_latmin, & + & ramp_start,ramp_end,thrh_omegaa + + ! Read parameters for alkalinization fluxes from namelist file + if(.not. allocated(bgc_namelist)) call get_bgc_namelist + open (newunit=iounit, file=bgc_namelist, status='old',action='read') + read (unit=iounit, nml=BGCOAFX) + close (unit=iounit) + + ! Return if alkalinization is turned off + if (.not. do_oalk) then + if (mnproc.eq.1) then + write(io_stdo_bgc,*) '' + write(io_stdo_bgc,*) 'ini_read_oafx: ocean alkalinization is not activated.' + endif + return endif - if( trim(oalkscen)=='const' .or. trim(oalkscen)=='ramp' .or. & - trim(oalkscen)=='file' ) then + ! Initialise the module + if(.not. lini) then if(mnproc.eq.1) then - write(io_stdo_bgc,*)'Using alkalinization scenario ', trim(oalkscen) - if( trim(oalkscen)=='file' ) then - write(io_stdo_bgc,*) 'from ', trim(oalkfile) - endif + write(io_stdo_bgc,*)' ' + write(io_stdo_bgc,*)'***************************************************' + write(io_stdo_bgc,*)'iHAMOCC: Initialization of module mo_read_oafx:' write(io_stdo_bgc,*)' ' endif - if( trim(oalkscen)=='file' ) then - ! Check if OA file exists. If not, abort. - inquire(file=oalkfile,exist=file_exists) - if (.not. file_exists .and. mnproc.eq.1) then - write(io_stdo_bgc,*) '' - write(io_stdo_bgc,*) 'ini_read_oafx: Cannot find ocean alkalinization file... ' - call xchalt('(ini_read_oafx)') - stop '(ini_read_oafx)' - endif - endif - - ! Allocate field to hold alkalinization fluxes - if(mnproc.eq.1) then - write(io_stdo_bgc,*)'Memory allocation for variable oalkflx ...' - write(io_stdo_bgc,*)'First dimension : ',kpie - write(io_stdo_bgc,*)'Second dimension : ',kpje - endif - - allocate(oalkflx(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory oalkflx' - oalkflx(:,:) = 0.0 - - if( trim(oalkscen)=='file' ) then - - ! read start and end year of OA file - call ncfopn(trim(oalkfile),'r',' ',1,iotype) - call ncgeti('startyear',startyear) - call ncgeti('endyear',endyear) - call ncfcls - - else + if( trim(oalkscen)=='const' .or. trim(oalkscen)=='ramp' .or. & + trim(oalkscen)=='file' ) then - ! Calculate total ocean area - ztmp1(:,:)=0.0 - do j=1,kpje - do i=1,kpie - if( omask(i,j).gt.0.5 .and. pglat(i,j)cdrmip_latmin ) then - ztmp1(i,j)=ztmp1(i,j)+pdlxp(i,j)*pdlyp(i,j) - endif - enddo - enddo - - call xcsum(ztotarea,ztmp1,ips) - - ! Calculate alkalinity flux (kmol m^2 yr-1) to be applied - avflx = addalk/ztotarea*Pmol2kmol if(mnproc.eq.1) then - write(io_stdo_bgc,*)' ' - write(io_stdo_bgc,*)' applying alkalinity flux of ', avflx, ' kmol m-2 yr-1' - write(io_stdo_bgc,*)' over an area of ', ztotarea , ' m2' - if( trim(oalkscen)=='ramp' ) then - write(io_stdo_bgc,*)' ramping-up from ', ramp_start, ' to ', ramp_end + write(io_stdo_bgc,*)'Using alkalinization scenario ', trim(oalkscen) + if( trim(oalkscen)=='file' ) then + write(io_stdo_bgc,*) 'from ', trim(oalkfile) endif - endif - - if(mnproc.eq.1 .and. thrh_omegaa > 0.0) then - write(io_stdo_bgc,*)' alkalinity flux will be limited by a threshold for Omega_a of ',thrh_omegaa write(io_stdo_bgc,*)' ' endif - - - do j=1,kpje - do i=1,kpie - if( omask(i,j).gt.0.5 .and. pglat(i,j)cdrmip_latmin ) then - oalkflx(i,j) = avflx + + if( trim(oalkscen)=='file' ) then + ! Check if OA file exists. If not, abort. + inquire(file=oalkfile,exist=file_exists) + if (.not. file_exists .and. mnproc.eq.1) then + write(io_stdo_bgc,*) '' + write(io_stdo_bgc,*) 'ini_read_oafx: Cannot find ocean alkalinization file... ' + call xchalt('(ini_read_oafx)') + stop '(ini_read_oafx)' endif - enddo - enddo + endif - endif + ! Allocate field to hold alkalinization fluxes + if(mnproc.eq.1) then + write(io_stdo_bgc,*)'Memory allocation for variable oalkflx ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje + endif - lini=.true. + allocate(oalkflx(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory oalkflx' + oalkflx(:,:) = 0.0 - !-------------------------------- - ! No valid scenario specified - !-------------------------------- - else - - write(io_stdo_bgc,*) '' - write(io_stdo_bgc,*) 'ini_read_oafx: invalid alkalinization scenario' - call xchalt('(ini_read_oafx)') - stop '(ini_read_oafx)' - - endif + if( trim(oalkscen)=='file' ) then - endif ! not lini + ! read start and end year of OA file + call ncfopn(trim(oalkfile),'r',' ',1,iotype) + call ncgeti('startyear',startyear) + call ncgeti('endyear',endyear) + call ncfcls + + else + + ! Calculate total ocean area + ztmp1(:,:)=0.0 + do j=1,kpje + do i=1,kpie + if( omask(i,j).gt.0.5 .and. pglat(i,j)cdrmip_latmin ) then + ztmp1(i,j)=ztmp1(i,j)+pdlxp(i,j)*pdlyp(i,j) + endif + enddo + enddo + + call xcsum(ztotarea,ztmp1,ips) + + ! Calculate alkalinity flux (kmol m^2 yr-1) to be applied + avflx = addalk/ztotarea*Pmol2kmol + if(mnproc.eq.1) then + write(io_stdo_bgc,*)' ' + write(io_stdo_bgc,*)' applying alkalinity flux of ', avflx, ' kmol m-2 yr-1' + write(io_stdo_bgc,*)' over an area of ', ztotarea , ' m2' + if( trim(oalkscen)=='ramp' ) then + write(io_stdo_bgc,*)' ramping-up from ', ramp_start, ' to ', ramp_end + endif + endif + if(mnproc.eq.1 .and. thrh_omegaa > 0.0) then + write(io_stdo_bgc,*)' alkalinity flux will be limited by a threshold for Omega_a of ',thrh_omegaa + write(io_stdo_bgc,*)' ' + endif -!****************************************************************************** -end subroutine ini_read_oafx + do j=1,kpje + do i=1,kpie + if( omask(i,j).gt.0.5 .and. pglat(i,j)cdrmip_latmin ) then + oalkflx(i,j) = avflx + endif + enddo + enddo -subroutine get_oafx(kpie,kpje,kplyear,kplmon,omask,oafx) -!****************************************************************************** -! -! J. Schwinger *NORCE Climate, Bergen* 2021-11-15 -! -! Purpose -! ------- -! -return ocean alkalinization flux. -! -! Changes: -! -------- -! -! -! Parameter list: -! --------------- -! *INTEGER* *kpie* - 1st dimension of model grid. -! *INTEGER* *kpje* - 2nd dimension of model grid. -! *INTEGER* *kplyear* - current year. -! *INTEGER* *kplmon* - current month. -! *REAL* *omask* - land/ocean mask (1=ocean) -! *REAL* *oaflx* - alkalinization flux [kmol m-2 yr-1] -! -!****************************************************************************** - use mod_xc, only: xchalt,mnproc - use netcdf, only: nf90_open,nf90_close,nf90_nowrite - use mo_control_bgc, only: io_stdo_bgc,do_oalk - use mod_time, only: nday_of_year + endif - implicit none + lini=.true. + + !-------------------------------- + ! No valid scenario specified + !-------------------------------- + else + + write(io_stdo_bgc,*) '' + write(io_stdo_bgc,*) 'ini_read_oafx: invalid alkalinization scenario' + call xchalt('(ini_read_oafx)') + stop '(ini_read_oafx)' + + endif - integer, intent(in) :: kpie,kpje,kplyear,kplmon - real, intent(in) :: omask(kpie,kpje) - real, intent(out) :: oafx(kpie,kpje) - - ! local variables - integer :: month_in_file,ncstat,ncid,current_day - integer, save :: oldmonth=0 - - if (.not. do_oalk) then - oafx(:,:) = 0.0 - return - endif - - !-------------------------------- - ! Scenarios of constant fluxes - !-------------------------------- - if( trim(oalkscen)=='const' ) then - - oafx(:,:) = oalkflx(:,:) - - !-------------------------------- - ! Scenario of ramping-up fluxes - !-------------------------------- - elseif(trim(oalkscen)=='ramp' ) then - - if(kplyear.lt.ramp_start ) then + endif ! not lini + + + !****************************************************************************** + end subroutine ini_read_oafx + + + subroutine get_oafx(kpie,kpje,kplyear,kplmon,omask,oafx) + !****************************************************************************** + ! + ! J. Schwinger *NORCE Climate, Bergen* 2021-11-15 + ! + ! Purpose + ! ------- + ! -return ocean alkalinization flux. + ! + ! Changes: + ! -------- + ! + ! + ! Parameter list: + ! --------------- + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! *INTEGER* *kplyear* - current year. + ! *INTEGER* *kplmon* - current month. + ! *REAL* *omask* - land/ocean mask (1=ocean) + ! *REAL* *oaflx* - alkalinization flux [kmol m-2 yr-1] + ! + !****************************************************************************** + use mod_xc, only: xchalt,mnproc + use netcdf, only: nf90_open,nf90_close,nf90_nowrite + use mo_control_bgc, only: io_stdo_bgc,do_oalk + use mod_time, only: nday_of_year + + implicit none + + integer, intent(in) :: kpie,kpje,kplyear,kplmon + real, intent(in) :: omask(kpie,kpje) + real, intent(out) :: oafx(kpie,kpje) + + ! local variables + integer :: month_in_file,ncstat,ncid,current_day + integer, save :: oldmonth=0 + + if (.not. do_oalk) then oafx(:,:) = 0.0 - elseif(kplyear.ge.ramp_end ) then - oafx(:,:) = oalkflx(:,:) - else - current_day = (kplyear-ramp_start)*365+nday_of_year - oafx(:,:) = oalkflx(:,:) * current_day / ((ramp_end-ramp_start)*365.) + return endif - !-------------------------------- - ! Scenario from OA file - !-------------------------------- - elseif(trim(oalkscen)=='file' ) then + !-------------------------------- + ! Scenarios of constant fluxes + !-------------------------------- + if( trim(oalkscen)=='const' ) then - ! read OA data from file - if (kplmon.ne.oldmonth) then - month_in_file=(max(startyear,min(endyear,kplyear))-startyear)*12+kplmon - if (mnproc.eq.1) then - write(io_stdo_bgc,*) 'Read OA month ',month_in_file, & - 'from file ',trim(oalkfile) + oafx(:,:) = oalkflx(:,:) + + !-------------------------------- + ! Scenario of ramping-up fluxes + !-------------------------------- + elseif(trim(oalkscen)=='ramp' ) then + + if(kplyear.lt.ramp_start ) then + oafx(:,:) = 0.0 + elseif(kplyear.ge.ramp_end ) then + oafx(:,:) = oalkflx(:,:) + else + current_day = (kplyear-ramp_start)*365+nday_of_year + oafx(:,:) = oalkflx(:,:) * current_day / ((ramp_end-ramp_start)*365.) endif - ncstat=nf90_open(trim(oalkfile),nf90_nowrite,ncid) - call read_netcdf_var(ncid,'oafx',oalkflx,1,month_in_file,0) - ncstat=nf90_close(ncid) - oldmonth=kplmon - endif - oafx(:,:) = oalkflx - else - - write(io_stdo_bgc,*) '' - write(io_stdo_bgc,*) 'get_oafx: invalid alkalinization scenario... ' - call xchalt('(get_oafx)') - stop '(get_oafx)' - - endif + !-------------------------------- + ! Scenario from OA file + !-------------------------------- + elseif(trim(oalkscen)=='file' ) then + + ! read OA data from file + if (kplmon.ne.oldmonth) then + month_in_file=(max(startyear,min(endyear,kplyear))-startyear)*12+kplmon + if (mnproc.eq.1) then + write(io_stdo_bgc,*) 'Read OA month ',month_in_file, & + 'from file ',trim(oalkfile) + endif + ncstat=nf90_open(trim(oalkfile),nf90_nowrite,ncid) + call read_netcdf_var(ncid,'oafx',oalkflx,1,month_in_file,0) + ncstat=nf90_close(ncid) + oldmonth=kplmon + endif + oafx(:,:) = oalkflx + + else + + write(io_stdo_bgc,*) '' + write(io_stdo_bgc,*) 'get_oafx: invalid alkalinization scenario... ' + call xchalt('(get_oafx)') + stop '(get_oafx)' + + endif -!****************************************************************************** -end subroutine get_oafx + !****************************************************************************** + end subroutine get_oafx -!****************************************************************************** + !****************************************************************************** end module mo_read_oafx diff --git a/hamocc/mo_read_pi_ph.F90 b/hamocc/mo_read_pi_ph.F90 index 87070d71..95621ebd 100644 --- a/hamocc/mo_read_pi_ph.F90 +++ b/hamocc/mo_read_pi_ph.F90 @@ -63,43 +63,43 @@ subroutine ini_pi_ph(kpie,kpje,omask) ! Only read PI pH climatology if needed for DMS if(with_dmsph) then - ! allocate pi_ph_clim field - if(.not. allocated(pi_ph_clim)) call alloc_pi_ph_clim(kpie,kpje) - - ! Open netCDF data file - IF(mnproc==1) THEN - ncstat = NF90_OPEN(trim(pi_ph_file), NF90_NOWRITE, ncid) - write(io_stdo_bgc,*) 'HAMOCC: opening PI_PH climatology file' - IF (ncstat.NE.NF90_NOERR ) THEN - CALL xchalt('(ini_pi_ph: Problem with netCDF1)') - stop '(ini_pi_ph: Problem with netCDF1)' - END IF - END IF - ! - ! Read data - call read_netcdf_var(ncid,'pH',pi_ph_in(1,1,1),pi_ph_record,0,0) - ! - ! Close file - IF(mnproc==1) THEN - ncstat = NF90_CLOSE(ncid) - IF ( ncstat .NE. NF90_NOERR ) THEN - CALL xchalt('(ini_pi_ph: Problem with netCDF200)') - stop '(ini_pi_ph: Problem with netCDF200)' - END IF - END IF - - ! set missings over land - do l=1,pi_ph_record - do j=1,kpje - do i=1,kpie - if(omask(i,j).gt.0.5) then - pi_ph_clim(i,j,l) = pi_ph_in(i,j,l) - else - pi_ph_clim(i,j,l) = 0. - endif - enddo + ! allocate pi_ph_clim field + if(.not. allocated(pi_ph_clim)) call alloc_pi_ph_clim(kpie,kpje) + + ! Open netCDF data file + IF(mnproc==1) THEN + ncstat = NF90_OPEN(trim(pi_ph_file), NF90_NOWRITE, ncid) + write(io_stdo_bgc,*) 'HAMOCC: opening PI_PH climatology file' + IF (ncstat.NE.NF90_NOERR ) THEN + CALL xchalt('(ini_pi_ph: Problem with netCDF1)') + stop '(ini_pi_ph: Problem with netCDF1)' + END IF + END IF + ! + ! Read data + call read_netcdf_var(ncid,'pH',pi_ph_in(1,1,1),pi_ph_record,0,0) + ! + ! Close file + IF(mnproc==1) THEN + ncstat = NF90_CLOSE(ncid) + IF ( ncstat .NE. NF90_NOERR ) THEN + CALL xchalt('(ini_pi_ph: Problem with netCDF200)') + stop '(ini_pi_ph: Problem with netCDF200)' + END IF + END IF + + ! set missings over land + do l=1,pi_ph_record + do j=1,kpje + do i=1,kpie + if(omask(i,j).gt.0.5) then + pi_ph_clim(i,j,l) = pi_ph_in(i,j,l) + else + pi_ph_clim(i,j,l) = 0. + endif enddo - enddo + enddo + enddo endif end subroutine ini_pi_ph @@ -123,10 +123,10 @@ subroutine get_pi_ph(kpie,kpje,kplmon) ! Update only if PI pH climatology is used for DMS if(with_dmsph) then - if(kplmon /= oldmonth) then - pi_ph = reshape(pi_ph_clim(:,:,kplmon), [kpie,kpje]) - oldmonth = kplmon - endif + if(kplmon /= oldmonth) then + pi_ph = reshape(pi_ph_clim(:,:,kplmon), [kpie,kpje]) + oldmonth = kplmon + endif endif end subroutine get_pi_ph @@ -146,9 +146,9 @@ subroutine alloc_pi_ph(kpie,kpje) integer :: errstat IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable pi_ph ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Memory allocation for variable pi_ph ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF ALLOCATE (pi_ph(kpie,kpje),stat=errstat) @@ -172,10 +172,10 @@ subroutine alloc_pi_ph_clim(kpie,kpje) integer :: errstat IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable pi_ph_clim ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',pi_ph_record + WRITE(io_stdo_bgc,*)'Memory allocation for variable pi_ph_clim ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',pi_ph_record ENDIF ALLOCATE (pi_ph_clim(kpie,kpje,pi_ph_record),stat=errstat) diff --git a/hamocc/mo_read_rivin.F90 b/hamocc/mo_read_rivin.F90 index b421743f..c0d7289f 100644 --- a/hamocc/mo_read_rivin.F90 +++ b/hamocc/mo_read_rivin.F90 @@ -3,188 +3,188 @@ ! 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_read_rivin -!******************************************************************************** -! -! S. Gao, *Gfi, Bergen* 19.08.2017 -! -! Purpose -! ------- -! - Routines for reading riverine nutrient and carbon input data -! -! -! Description: -! ------------ -! Public routines and variable of this module: -! -! -subroutine ini_read_rivin -! read gnews riverine nutrient and carbon data -! -! -! BLOM_RIVER_NUTRIENTS must be set to TRUE in env_run.xml to activate -! riverine nutrients. -! -! The model attempts to read nutrient fluxes from a NetCDF file -! derived from the GNEWS 2000 data base, which is specified through the -! namelist. The nutrient fluxes in the file are pre-interpolated to the -! ocean grid. -! -! The nutrient discharge is distributed on the ocean grid in manner that is -! consistent with how model distributes its freshwater runoff. -! This has been achieved by using the mapping file used to interpolate the -! runoff also to interpolate the GNEWS nutrient fluxes to the ocean grid. -! -! Since only alkalinity is available from measurements, 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). -! -! Changes: -! -------- -! J. Schwinger, *NORCE climate, Bergen* 2020-05-27 -! - re-structured this module such that riverine input can be passed as an -! argument to iHAMOCC's main routine -! -! J. Schwinger, *NORCE climate, Bergen* 2022-05-18 -! - re-structured and renamed this module such that reading and application of -! data are seperated into two distinct modules -! -!******************************************************************************** -use dimensions, only: idm,jdm -use mod_xc , only: nbdy + !******************************************************************************** + ! + ! S. Gao, *Gfi, Bergen* 19.08.2017 + ! + ! Purpose + ! ------- + ! - Routines for reading riverine nutrient and carbon input data + ! + ! + ! Description: + ! ------------ + ! Public routines and variable of this module: + ! + ! -subroutine ini_read_rivin + ! read gnews riverine nutrient and carbon data + ! + ! + ! BLOM_RIVER_NUTRIENTS must be set to TRUE in env_run.xml to activate + ! riverine nutrients. + ! + ! The model attempts to read nutrient fluxes from a NetCDF file + ! derived from the GNEWS 2000 data base, which is specified through the + ! namelist. The nutrient fluxes in the file are pre-interpolated to the + ! ocean grid. + ! + ! The nutrient discharge is distributed on the ocean grid in manner that is + ! consistent with how model distributes its freshwater runoff. + ! This has been achieved by using the mapping file used to interpolate the + ! runoff also to interpolate the GNEWS nutrient fluxes to the ocean grid. + ! + ! Since only alkalinity is available from measurements, 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). + ! + ! Changes: + ! -------- + ! J. Schwinger, *NORCE climate, Bergen* 2020-05-27 + ! - re-structured this module such that riverine input can be passed as an + ! argument to iHAMOCC's main routine + ! + ! J. Schwinger, *NORCE climate, Bergen* 2022-05-18 + ! - re-structured and renamed this module such that reading and application of + ! data are seperated into two distinct modules + ! + !******************************************************************************** + use dimensions, only: idm,jdm + use mod_xc , only: nbdy -implicit none + implicit none -private -public :: ini_read_rivin,rivinfile,rivflx + private + public :: ini_read_rivin,rivinfile,rivflx -! File name (incl. full path) for input data, set through namelist -! in hamocc_init.F -character(len=256),save :: rivinfile = '' -real,save,allocatable :: rivflx(:,:,:) ! holds input data as read from file + ! File name (incl. full path) for input data, set through namelist + ! in hamocc_init.F + character(len=256),save :: rivinfile = '' + real,save,allocatable :: rivflx(:,:,:) ! holds input data as read from file -! arrays for reading riverine inputs on the model grid -real,save,dimension(1-nbdy:idm+nbdy,1-nbdy:jdm+nbdy) :: riv_DIN2d, riv_DIP2d, & - riv_DSI2d, riv_DIC2d, & - riv_idet2d,riv_idoc2d, & - riv_DFe2d + ! arrays for reading riverine inputs on the model grid + real,save,dimension(1-nbdy:idm+nbdy,1-nbdy:jdm+nbdy) :: riv_DIN2d, riv_DIP2d, & + riv_DSI2d, riv_DIC2d, & + riv_idet2d,riv_idoc2d, & + riv_DFe2d -!******************************************************************************** + !******************************************************************************** contains -subroutine ini_read_rivin(kpie,kpje,omask) -!-------------------------------------------------------------------------------- -! -! Purpose: -! -------- -! Initialise reading of riverine input data (GNEWS 2000) -! -! -! Arguments: -! ---------- -! *INTEGER* *kpie* - 1st dimension of model grid. -! *INTEGER* *kpje* - 2nd dimension of model grid. -! *REAL* *omask* - ocean mask -! -!-------------------------------------------------------------------------------- - use mod_xc, only: mnproc - use mod_dia, only: iotype - use mod_nctools, only: ncfopn,ncread,ncfcls - use mo_control_bgc, only: io_stdo_bgc,do_rivinpt - use mo_param1_bgc, only: nriv,irdin,irdip,irsi,iralk,iriron,irdoc,irdet + subroutine ini_read_rivin(kpie,kpje,omask) + !-------------------------------------------------------------------------------- + ! + ! Purpose: + ! -------- + ! Initialise reading of riverine input data (GNEWS 2000) + ! + ! + ! Arguments: + ! ---------- + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! *REAL* *omask* - ocean mask + ! + !-------------------------------------------------------------------------------- + use mod_xc, only: mnproc + use mod_dia, only: iotype + use mod_nctools, only: ncfopn,ncread,ncfcls + use mo_control_bgc, only: io_stdo_bgc,do_rivinpt + use mo_param1_bgc, only: nriv,irdin,irdip,irsi,iralk,iriron,irdoc,irdet + + implicit none + + integer, intent(in) :: kpie,kpje + real, intent(in) :: omask(kpie,kpje) + + ! local variables + integer :: i,j,errstat,dummymask(2) + + + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)' ' + WRITE(io_stdo_bgc,*)'***************************************************' + WRITE(io_stdo_bgc,*)'iHAMOCC: Initialization of module mo_read_rivin:' + WRITE(io_stdo_bgc,*)' ' + ENDIF - implicit none + ! Allocate field to hold river fluxes + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable rivflx ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',nriv + ENDIF - integer, intent(in) :: kpie,kpje - real, intent(in) :: omask(kpie,kpje) + ALLOCATE (rivflx(kpie,kpje,nriv),stat=errstat) + if(errstat.ne.0) stop 'not enough memory rivflx' + rivflx(:,:,:) = 0.0 - ! local variables - integer :: i,j,errstat,dummymask(2) + ! Return if riverine input is turned off + if (.not. do_rivinpt) then + if (mnproc.eq.1) then + write(io_stdo_bgc,*) '' + write(io_stdo_bgc,*) 'ini_read_rivin: riverine input is not activated.' + endif + return + endif - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'***************************************************' - WRITE(io_stdo_bgc,*)'iHAMOCC: Initialization of module mo_read_rivin:' - WRITE(io_stdo_bgc,*)' ' - ENDIF + ! read riverine nutrient fluxes from file + if (mnproc.eq.1) then + write(io_stdo_bgc,*) '' + write(io_stdo_bgc,*) 'ini_read_rivin: read riverine nutrients from ', & + trim(rivinfile) + endif + call ncfopn(trim(rivinfile),'r',' ',1,iotype) + call ncread('DIN',riv_DIN2d,dummymask,0,0.) + call ncread('DIP',riv_DIP2d,dummymask,0,0.) + call ncread('DSi',riv_DSI2d,dummymask,0,0.) + call ncread('DIC',riv_DIC2d,dummymask,0,0.) ! It is actually alkalinity that is observed + call ncread('Fe',riv_DFe2d,dummymask,0,0.) + call ncread('DOC',riv_idoc2d,dummymask,0,0.) + call ncread('DET',riv_idet2d,dummymask,0,0.) + call ncfcls - ! Allocate field to hold river fluxes - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable rivflx ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',nriv - ENDIF - ALLOCATE (rivflx(kpie,kpje,nriv),stat=errstat) - if(errstat.ne.0) stop 'not enough memory rivflx' - rivflx(:,:,:) = 0.0 + DO j=1,kpje + DO i=1,kpie + IF(omask(i,j).GT.0.5) THEN - ! Return if riverine input is turned off - if (.not. do_rivinpt) then - if (mnproc.eq.1) then - write(io_stdo_bgc,*) '' - write(io_stdo_bgc,*) 'ini_read_rivin: riverine input is not activated.' - endif - return - endif - - ! read riverine nutrient fluxes from file - if (mnproc.eq.1) then - write(io_stdo_bgc,*) '' - write(io_stdo_bgc,*) 'ini_read_rivin: read riverine nutrients from ', & - trim(rivinfile) - endif - call ncfopn(trim(rivinfile),'r',' ',1,iotype) - call ncread('DIN',riv_DIN2d,dummymask,0,0.) - call ncread('DIP',riv_DIP2d,dummymask,0,0.) - call ncread('DSi',riv_DSI2d,dummymask,0,0.) - call ncread('DIC',riv_DIC2d,dummymask,0,0.) ! It is actually alkalinity that is observed - call ncread('Fe',riv_DFe2d,dummymask,0,0.) - call ncread('DOC',riv_idoc2d,dummymask,0,0.) - call ncread('DET',riv_idet2d,dummymask,0,0.) - call ncfcls - - - - DO j=1,kpje - DO i=1,kpie - IF(omask(i,j).GT.0.5) THEN - - rivflx(i,j,irdin) = riv_DIN2d(i,j) - rivflx(i,j,irdip) = riv_DIP2d(i,j) - rivflx(i,j,irsi) = riv_DSI2d(i,j) - rivflx(i,j,iralk) = riv_DIC2d(i,j) - rivflx(i,j,iriron) = riv_DFe2d(i,j) - rivflx(i,j,irdoc) = riv_idoc2d(i,j) - rivflx(i,j,irdet) = riv_idet2d(i,j) + rivflx(i,j,irdin) = riv_DIN2d(i,j) + rivflx(i,j,irdip) = riv_DIP2d(i,j) + rivflx(i,j,irsi) = riv_DSI2d(i,j) + rivflx(i,j,iralk) = riv_DIC2d(i,j) + rivflx(i,j,iriron) = riv_DFe2d(i,j) + rivflx(i,j,irdoc) = riv_idoc2d(i,j) + rivflx(i,j,irdet) = riv_idet2d(i,j) - ENDIF - ENDDO - ENDDO + ENDIF + ENDDO + ENDDO -!-------------------------------------------------------------------------------- -end subroutine ini_read_rivin + !-------------------------------------------------------------------------------- + end subroutine ini_read_rivin -!******************************************************************************** + !******************************************************************************** end module mo_read_rivin diff --git a/hamocc/mo_read_sedpor.F90 b/hamocc/mo_read_sedpor.F90 index 8f51b0ca..d2947a20 100644 --- a/hamocc/mo_read_sedpor.F90 +++ b/hamocc/mo_read_sedpor.F90 @@ -3,129 +3,129 @@ ! 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_read_sedpor -!***************************************************************************** -! Purpose -! ------- -! - Routine for reading sediment porosity from netcdf file -! -! Description -! ----------- -! Public routines and variable of this module: -! -! - subroutine ini_read_sedpor -! read sediment porosity file -! -! L_SED_POR must be set to true in nml to activate -! lon-lat variable sediment porosity. -! -! The model attempts to read lon-lat-sediment depth variable porosity -! from the input file 'SEDPORFILE' (incl. full path) -! -! sed_por holds then the porosity that can be applied later -! via mo_apply_sedpor -! -!***************************************************************************** + !***************************************************************************** + ! Purpose + ! ------- + ! - Routine for reading sediment porosity from netcdf file + ! + ! Description + ! ----------- + ! Public routines and variable of this module: + ! + ! - subroutine ini_read_sedpor + ! read sediment porosity file + ! + ! L_SED_POR must be set to true in nml to activate + ! lon-lat variable sediment porosity. + ! + ! The model attempts to read lon-lat-sediment depth variable porosity + ! from the input file 'SEDPORFILE' (incl. full path) + ! + ! sed_por holds then the porosity that can be applied later + ! via mo_apply_sedpor + ! + !***************************************************************************** -implicit none + implicit none -private + private -public :: read_sedpor,sedporfile + public :: read_sedpor,sedporfile -character(len=512),save :: sedporfile = '' + character(len=512),save :: sedporfile = '' contains -subroutine read_sedpor(kpie,kpje,ks,omask,sed_por) - use mod_xc, only: mnproc,xchalt - use mo_control_bgc, only: io_stdo_bgc,l_3Dvarsedpor - use netcdf, only: nf90_noerr,nf90_nowrite,nf90_close,nf90_open + subroutine read_sedpor(kpie,kpje,ks,omask,sed_por) + use mod_xc, only: mnproc,xchalt + use mo_control_bgc, only: io_stdo_bgc,l_3Dvarsedpor + use netcdf, only: nf90_noerr,nf90_nowrite,nf90_close,nf90_open - implicit none + implicit none + + integer, intent(in) :: kpie,kpje,ks + real, intent(in) :: omask(kpie,kpje) + real, intent(inout) :: sed_por(kpie,kpje,ks) - integer, intent(in) :: kpie,kpje,ks - real, intent(in) :: omask(kpie,kpje) - real, intent(inout) :: sed_por(kpie,kpje,ks) + !local variables + integer :: i,j,k + real :: sed_por_in(kpie,kpje,ks) + logical :: file_exists = .false. + integer :: ncid,ncstat - !local variables - integer :: i,j,k - real :: sed_por_in(kpie,kpje,ks) - logical :: file_exists = .false. - integer :: ncid,ncstat + ! Return if l_3Dvarsedpor is turned off + if (.not. l_3Dvarsedpor) then + if (mnproc.eq.1) then + write(io_stdo_bgc,*) '' + write(io_stdo_bgc,*) 'read_sedpor: spatially variable sediment porosity is not activated.' + endif + return + endif + + ! Check if sediment porosity file exists. If not, abort. + inquire(file=sedporfile,exist=file_exists) + if (.not. file_exists .and. mnproc.eq.1) then + write(io_stdo_bgc,*) '' + write(io_stdo_bgc,*) 'read_sedpor: Cannot find sediment porosity file... ' + call xchalt('(read_sedpor)') + stop '(read_sedpor)' + endif - ! Return if l_3Dvarsedpor is turned off - if (.not. l_3Dvarsedpor) then + ! read sediment porosity from file if (mnproc.eq.1) then write(io_stdo_bgc,*) '' - write(io_stdo_bgc,*) 'read_sedpor: spatially variable sediment porosity is not activated.' + write(io_stdo_bgc,*) 'read_sedpor: read sediment porosity from ', & + trim(sedporfile) endif - return - endif - - ! Check if sediment porosity file exists. If not, abort. - inquire(file=sedporfile,exist=file_exists) - if (.not. file_exists .and. mnproc.eq.1) then - write(io_stdo_bgc,*) '' - write(io_stdo_bgc,*) 'read_sedpor: Cannot find sediment porosity file... ' - call xchalt('(read_sedpor)') - stop '(read_sedpor)' - endif - - ! read sediment porosity from file - if (mnproc.eq.1) then - write(io_stdo_bgc,*) '' - write(io_stdo_bgc,*) 'read_sedpor: read sediment porosity from ', & - trim(sedporfile) - endif - - ! Open netCDF data file - IF(mnproc==1) THEN - ncstat = NF90_OPEN(trim(sedporfile),NF90_NOWRITE, ncid) - IF (ncstat.NE.NF90_NOERR ) THEN - CALL xchalt('(read_sedpor: Problem with netCDF1)') - stop '(read_sedpor: Problem with netCDF1)' + + ! Open netCDF data file + IF(mnproc==1) THEN + ncstat = NF90_OPEN(trim(sedporfile),NF90_NOWRITE, ncid) + IF (ncstat.NE.NF90_NOERR ) THEN + CALL xchalt('(read_sedpor: Problem with netCDF1)') + stop '(read_sedpor: Problem with netCDF1)' + END IF END IF - END IF - ! Read data - call read_netcdf_var(ncid,'sedpor',sed_por_in(1,1,1),ks,0,0) + ! Read data + call read_netcdf_var(ncid,'sedpor',sed_por_in(1,1,1),ks,0,0) - ! Close file - IF(mnproc==1) THEN - ncstat = NF90_CLOSE(ncid) - IF ( ncstat .NE. NF90_NOERR ) THEN - CALL xchalt('(read_sedpor: Problem with netCDF200)') - stop '(read_sedpor: Problem with netCDF200)' + ! Close file + IF(mnproc==1) THEN + ncstat = NF90_CLOSE(ncid) + IF ( ncstat .NE. NF90_NOERR ) THEN + CALL xchalt('(read_sedpor: Problem with netCDF200)') + stop '(read_sedpor: Problem with netCDF200)' + END IF END IF - END IF - - - do k=1,ks - do j=1,kpje - do i=1,kpie - if(omask(i,j).gt. 0.5)then - sed_por(i,j,k)=sed_por_in(i,j,k) - else - sed_por(i,j,k)=0. - endif - enddo - enddo - enddo - -end subroutine read_sedpor + + + do k=1,ks + do j=1,kpje + do i=1,kpie + if(omask(i,j).gt. 0.5)then + sed_por(i,j,k)=sed_por_in(i,j,k) + else + sed_por(i,j,k)=0. + endif + enddo + enddo + enddo + + end subroutine read_sedpor end module mo_read_sedpor diff --git a/hamocc/mo_sedmnt.F90 b/hamocc/mo_sedmnt.F90 index 3b2c2963..0498abf2 100644 --- a/hamocc/mo_sedmnt.F90 +++ b/hamocc/mo_sedmnt.F90 @@ -4,437 +4,437 @@ ! 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_sedmnt -!****************************************************************************** -! -! MODULE mo_sedmnt - Variables for sediment modules. -! -! S.Legutke, *MPI-MaD, HH* 31.10.01 -! -! Modified -! -------- -! J.Schwinger, *Uni Research, Bergen* 2018-04-12 -! - added sediment bypass preprocessor option -! -! Purpose -! ------- -! - declaration and memory allocation -! - initialization of sediment -! -! Description: -! ------------ -! Public routines and variable of this module: -! -! -subroutine alloc_mem_sedmnt -! Allocate memory for sediment variables -! -! *sedlay* *REAL* - . -! *sedla1* *REAL* - . -! *sedtot* *REAL* - . -! *sedtoa* *REAL* - . -! *seffel* *REAL* - . -! *sedhpl* *REAL* - . -! *powtra* *REAL* - . -! *prorca* *REAL* - . -! *prcaca* *REAL* - . -! *silpro* *REAL* - . -! *porwat* *REAL* - . -! *porsol* *REAL* - . -! *seddzi* *REAL* - . -! *dzs* *REAL* - . -! *porwah* *REAL* - . -! *seddw* *REAL* - . -! *calcon* *REAL* - . -! -! -subroutine ini_sedmnt -! Initialize sediment parameters and sediment vertical grid -! -subroutine ini_sedmnt_fields -! Initialize 2D and 3D sediment fields -! -!****************************************************************************** - use mod_xc, only: mnproc - use mo_param1_bgc, only: ks,ksp,nsedtra,npowtra - use mo_control_bgc, only: io_stdo_bgc - use mo_control_bgc, only: use_sedbypass,use_cisonew - - implicit none - - REAL, protected :: dzs(ksp) = 0.0 - REAL, protected :: seddzi(ksp) = 0.0 - REAL, protected :: seddw(ks) = 0.0 - - REAL, DIMENSION (:,:,:,:), ALLOCATABLE :: sedlay - REAL, DIMENSION (:,:,:,:), ALLOCATABLE :: powtra - REAL, DIMENSION (:,:,:), ALLOCATABLE :: sedhpl - REAL, DIMENSION (:,:,:), ALLOCATABLE :: porsol - REAL, DIMENSION (:,:,:), ALLOCATABLE :: porwah - REAL, DIMENSION (:,:,:), ALLOCATABLE :: porwat - REAL, DIMENSION (:,:), ALLOCATABLE :: solfu - REAL, DIMENSION (:,:,:), ALLOCATABLE :: zcoefsu - REAL, DIMENSION (:,:,:), ALLOCATABLE :: zcoeflo - - REAL, DIMENSION (:,:), ALLOCATABLE :: silpro - REAL, DIMENSION (:,:), ALLOCATABLE :: prorca - REAL, DIMENSION (:,:), ALLOCATABLE :: pror13 - REAL, DIMENSION (:,:), ALLOCATABLE :: prca13 - REAL, DIMENSION (:,:), ALLOCATABLE :: pror14 - REAL, DIMENSION (:,:), ALLOCATABLE :: prca14 - REAL, DIMENSION (:,:), ALLOCATABLE :: prcaca - REAL, DIMENSION (:,:), ALLOCATABLE :: produs - REAL, DIMENSION (:,:,:), ALLOCATABLE :: burial - - real, protected :: calfa, oplfa, orgfa, clafa - - CONTAINS - -!======================================================================== - SUBROUTINE ini_sedmnt(kpie,kpje,kpke,omask,sed_por) - - use mo_param_bgc, only: claydens,calcwei,calcdens,opalwei,opaldens,orgwei,orgdens,sedict - - implicit none - - integer, intent(in) :: kpie,kpje,kpke - real, intent(in) :: omask(kpie,kpje) - real, intent(in) :: sed_por(kpie,kpje,ks) - - integer :: k - - ! define volumes occupied by solid constituents [m3/kmol] - calfa = calcwei / calcdens - oplfa = opalwei / opaldens - orgfa = orgwei / orgdens - clafa = 1. / claydens !clay is calculated in kg/m3 - - ! sediment layer thickness - dzs(1) = 0.001 - dzs(2) = 0.003 - dzs(3) = 0.005 - dzs(4) = 0.007 - dzs(5) = 0.009 - dzs(6) = 0.011 - dzs(7) = 0.013 - dzs(8) = 0.015 - dzs(9) = 0.017 - dzs(10) = 0.019 - dzs(11) = 0.021 - dzs(12) = 0.023 - dzs(13) = 0.025 - - if (mnproc == 1) then - write(io_stdo_bgc,*) ' ' - write(io_stdo_bgc,*) 'Sediment layer thickness [m] : ' - write(io_stdo_bgc,'(5F9.3)') dzs - write(io_stdo_bgc,*) ' ' - endif - - seddzi(1) = 500. - do k = 1, ks - seddzi(k+1) = 1. / dzs(k+1) ! inverse of grid cell size - seddw(k) = 0.5 * (dzs(k) + dzs(k+1)) ! distance between grid cell centers (pressure points) - enddo - - 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) - endif - - END SUBROUTINE ini_sedmnt - - !======================================================================== - SUBROUTINE ini_sedmnt_por(kpie,kpje,kpke,omask,sed_por) -! -! Initialization of: -! - 3D porosity field (cell center and cell boundaries) -! - solid volume fraction at cell center -! - vertical molecular diffusion coefficients scaled with porosity -! - use mo_control_bgc, only: l_3Dvarsedpor - use mo_param_bgc, only: sedict - - implicit none - - integer, intent(in) :: kpie,kpje,kpke - real, intent(in) :: omask(kpie,kpje) - real, intent(in) :: sed_por(kpie,kpje,ks) - - ! local - integer :: i,j,k - - ! this initialization can be done via reading a porosity map - ! porwat is the poroisty at the (pressure point) center of the grid cell - if (l_3Dvarsedpor)then - ! lon-lat variable sediment porosity from input file - do k=1,ks +MODULE mo_sedmnt + !****************************************************************************** + ! + ! MODULE mo_sedmnt - Variables for sediment modules. + ! + ! S.Legutke, *MPI-MaD, HH* 31.10.01 + ! + ! Modified + ! -------- + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - added sediment bypass preprocessor option + ! + ! Purpose + ! ------- + ! - declaration and memory allocation + ! - initialization of sediment + ! + ! Description: + ! ------------ + ! Public routines and variable of this module: + ! + ! -subroutine alloc_mem_sedmnt + ! Allocate memory for sediment variables + ! + ! *sedlay* *REAL* - . + ! *sedla1* *REAL* - . + ! *sedtot* *REAL* - . + ! *sedtoa* *REAL* - . + ! *seffel* *REAL* - . + ! *sedhpl* *REAL* - . + ! *powtra* *REAL* - . + ! *prorca* *REAL* - . + ! *prcaca* *REAL* - . + ! *silpro* *REAL* - . + ! *porwat* *REAL* - . + ! *porsol* *REAL* - . + ! *seddzi* *REAL* - . + ! *dzs* *REAL* - . + ! *porwah* *REAL* - . + ! *seddw* *REAL* - . + ! *calcon* *REAL* - . + ! + ! -subroutine ini_sedmnt + ! Initialize sediment parameters and sediment vertical grid + ! -subroutine ini_sedmnt_fields + ! Initialize 2D and 3D sediment fields + ! + !****************************************************************************** + use mod_xc, only: mnproc + use mo_param1_bgc, only: ks,ksp,nsedtra,npowtra + use mo_control_bgc, only: io_stdo_bgc + use mo_control_bgc, only: use_sedbypass,use_cisonew + + implicit none + + REAL, protected :: dzs(ksp) = 0.0 + REAL, protected :: seddzi(ksp) = 0.0 + REAL, protected :: seddw(ks) = 0.0 + + REAL, DIMENSION (:,:,:,:), ALLOCATABLE :: sedlay + REAL, DIMENSION (:,:,:,:), ALLOCATABLE :: powtra + REAL, DIMENSION (:,:,:), ALLOCATABLE :: sedhpl + REAL, DIMENSION (:,:,:), ALLOCATABLE :: porsol + REAL, DIMENSION (:,:,:), ALLOCATABLE :: porwah + REAL, DIMENSION (:,:,:), ALLOCATABLE :: porwat + REAL, DIMENSION (:,:), ALLOCATABLE :: solfu + REAL, DIMENSION (:,:,:), ALLOCATABLE :: zcoefsu + REAL, DIMENSION (:,:,:), ALLOCATABLE :: zcoeflo + + REAL, DIMENSION (:,:), ALLOCATABLE :: silpro + REAL, DIMENSION (:,:), ALLOCATABLE :: prorca + REAL, DIMENSION (:,:), ALLOCATABLE :: pror13 + REAL, DIMENSION (:,:), ALLOCATABLE :: prca13 + REAL, DIMENSION (:,:), ALLOCATABLE :: pror14 + REAL, DIMENSION (:,:), ALLOCATABLE :: prca14 + REAL, DIMENSION (:,:), ALLOCATABLE :: prcaca + REAL, DIMENSION (:,:), ALLOCATABLE :: produs + REAL, DIMENSION (:,:,:), ALLOCATABLE :: burial + + real, protected :: calfa, oplfa, orgfa, clafa + +CONTAINS + + !======================================================================== + SUBROUTINE ini_sedmnt(kpie,kpje,kpke,omask,sed_por) + + use mo_param_bgc, only: claydens,calcwei,calcdens,opalwei,opaldens,orgwei,orgdens,sedict + + implicit none + + integer, intent(in) :: kpie,kpje,kpke + real, intent(in) :: omask(kpie,kpje) + real, intent(in) :: sed_por(kpie,kpje,ks) + + integer :: k + + ! define volumes occupied by solid constituents [m3/kmol] + calfa = calcwei / calcdens + oplfa = opalwei / opaldens + orgfa = orgwei / orgdens + clafa = 1. / claydens !clay is calculated in kg/m3 + + ! sediment layer thickness + dzs(1) = 0.001 + dzs(2) = 0.003 + dzs(3) = 0.005 + dzs(4) = 0.007 + dzs(5) = 0.009 + dzs(6) = 0.011 + dzs(7) = 0.013 + dzs(8) = 0.015 + dzs(9) = 0.017 + dzs(10) = 0.019 + dzs(11) = 0.021 + dzs(12) = 0.023 + dzs(13) = 0.025 + + if (mnproc == 1) then + write(io_stdo_bgc,*) ' ' + write(io_stdo_bgc,*) 'Sediment layer thickness [m] : ' + write(io_stdo_bgc,'(5F9.3)') dzs + write(io_stdo_bgc,*) ' ' + endif + + seddzi(1) = 500. + do k = 1, ks + seddzi(k+1) = 1. / dzs(k+1) ! inverse of grid cell size + seddw(k) = 0.5 * (dzs(k) + dzs(k+1)) ! distance between grid cell centers (pressure points) + enddo + + 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) + endif + + END SUBROUTINE ini_sedmnt + + !======================================================================== + SUBROUTINE ini_sedmnt_por(kpie,kpje,kpke,omask,sed_por) + ! + ! Initialization of: + ! - 3D porosity field (cell center and cell boundaries) + ! - solid volume fraction at cell center + ! - vertical molecular diffusion coefficients scaled with porosity + ! + use mo_control_bgc, only: l_3Dvarsedpor + use mo_param_bgc, only: sedict + + implicit none + + integer, intent(in) :: kpie,kpje,kpke + real, intent(in) :: omask(kpie,kpje) + real, intent(in) :: sed_por(kpie,kpje,ks) + + ! local + integer :: i,j,k + + ! this initialization can be done via reading a porosity map + ! porwat is the poroisty at the (pressure point) center of the grid cell + if (l_3Dvarsedpor)then + ! lon-lat variable sediment porosity from input file + do k=1,ks do j=1,kpje - do i=1,kpie - if(omask(i,j).gt. 0.5) then + do i=1,kpie + if(omask(i,j).gt. 0.5) then porwat(i,j,k) = sed_por(i,j,k) - endif - enddo + endif + enddo enddo - enddo - else - porwat(:,:,1) = 0.85 - porwat(:,:,2) = 0.83 - porwat(:,:,3) = 0.8 - porwat(:,:,4) = 0.79 - porwat(:,:,5) = 0.77 - porwat(:,:,6) = 0.75 - porwat(:,:,7) = 0.73 - porwat(:,:,8) = 0.7 - porwat(:,:,9) = 0.68 - porwat(:,:,10) = 0.66 - porwat(:,:,11) = 0.64 - porwat(:,:,12) = 0.62 - endif - - if (mnproc == 1) then - write(io_stdo_bgc,*) 'Pore water in sediment initialized' - endif - - do k = 1, ks - do j = 1, kpje - do i = 1, kpie - porsol(i,j,k) = 1. - porwat(i,j,k) ! solid volume fraction at grid center - if(k >= 2) porwah(i,j,k) = 0.5 * (porwat(i,j,k) + porwat(i,j,k-1)) ! porosity at cell interfaces - if(k == 1) porwah(i,j,k) = 0.5 * (1. + porwat(i,j,1)) - enddo enddo + else + porwat(:,:,1) = 0.85 + porwat(:,:,2) = 0.83 + porwat(:,:,3) = 0.8 + porwat(:,:,4) = 0.79 + porwat(:,:,5) = 0.77 + porwat(:,:,6) = 0.75 + porwat(:,:,7) = 0.73 + porwat(:,:,8) = 0.7 + porwat(:,:,9) = 0.68 + porwat(:,:,10) = 0.66 + porwat(:,:,11) = 0.64 + porwat(:,:,12) = 0.62 + endif + + if (mnproc == 1) then + write(io_stdo_bgc,*) 'Pore water in sediment initialized' + endif + + do k = 1, ks + do j = 1, kpje + do i = 1, kpie + porsol(i,j,k) = 1. - porwat(i,j,k) ! solid volume fraction at grid center + if(k >= 2) porwah(i,j,k) = 0.5 * (porwat(i,j,k) + porwat(i,j,k-1)) ! porosity at cell interfaces + if(k == 1) porwah(i,j,k) = 0.5 * (1. + porwat(i,j,1)) + enddo enddo + enddo - ! determine total solid sediment volume - solfu = 0. - do i = 1, kpie + ! determine total solid sediment volume + solfu = 0. + do i = 1, kpie do j = 1, kpje - do k = 1, ks - solfu(i,j) = solfu(i,j) + seddw(k) * porsol(i,j,k) - enddo - enddo + do k = 1, ks + solfu(i,j) = solfu(i,j) + seddw(k) * porsol(i,j,k) + enddo enddo + enddo - ! Initialize porosity-dependent diffusion coefficients of sediment - zcoefsu(:,:,0) = 0.0 - do k = 1,ks + ! Initialize porosity-dependent diffusion coefficients of sediment + zcoefsu(:,:,0) = 0.0 + do k = 1,ks do j = 1, kpje - do i = 1, kpie - ! sediment diffusion coefficient * 1/dz * fraction of pore water at half depths - zcoefsu(i,j,k ) = -sedict * seddzi(k) * porwah(i,j,k) - zcoeflo(i,j,k-1) = -sedict * seddzi(k) * porwah(i,j,k) ! why the same ? - enddo - enddo + do i = 1, kpie + ! sediment diffusion coefficient * 1/dz * fraction of pore water at half depths + zcoefsu(i,j,k ) = -sedict * seddzi(k) * porwah(i,j,k) + zcoeflo(i,j,k-1) = -sedict * seddzi(k) * porwah(i,j,k) ! why the same ? + enddo enddo - zcoeflo(:,:,ks) = 0.0 ! diffusion coefficient for bottom sediment layer - - if (mnproc == 1) then - write(io_stdo_bgc,*) 'Pore water diffusion coefficients in sediment initialized' - endif + enddo + zcoeflo(:,:,ks) = 0.0 ! diffusion coefficient for bottom sediment layer - END SUBROUTINE ini_sedmnt_por + if (mnproc == 1) then + write(io_stdo_bgc,*) 'Pore water diffusion coefficients in sediment initialized' + endif + END SUBROUTINE ini_sedmnt_por - !======================================================================== - SUBROUTINE ALLOC_MEM_SEDMNT(kpie,kpje) - !****************************************************************************** - ! ALLOC_MEM_SEDMNT - Allocate variables in this module - !****************************************************************************** - INTEGER, intent(in) :: kpie,kpje - INTEGER :: errstat - IF (mnproc.eq.1) THEN + !======================================================================== + SUBROUTINE ALLOC_MEM_SEDMNT(kpie,kpje) + !****************************************************************************** + ! ALLOC_MEM_SEDMNT - Allocate variables in this module + !****************************************************************************** + INTEGER, intent(in) :: kpie,kpje + INTEGER :: errstat + + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)' ' WRITE(io_stdo_bgc,*)'***************************************************' WRITE(io_stdo_bgc,*)'Memory allocation for sediment module :' WRITE(io_stdo_bgc,*)' ' - ENDIF + ENDIF - IF (mnproc.eq.1) THEN + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable silpro ...' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF + ENDIF - ALLOCATE (silpro(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory silpro' - silpro(:,:) = 0.0 + ALLOCATE (silpro(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory silpro' + silpro(:,:) = 0.0 - IF (mnproc.eq.1) THEN + IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)'Memory allocation for variable prorca ...' WRITE(io_stdo_bgc,*)'First dimension : ',kpie WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + ENDIF + + ALLOCATE (prorca(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory prorca' + prorca(:,:) = 0.0 + 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 + endif + + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable prcaca ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + ENDIF + + ALLOCATE (prcaca(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory prcaca' + prcaca(:,:) = 0.0 + 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 + endif + + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable produs ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + ENDIF + + ALLOCATE (produs(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory produs' + produs(:,:) = 0.0 + + + 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 (prorca(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory prorca' - prorca(:,:) = 0.0 - 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 - 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 prcaca ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + 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 (prcaca(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory prcaca' - prcaca(:,:) = 0.0 - 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 - 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 produs ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + 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 (produs(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory produs' - produs(:,:) = 0.0 - - - 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 - endif - - -!****************************************************************************** - END SUBROUTINE ALLOC_MEM_SEDMNT - - END MODULE mo_sedmnt + 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 + + + !****************************************************************************** + END SUBROUTINE ALLOC_MEM_SEDMNT + +END MODULE mo_sedmnt diff --git a/hamocc/mo_vgrid.F90 b/hamocc/mo_vgrid.F90 index e010e92e..1c642780 100644 --- a/hamocc/mo_vgrid.F90 +++ b/hamocc/mo_vgrid.F90 @@ -3,66 +3,66 @@ ! 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_vgrid -!****************************************************************************** -! -! MODULE mo_vgrid - Variables and routines related to vertical grid -! structure -! -! J.Schwinger, *NORCE Climate, Bergen* 2020-05-19 -! -! Modified -! -------- -! -! Purpose -! ------- -! Declaration, memory allocation, and routines related to the -! vertical grid structure. These have to be recalculated every -! time step when iHAMOCC is coupled to BLOM. -! -! Description: -! ------------ -! Public routines and variables of this module: -! -! -subroutine set_vgrid -! Calculate variables related to the vertical grid structure. -! -! -subroutine alloc_mem_vgrid -! Allocate memory for vertical grid variables -! -! *kbo* *INTEGER* - number of wet cells in column. -! *kwrbioz* *INTEGER* - last k-index of euphotic zone. -! *kxxxx* *INTEGER* - k-index of gridbox comprising xxxx m depth. -! *bolay* *REAL* - height of bottom cell. -! *ptiestu* *REAL* - depth of layer centres. -! *ptiestw* *REAL* - depth of layer interfaces. -! -!****************************************************************************** + !****************************************************************************** + ! + ! MODULE mo_vgrid - Variables and routines related to vertical grid + ! structure + ! + ! J.Schwinger, *NORCE Climate, Bergen* 2020-05-19 + ! + ! Modified + ! -------- + ! + ! Purpose + ! ------- + ! Declaration, memory allocation, and routines related to the + ! vertical grid structure. These have to be recalculated every + ! time step when iHAMOCC is coupled to BLOM. + ! + ! Description: + ! ------------ + ! Public routines and variables of this module: + ! + ! -subroutine set_vgrid + ! Calculate variables related to the vertical grid structure. + ! + ! -subroutine alloc_mem_vgrid + ! Allocate memory for vertical grid variables + ! + ! *kbo* *INTEGER* - number of wet cells in column. + ! *kwrbioz* *INTEGER* - last k-index of euphotic zone. + ! *kxxxx* *INTEGER* - k-index of gridbox comprising xxxx m depth. + ! *bolay* *REAL* - height of bottom cell. + ! *ptiestu* *REAL* - depth of layer centres. + ! *ptiestw* *REAL* - depth of layer interfaces. + ! + !****************************************************************************** implicit none INTEGER, PARAMETER :: kmle_static = 2 ! k-end index for layers that - ! represent the mixed layer in BLOM. - ! Default value used for isopycnic coordinates. + ! represent the mixed layer in BLOM. + ! Default value used for isopycnic coordinates. REAL, PARAMETER :: dp_ez = 100.0 ! depth of euphotic zone REAL, PARAMETER :: dp_min = 1.0E-12 ! min layer thickness layers thinner - ! than this are ignored by HAMOCC - REAL, PARAMETER :: dp_min_sink = 1.0 ! min layer thickness for sinking (layers thinner than - ! this are ignored and set to the concentration of the - ! layer above). Note that the bottom layer index kbo(i,j) - ! is defined as the lowermost layer thicker than dp_min_sink. + ! than this are ignored by HAMOCC + REAL, PARAMETER :: dp_min_sink = 1.0 ! min layer thickness for sinking (layers thinner than + ! this are ignored and set to the concentration of the + ! layer above). Note that the bottom layer index kbo(i,j) + ! is defined as the lowermost layer thicker than dp_min_sink. INTEGER, DIMENSION(:,:), ALLOCATABLE :: kmle INTEGER, DIMENSION(:,:), ALLOCATABLE :: kbo @@ -73,264 +73,264 @@ module mo_vgrid REAL, DIMENSION(:,:,:), ALLOCATABLE :: ptiestw contains -!****************************************************************************** - - - -subroutine set_vgrid(kpie,kpje,kpke,pddpo) -!****************************************************************************** -! -! SET_VGRID - Calculate variables related to the vertical grid structure. This -! routine replaces calc_idepth and calc_bot. -! -! J.Schwinger *NORCE Climate, Bergen* 2020-05-19 -! -! Purpose -! ------- -! -calculate depth of layer interfaces and centres based on layer thickness -! -find lowest mass containing layer in the euphotic zone -! -find k-index of 100,500,1000,2000, and 4000 m-surfaces -! -! Parameter list: -! --------------- -! *INTEGER* *kpie* - 1st dimension of model grid. -! *INTEGER* *kpje* - 2nd dimension of model grid. -! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. -! *REAL* *pddpo* - size of grid cell (3rd dimension) [m]. -! -!****************************************************************************** - INTEGER, intent(in) :: kpie,kpje,kpke - REAL, intent(in) :: pddpo(kpie,kpje,kpke) - - INTEGER :: i,j,k - - - ! --- set depth of surface interface to zero - ptiestw(:,:,1)=0. - ! --- depth of layer kpke+1 centre - ptiestu(:,:,kpke+1)=9000. - -!$OMP PARALLEL DO PRIVATE(j,i) - do k=1,kpke - do j=1,kpje - do i=1,kpie - - ! --- depth of layer interfaces - ptiestw(i,j,k+1)=ptiestw(i,j,k)+pddpo(i,j,k) - ! --- depth of layer centres - ptiestu(i,j,k)=ptiestw(i,j,k)+0.5*pddpo(i,j,k) - + !****************************************************************************** + + + + subroutine set_vgrid(kpie,kpje,kpke,pddpo) + !****************************************************************************** + ! + ! SET_VGRID - Calculate variables related to the vertical grid structure. This + ! routine replaces calc_idepth and calc_bot. + ! + ! J.Schwinger *NORCE Climate, Bergen* 2020-05-19 + ! + ! Purpose + ! ------- + ! -calculate depth of layer interfaces and centres based on layer thickness + ! -find lowest mass containing layer in the euphotic zone + ! -find k-index of 100,500,1000,2000, and 4000 m-surfaces + ! + ! Parameter list: + ! --------------- + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. + ! *REAL* *pddpo* - size of grid cell (3rd dimension) [m]. + ! + !****************************************************************************** + INTEGER, intent(in) :: kpie,kpje,kpke + REAL, intent(in) :: pddpo(kpie,kpje,kpke) + + INTEGER :: i,j,k + + + ! --- set depth of surface interface to zero + ptiestw(:,:,1)=0. + ! --- depth of layer kpke+1 centre + ptiestu(:,:,kpke+1)=9000. + + !$OMP PARALLEL DO PRIVATE(j,i) + do k=1,kpke + do j=1,kpje + do i=1,kpie + + ! --- depth of layer interfaces + ptiestw(i,j,k+1)=ptiestw(i,j,k)+pddpo(i,j,k) + ! --- depth of layer centres + ptiestu(i,j,k)=ptiestw(i,j,k)+0.5*pddpo(i,j,k) + + enddo + enddo enddo - enddo - enddo -!$OMP END PARALLEL DO - - - kbo(:,:) =1 - bolay(:,:)=0.0 - -!$OMP PARALLEL DO PRIVATE(i,k) - DO j=1,kpje - DO i=1,kpie - - DO k=kpke,1,-1 - IF(pddpo(i,j,k).GT.dp_min_sink) THEN - bolay(i,j)=pddpo(i,j,k) - kbo(i,j)=k - exit - ENDIF - ENDDO - - ENDDO - ENDDO -!$OMP END PARALLEL DO + !$OMP END PARALLEL DO -!$OMP PARALLEL DO PRIVATE(i,k) - DO j=1,kpje - DO i=1,kpie + kbo(:,:) =1 + bolay(:,:)=0.0 - kwrbioz(i,j)=1 - DO k=2,kpke - IF(pddpo(i,j,k) .gt. dp_min .and. ptiestw(i,j,k) .lt. dp_ez ) THEN - kwrbioz(i,j)=k - ENDIF - END DO + !$OMP PARALLEL DO PRIVATE(i,k) + DO j=1,kpje + DO i=1,kpie - END DO - END DO -!$OMP END PARALLEL DO + DO k=kpke,1,-1 + IF(pddpo(i,j,k).GT.dp_min_sink) THEN + bolay(i,j)=pddpo(i,j,k) + kbo(i,j)=k + exit + ENDIF + ENDDO + ENDDO + ENDDO + !$OMP END PARALLEL DO - k0100(:,:)=0 - k0500(:,:)=0 - k1000(:,:)=0 - k2000(:,:)=0 - k4000(:,:)=0 -!$OMP PARALLEL DO PRIVATE(i,k) - DO j=1,kpje - DO i=1,kpie + !$OMP PARALLEL DO PRIVATE(i,k) + DO j=1,kpje + DO i=1,kpie - DO k=2,kpke - IF(pddpo(i,j,k) .gt. dp_min .and. ptiestw(i,j,k+1) .gt. 100.0 ) THEN - k0100(i,j)=k - exit - ENDIF - END DO - - DO k=2,kpke - IF(pddpo(i,j,k) .gt. dp_min .and. ptiestw(i,j,k+1) .gt. 500.0 ) THEN - k0500(i,j)=k - exit - ENDIF - END DO + kwrbioz(i,j)=1 + DO k=2,kpke + IF(pddpo(i,j,k) .gt. dp_min .and. ptiestw(i,j,k) .lt. dp_ez ) THEN + kwrbioz(i,j)=k + ENDIF + END DO - DO k=2,kpke - IF(pddpo(i,j,k) .gt. dp_min .and. ptiestw(i,j,k+1) .gt. 1000.0 ) THEN - k1000(i,j)=k - exit - ENDIF + END DO END DO - - DO k=2,kpke - IF(pddpo(i,j,k) .gt. dp_min .and. ptiestw(i,j,k+1) .gt. 2000.0 ) THEN - k2000(i,j)=k - exit - ENDIF + !$OMP END PARALLEL DO + + + k0100(:,:)=0 + k0500(:,:)=0 + k1000(:,:)=0 + k2000(:,:)=0 + k4000(:,:)=0 + + !$OMP PARALLEL DO PRIVATE(i,k) + DO j=1,kpje + DO i=1,kpie + + DO k=2,kpke + IF(pddpo(i,j,k) .gt. dp_min .and. ptiestw(i,j,k+1) .gt. 100.0 ) THEN + k0100(i,j)=k + exit + ENDIF + END DO + + DO k=2,kpke + IF(pddpo(i,j,k) .gt. dp_min .and. ptiestw(i,j,k+1) .gt. 500.0 ) THEN + k0500(i,j)=k + exit + ENDIF + END DO + + DO k=2,kpke + IF(pddpo(i,j,k) .gt. dp_min .and. ptiestw(i,j,k+1) .gt. 1000.0 ) THEN + k1000(i,j)=k + exit + ENDIF + END DO + + DO k=2,kpke + IF(pddpo(i,j,k) .gt. dp_min .and. ptiestw(i,j,k+1) .gt. 2000.0 ) THEN + k2000(i,j)=k + exit + ENDIF + END DO + + DO k=2,kpke + IF(pddpo(i,j,k) .gt. dp_min .and. ptiestw(i,j,k+1) .gt. 4000.0 ) THEN + k4000(i,j)=k + exit + ENDIF + END DO + + END DO END DO + !$OMP END PARALLEL DO - DO k=2,kpke - IF(pddpo(i,j,k) .gt. dp_min .and. ptiestw(i,j,k+1) .gt. 4000.0 ) THEN - k4000(i,j)=k - exit - ENDIF - END DO + RETURN - END DO - END DO -!$OMP END PARALLEL DO + !****************************************************************************** + end subroutine set_vgrid - RETURN -!****************************************************************************** -end subroutine set_vgrid + subroutine alloc_mem_vgrid(kpie,kpje,kpke) + !****************************************************************************** + ! + ! ALLOC_MEM_VGRID - Allocate variables in this module + ! + ! J.Schwinger *NORCE Climate, Bergen* 2020-05-19 + ! + !****************************************************************************** + use mod_xc, only: mnproc + use mo_control_bgc, only: io_stdo_bgc + INTEGER, intent(in) :: kpie,kpje,kpke + INTEGER :: errstat -subroutine alloc_mem_vgrid(kpie,kpje,kpke) -!****************************************************************************** -! -! ALLOC_MEM_VGRID - Allocate variables in this module -! -! J.Schwinger *NORCE Climate, Bergen* 2020-05-19 -! -!****************************************************************************** - use mod_xc, only: mnproc - use mo_control_bgc, only: io_stdo_bgc - - INTEGER, intent(in) :: kpie,kpje,kpke - INTEGER :: errstat - - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'***************************************************' - WRITE(io_stdo_bgc,*)'Memory allocation for module mo_vgrid :' - WRITE(io_stdo_bgc,*)' ' - ENDIF + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)' ' + WRITE(io_stdo_bgc,*)'***************************************************' + WRITE(io_stdo_bgc,*)'Memory allocation for module mo_vgrid :' + WRITE(io_stdo_bgc,*)' ' + ENDIF - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable ptiestu ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',kpke+1 - ENDIF + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable ptiestu ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',kpke+1 + ENDIF - ALLOCATE (ptiestu(kpie,kpje,kpke+1),stat=errstat) - if(errstat.ne.0) stop 'not enough memory ptiestu' - ptiestu(:,:,:) = 0.0 + ALLOCATE (ptiestu(kpie,kpje,kpke+1),stat=errstat) + if(errstat.ne.0) stop 'not enough memory ptiestu' + ptiestu(:,:,:) = 0.0 - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable ptiestw ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',kpke+1 - ENDIF + IF (mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable ptiestw ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + WRITE(io_stdo_bgc,*)'Third dimension : ',kpke+1 + ENDIF - ALLOCATE (ptiestw(kpie,kpje,kpke+1),stat=errstat) - if(errstat.ne.0) stop 'not enough memory ptiestw' - ptiestw(:,:,:) = 0.0 + ALLOCATE (ptiestw(kpie,kpje,kpke+1),stat=errstat) + if(errstat.ne.0) stop 'not enough memory ptiestw' + ptiestw(:,:,:) = 0.0 - IF(mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable kmle ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF + IF(mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable kmle ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + ENDIF - ALLOCATE(kmle(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory kmle' - kmle(:,:) = kmle_static + ALLOCATE(kmle(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory kmle' + kmle(:,:) = kmle_static - IF(mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable kbo ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF + IF(mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable kbo ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + ENDIF - ALLOCATE(kbo(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory kbo' - kbo(:,:) = 0 + ALLOCATE(kbo(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory kbo' + kbo(:,:) = 0 - IF(mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable kwrbioz...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF + IF(mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable kwrbioz...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + ENDIF - ALLOCATE(kwrbioz(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory kwrbioz' - kwrbioz(:,:) = 0 + ALLOCATE(kwrbioz(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory kwrbioz' + kwrbioz(:,:) = 0 - IF(mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variables k0100, k0500, k1000, k2000 ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF + IF(mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variables k0100, k0500, k1000, k2000 ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + ENDIF - ALLOCATE(k0100(kpie,kpje),stat=errstat) - ALLOCATE(k0500(kpie,kpje),stat=errstat) - ALLOCATE(k1000(kpie,kpje),stat=errstat) - ALLOCATE(k2000(kpie,kpje),stat=errstat) - ALLOCATE(k4000(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory k0100, k0500, k1000, k2000' - k0100(:,:) = 0 - k0500(:,:) = 0 - k1000(:,:) = 0 - k2000(:,:) = 0 - k4000(:,:) = 0 + ALLOCATE(k0100(kpie,kpje),stat=errstat) + ALLOCATE(k0500(kpie,kpje),stat=errstat) + ALLOCATE(k1000(kpie,kpje),stat=errstat) + ALLOCATE(k2000(kpie,kpje),stat=errstat) + ALLOCATE(k4000(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory k0100, k0500, k1000, k2000' + k0100(:,:) = 0 + k0500(:,:) = 0 + k1000(:,:) = 0 + k2000(:,:) = 0 + k4000(:,:) = 0 - IF(mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable bolay ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - ENDIF + IF(mnproc.eq.1) THEN + WRITE(io_stdo_bgc,*)'Memory allocation for variable bolay ...' + WRITE(io_stdo_bgc,*)'First dimension : ',kpie + WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + ENDIF - ALLOCATE (bolay(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory bolay' - bolay(:,:) = 0.0 + ALLOCATE (bolay(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory bolay' + bolay(:,:) = 0.0 -!****************************************************************************** -end subroutine alloc_mem_vgrid + !****************************************************************************** + end subroutine alloc_mem_vgrid -!****************************************************************************** + !****************************************************************************** end module mo_vgrid diff --git a/hamocc/ncout_hamocc.F90 b/hamocc/ncout_hamocc.F90 index 7e0ab6f1..e459eff2 100644 --- a/hamocc/ncout_hamocc.F90 +++ b/hamocc/ncout_hamocc.F90 @@ -18,138 +18,138 @@ subroutine ncwrt_bgc(iogrp) -! -! --- ------------------------------------------- -! --- output routine for HAMOCC diagnostic fields -! --- ------------------------------------------- -! + ! + ! --- ------------------------------------------- + ! --- output routine for HAMOCC diagnostic fields + ! --- ------------------------------------------- + ! use mod_time, only: date0,date,calendar,nstep,nstep_in_day, & - nday_of_year,time0,time + 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 + depthslev_bnds use mo_control_bgc, only: dtbgc,use_cisonew,use_AGG,use_CFC,use_natDIC, & - use_BROMO,use_sedbypass,use_BOXATM + 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, & - 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 + 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_param_bgc, only: c14fac implicit none @@ -176,46 +176,46 @@ subroutine ncwrt_bgc(iogrp) ! --- get file name if (.not.append2file(iogrp)) then - call diafnm(GLB_FNAMETAG(iogrp), & - & filefq_bgc(iogrp)/real(nstep_in_day), & - & filemon_bgc(iogrp),fileann_bgc(iogrp),fname(iogrp)) - append2file(iogrp)=.true. - irec(iogrp)=1 + call diafnm(GLB_FNAMETAG(iogrp), & + & filefq_bgc(iogrp)/real(nstep_in_day), & + & filemon_bgc(iogrp),fileann_bgc(iogrp),fname(iogrp)) + append2file(iogrp)=.true. + irec(iogrp)=1 else - irec(iogrp)=irec(iogrp)+1 + irec(iogrp)=irec(iogrp)+1 endif if (((fileann_bgc(iogrp).and.nday_of_year.eq.1.or. & & filemon_bgc(iogrp).and.date%day.eq.1).and. & & mod(nstep,nstep_in_day).eq.0).or. & & .not.(fileann_bgc(iogrp).or.filemon_bgc(iogrp)).and. & & mod(nstep+.5,filefq_bgc(iogrp)).lt.1.) then - append2file(iogrp)=.false. + append2file(iogrp)=.false. endif ! --- prepare output fields if (mnproc.eq.1) then - write (lp,'(a,f6.2,a)') ' ncwrt_bgc: fields averaged over ', & - & real(nacc_bgc(iogrp)),' steps' - write(lp,*) 'irec(iogrp)',irec(iogrp) + write (lp,'(a,f6.2,a)') ' ncwrt_bgc: fields averaged over ', & + & real(nacc_bgc(iogrp)),' steps' + write(lp,*) 'irec(iogrp)',irec(iogrp) endif rnacc=1./real(nacc_bgc(iogrp)) cmpflg=GLB_COMPFLAG(iogrp) ! --- create output file if (GLB_NCFORMAT(iogrp).eq.1) then - call ncfopn(fname(iogrp),'w','6',irec(iogrp),iotype) + call ncfopn(fname(iogrp),'w','6',irec(iogrp),iotype) elseif (GLB_NCFORMAT(iogrp).eq.2) then - call ncfopn(fname(iogrp),'w','h',irec(iogrp),iotype) + call ncfopn(fname(iogrp),'w','h',irec(iogrp),iotype) else - call ncfopn(fname(iogrp),'w','c',irec(iogrp),iotype) + call ncfopn(fname(iogrp),'w','c',irec(iogrp),iotype) endif ! --- define spatial and time dimensions if (cmpflg.ne.0) then - call ncdimc('pcomp',ip,0) + call ncdimc('pcomp',ip,0) else - call ncdims('x',itdm) - call ncdims('y',jtdm) + call ncdims('x',itdm) + call ncdims('y',jtdm) endif call ncdims('sigma',kdm) call ncdims('depth',ddm) @@ -257,40 +257,40 @@ subroutine ncwrt_bgc(iogrp) call finlyr(jprefdic(iogrp),jdp(iogrp)) call finlyr(jdicsat(iogrp),jdp(iogrp)) 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)) + 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 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)) + 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 if (use_CFC) then - call finlyr(jcfc11(iogrp),jdp(iogrp)) - call finlyr(jcfc12(iogrp),jdp(iogrp)) - call finlyr(jsf6(iogrp),jdp(iogrp)) + call finlyr(jcfc11(iogrp),jdp(iogrp)) + call finlyr(jcfc12(iogrp),jdp(iogrp)) + call finlyr(jsf6(iogrp),jdp(iogrp)) endif 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)) + 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 if (use_BROMO) then - call finlyr(jbromo(iogrp),jdp(iogrp)) + call finlyr(jbromo(iogrp),jdp(iogrp)) endif ! --- Mask sea floor in mass fluxes @@ -337,40 +337,40 @@ subroutine ncwrt_bgc(iogrp) call msklvl(jlvlprefdic(iogrp),depths) call msklvl(jlvldicsat(iogrp),depths) 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) + 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 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) + 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 if (use_CFC) then - call msklvl(jlvlcfc11(iogrp),depths) - call msklvl(jlvlcfc12(iogrp),depths) - call msklvl(jlvlsf6(iogrp),depths) + call msklvl(jlvlcfc11(iogrp),depths) + call msklvl(jlvlcfc12(iogrp),depths) + call msklvl(jlvlsf6(iogrp),depths) endif 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) + 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 if (use_BROMO) then - call msklvl(jlvlbromo(iogrp),depths) + call msklvl(jlvlbromo(iogrp),depths) endif ! --- Compute log10 of pH @@ -378,9 +378,9 @@ subroutine ncwrt_bgc(iogrp) if (LYR_PH(iogrp).ne.0) call loglyr(jph(iogrp),1.,0.) if (LVL_PH(iogrp).ne.0) call loglvl(jlvlph(iogrp),rnacc,0.) 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.) + 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 ! --- Store 2d fields @@ -436,47 +436,47 @@ subroutine ncwrt_bgc(iogrp) 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') 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') + 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 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') + 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 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') + 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 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') + 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 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') + 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 call wrtsrf(jatmco2(iogrp), SRF_ATMCO2(iogrp), rnacc, 0.,cmpflg,'atmco2') 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') + call wrtsrf(jatmo2(iogrp), SRF_ATMO2(iogrp), rnacc, 0.,cmpflg,'atmo2') + call wrtsrf(jatmn2(iogrp), SRF_ATMN2(iogrp), rnacc, 0.,cmpflg,'atmn2') endif 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') + call wrtsrf(jatmc13(iogrp), SRF_ATMC13(iogrp), rnacc, 0.,cmpflg,'atmc13') + call wrtsrf(jatmc14(iogrp), SRF_ATMC14(iogrp), rnacc, 0.,cmpflg,'atmc14') endif ! --- Store 3d layer fields @@ -507,40 +507,40 @@ subroutine ncwrt_bgc(iogrp) call wrtlyr(jprefdic(iogrp), LYR_PREFDIC(iogrp), 1e3, 0.,cmpflg,'p_dic') call wrtlyr(jdicsat(iogrp), LYR_DICSAT(iogrp), 1e3, 0.,cmpflg,'sat_dic') 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') + 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 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') + 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 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') + 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 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') + 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 if (use_BROMO) then - call wrtlyr(jbromo(iogrp), LYR_BROMO(iogrp), 1e3, 0.,cmpflg,'bromo') + call wrtlyr(jbromo(iogrp), LYR_BROMO(iogrp), 1e3, 0.,cmpflg,'bromo') endif ! --- Store 3d level fields @@ -570,61 +570,61 @@ subroutine ncwrt_bgc(iogrp) 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') 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') + 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 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') + 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 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') + 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 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') + 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 if (use_BROMO) then - call wrtlvl(jlvlbromo(iogrp), LVL_BROMO(iogrp), rnacc*1e3, 0.,cmpflg,'bromolvl') + call wrtlvl(jlvlbromo(iogrp), LVL_BROMO(iogrp), rnacc*1e3, 0.,cmpflg,'bromolvl') endif ! --- Store sediment fields 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') + 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') + ! --- 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 ! --- close netcdf file @@ -683,49 +683,49 @@ subroutine ncwrt_bgc(iogrp) call inisrf(jcalflx4000(iogrp),0.) call inisrf(jcalflx_bot(iogrp),0.) 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.) + 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 if (use_cisonew) then - call inisrf(jco213fxd(iogrp),0.) - call inisrf(jco213fxu(iogrp),0.) - call inisrf(jco214fxd(iogrp),0.) - call inisrf(jco214fxu(iogrp),0.) + call inisrf(jco213fxd(iogrp),0.) + call inisrf(jco213fxu(iogrp),0.) + call inisrf(jco214fxd(iogrp),0.) + call inisrf(jco214fxu(iogrp),0.) endif if (use_CFC) then - call inisrf(jcfc11fx(iogrp),0.) - call inisrf(jcfc12fx(iogrp),0.) - call inisrf(jsf6fx(iogrp),0.) + call inisrf(jcfc11fx(iogrp),0.) + call inisrf(jcfc12fx(iogrp),0.) + call inisrf(jsf6fx(iogrp),0.) endif 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.) + 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 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.) + 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 call inisrf(jatmco2(iogrp),0.) if (use_BOXATM) then - call inisrf(jatmo2(iogrp),0.) - call inisrf(jatmn2(iogrp),0.) + call inisrf(jatmo2(iogrp),0.) + call inisrf(jatmn2(iogrp),0.) endif if (use_cisonew) then - call inisrf(jatmc13(iogrp),0.) - call inisrf(jatmc14(iogrp),0.) + call inisrf(jatmc13(iogrp),0.) + call inisrf(jatmc14(iogrp),0.) endif call inilyr(jdp(iogrp),0.) @@ -755,40 +755,40 @@ subroutine ncwrt_bgc(iogrp) call inilyr(jprefdic(iogrp),0.) call inilyr(jdicsat(iogrp),0.) 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.) + 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 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.) + 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 if (use_CFC) then - call inilyr(jcfc11(iogrp),0.) - call inilyr(jcfc12(iogrp),0.) - call inilyr(jsf6(iogrp),0.) + call inilyr(jcfc11(iogrp),0.) + call inilyr(jcfc12(iogrp),0.) + call inilyr(jsf6(iogrp),0.) endif 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.) + 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 if (use_BROMO) then - call inilyr(jbromo(iogrp),0.) + call inilyr(jbromo(iogrp),0.) endif call inilvl(jlvldic(iogrp),0.) @@ -817,59 +817,59 @@ subroutine ncwrt_bgc(iogrp) call inilvl(jlvlprefdic(iogrp),0.) call inilvl(jlvldicsat(iogrp),0.) 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.) + 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 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.) + 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 if (use_CFC) then - call inilvl(jlvlcfc11(iogrp),0.) - call inilvl(jlvlcfc12(iogrp),0.) - call inilvl(jlvlsf6(iogrp),0.) + call inilvl(jlvlcfc11(iogrp),0.) + call inilvl(jlvlcfc12(iogrp),0.) + call inilvl(jlvlsf6(iogrp),0.) endif 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.) + 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 if (use_BROMO) then - call inilvl(jlvlbromo(iogrp),0.) + call inilvl(jlvlbromo(iogrp),0.) endif 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 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.) + call inibur(jburssso12(iogrp),0.) + call inibur(jbursssc12(iogrp),0.) + call inibur(jburssssil(iogrp),0.) + call inibur(jburssster(iogrp),0.) endif nacc_bgc(iogrp)=0 @@ -1050,85 +1050,85 @@ subroutine hamoccvardef(iogrp,timeunits,calendar,cmpflg) call ncdefvar3d(SRF_N2OFX(iogrp),cmpflg,'p','n2oflux', & & 'N2O flux',' ','mol N2O m-2 s-1',0) 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) + 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 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) + 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 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) + 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 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) + 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 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) + 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 call ncdefvar3d(SRF_ATMCO2(iogrp),cmpflg,'p', & & 'atmco2','Atmospheric CO2',' ','ppm',0) 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) + 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 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) + 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 ! --- define 3d layer fields @@ -1185,66 +1185,66 @@ subroutine hamoccvardef(iogrp,timeunits,calendar,cmpflg) call ncdefvar3d(LYR_DICSAT(iogrp),cmpflg,'p', & & 'sat_dic','Saturated DIC',' ','mol C m-3',1) 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) + 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 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) + 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 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) + 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 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) + 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 if (use_BROMO) then - call ncdefvar3d(LYR_BROMO(iogrp),cmpflg,'p', & - & 'bromo','Bromoform',' ','mol CHBr3 m-3',1) + call ncdefvar3d(LYR_BROMO(iogrp),cmpflg,'p', & + & 'bromo','Bromoform',' ','mol CHBr3 m-3',1) endif ! --- define 3d level fields @@ -1299,102 +1299,102 @@ subroutine hamoccvardef(iogrp,timeunits,calendar,cmpflg) call ncdefvar3d(LVL_DICSAT(iogrp),cmpflg,'p', & & 'sat_diclvl','Saturated DIC',' ','mol C m-3',2) 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) + 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 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) + 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 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) + 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 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) + 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 if (use_BROMO) then - call ncdefvar3d(LVL_BROMO(iogrp),cmpflg,'p', & - & 'bromolvl','Bromoform',' ','mol CHBr3 m-3',2) + call ncdefvar3d(LVL_BROMO(iogrp),cmpflg,'p', & + & 'bromolvl','Bromoform',' ','mol CHBr3 m-3',2) endif ! --- define sediment fields 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) + 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) + ! --- 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 ! --- enddef netcdf file diff --git a/hamocc/netcdf_def_vardb.F90 b/hamocc/netcdf_def_vardb.F90 index 836661b5..13c50967 100644 --- a/hamocc/netcdf_def_vardb.F90 +++ b/hamocc/netcdf_def_vardb.F90 @@ -4,238 +4,238 @@ ! 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 NETCDF_DEF_VARDB & +SUBROUTINE NETCDF_DEF_VARDB & & (kcid,kshort,yshort,kdims,kcdims,kcvarid, & & kunitl,yunit,klong,ylong,pmissing,klabel,kunit) -! **************************************************************** -! -! **** *NETCDF_DEF_VAR* - define NetCDF variable. -! -! S.Legutke, *MPI-MaD, HH* 10.10.01 -! -! Modified -! -------- -! -! Purpose -! ------- -! Interface to NETCDF routines. -! -! Method -! ------- -! -! -!** Interface. -! ---------- -! -! *CALL* *NETCDF_DEF_VARDB(kcid,kshort,yshort,kdims,kcdims,kcvarid, -! kunitl,yunit,klong,ylong,pmissing,klabel,kunit)* -! -! -! ** Interface to calling routine (parameter list): -! ---------------------------------------------- -! -! *INTEGER* *kcid* - file ID. -! *INTEGER* *kshort* - length of short name. -! *INTEGER* *kdims* - number of dimensions. -! *INTEGER* *kcdims* - dimensions. -! *INTEGER* *kcvarid* - variable ID. -! *INTEGER* *kunitl* - length of unit string. -! *INTEGER* *klong* - length of long name. -! *INTEGER* *klabel* - label for abort identification. -! *INTEGER* *kunit* - stdout unit. -! *REAL* *pmissing* - missing value. -! *CHARACTER* *yshort* - short name. -! *CHARACTER* *yunit* - unit string. -! *CHARACTER* *ylong* - long name. -! -! -! Externals -! --------- -! none. -! -! ************************************************************************** - use netcdf, only: nf90_double,nf90_noerr,nf90_put_att,nf90_def_var - use mod_xc, only: mnproc,xchalt - use mod_dia, only:iotype - implicit none + ! **************************************************************** + ! + ! **** *NETCDF_DEF_VAR* - define NetCDF variable. + ! + ! S.Legutke, *MPI-MaD, HH* 10.10.01 + ! + ! Modified + ! -------- + ! + ! Purpose + ! ------- + ! Interface to NETCDF routines. + ! + ! Method + ! ------- + ! + ! + !** Interface. + ! ---------- + ! + ! *CALL* *NETCDF_DEF_VARDB(kcid,kshort,yshort,kdims,kcdims,kcvarid, + ! kunitl,yunit,klong,ylong,pmissing,klabel,kunit)* + ! + ! + ! ** Interface to calling routine (parameter list): + ! ---------------------------------------------- + ! + ! *INTEGER* *kcid* - file ID. + ! *INTEGER* *kshort* - length of short name. + ! *INTEGER* *kdims* - number of dimensions. + ! *INTEGER* *kcdims* - dimensions. + ! *INTEGER* *kcvarid* - variable ID. + ! *INTEGER* *kunitl* - length of unit string. + ! *INTEGER* *klong* - length of long name. + ! *INTEGER* *klabel* - label for abort identification. + ! *INTEGER* *kunit* - stdout unit. + ! *REAL* *pmissing* - missing value. + ! *CHARACTER* *yshort* - short name. + ! *CHARACTER* *yunit* - unit string. + ! *CHARACTER* *ylong* - long name. + ! + ! + ! Externals + ! --------- + ! none. + ! + ! ************************************************************************** + use netcdf, only: nf90_double,nf90_noerr,nf90_put_att,nf90_def_var + use mod_xc, only: mnproc,xchalt + use mod_dia, only:iotype + implicit none #ifdef PNETCDF #include -#include +#include #endif - - INTEGER ncstat - INTEGER kcid,kcvarid,kdims,kcdims(kdims) & - & ,kunitl,klong,kshort,klabel,kunit,k + INTEGER ncstat - REAL pmissing + INTEGER kcid,kcvarid,kdims,kcdims(kdims) & + & ,kunitl,klong,kshort,klabel,kunit,k - CHARACTER*(*) yshort, yunit, ylong + REAL pmissing - CHARACTER*24 ystring + CHARACTER*(*) yshort, yunit, ylong + + CHARACTER*24 ystring #ifdef PNETCDF - integer(kind=MPI_OFFSET_KIND) clen + integer(kind=MPI_OFFSET_KIND) clen #endif - ystring(1:21)='NETCDF stop at label ' - - -! -! Define variable -! - IF(mnproc==1 .AND. IOTYPE==0) THEN - ncstat = & - &NF90_DEF_VAR(kcid,yshort(1:kshort),NF90_DOUBLE,kcdims,kcvarid) - IF ( ncstat .NE. NF90_NOERR ) THEN - WRITE(kunit,*) 'Problems with definition of NetCDF variable:' - WRITE(kunit,*) 'kcid : ',kcid - WRITE(kunit,*) 'kshort : ',kshort - WRITE(kunit,*) 'yshort(kshort) : ',yshort(1:kshort),'---' - WRITE(kunit,*) 'kdims : ',kdims - WRITE(kunit,*) 'kcdims : ',(kcdims(k),k=1,kdims) - WRITE(kunit,*) 'kcvarid : ',kcvarid - WRITE(ystring(22:24),'(I3)') klabel - WRITE(kunit,*) ystring - CALL xchalt('(netcdf_def_vardb)') - stop '(netcdf_def_vardb)' - ENDIF -! -! Set unit -! - ncstat = & - &NF90_PUT_ATT(kcid,kcvarid,'units',yunit(1:kunitl)) - IF ( ncstat .NE. NF90_NOERR ) THEN - WRITE(kunit,*) 'Problems with definition of unit:' - WRITE(kunit,*) 'kcid : ',kcid - WRITE(kunit,*) 'kcvarid : ',kcvarid - WRITE(kunit,*) 'kunitl : ',kunitl - WRITE(kunit,*) 'yunit(kunitl) : ',yunit(1:kunitl),'---' - WRITE(ystring(22:24),'(I3)') klabel - WRITE(kunit,*) ystring - CALL xchalt('(netcdf_def_vardb)') - stop '(netcdf_def_vardb)' - ENDIF - -! -! Set long name -! - ncstat = & - &NF90_PUT_ATT(kcid,kcvarid,'long_name',ylong(1:klong)) - IF ( ncstat .NE. NF90_NOERR ) THEN - WRITE(kunit,*) 'Problems with definition of long name:' - WRITE(kunit,*) 'kcid : ',kcid - WRITE(kunit,*) 'kcvarid : ',kcvarid - WRITE(kunit,*) 'klong : ',klong - WRITE(kunit,*) 'ylong(klong) : ',ylong(1:klong),'---' - WRITE(ystring(22:24),'(I3)') klabel - WRITE(kunit,*) ystring - CALL xchalt('(netcdf_def_vardb)') - stop '(netcdf_def_vardb)' - ENDIF - -! -! Set missing value -! - - ncstat = NF90_PUT_ATT & - &(kcid,kcvarid,'missing_value',pmissing) - IF ( ncstat .NE. NF90_NOERR ) THEN - WRITE(kunit,*) 'Problems with definition of missing value:' - WRITE(kunit,*) 'kcid : ',kcid - WRITE(kunit,*) 'kcvarid : ',kcvarid - WRITE(kunit,*) 'pmissing : ',pmissing - WRITE(ystring(22:24),'(I3)') klabel - WRITE(kunit,*) ystring - CALL xchalt('(netcdf_def_vardb)') - stop '(netcdf_def_vardb)' - ENDIF - ELSE IF(IOTYPE==1) THEN + ystring(1:21)='NETCDF stop at label ' + + + ! + ! Define variable + ! + IF(mnproc==1 .AND. IOTYPE==0) THEN + ncstat = & + &NF90_DEF_VAR(kcid,yshort(1:kshort),NF90_DOUBLE,kcdims,kcvarid) + IF ( ncstat .NE. NF90_NOERR ) THEN + WRITE(kunit,*) 'Problems with definition of NetCDF variable:' + WRITE(kunit,*) 'kcid : ',kcid + WRITE(kunit,*) 'kshort : ',kshort + WRITE(kunit,*) 'yshort(kshort) : ',yshort(1:kshort),'---' + WRITE(kunit,*) 'kdims : ',kdims + WRITE(kunit,*) 'kcdims : ',(kcdims(k),k=1,kdims) + WRITE(kunit,*) 'kcvarid : ',kcvarid + WRITE(ystring(22:24),'(I3)') klabel + WRITE(kunit,*) ystring + CALL xchalt('(netcdf_def_vardb)') + stop '(netcdf_def_vardb)' + ENDIF + ! + ! Set unit + ! + ncstat = & + &NF90_PUT_ATT(kcid,kcvarid,'units',yunit(1:kunitl)) + IF ( ncstat .NE. NF90_NOERR ) THEN + WRITE(kunit,*) 'Problems with definition of unit:' + WRITE(kunit,*) 'kcid : ',kcid + WRITE(kunit,*) 'kcvarid : ',kcvarid + WRITE(kunit,*) 'kunitl : ',kunitl + WRITE(kunit,*) 'yunit(kunitl) : ',yunit(1:kunitl),'---' + WRITE(ystring(22:24),'(I3)') klabel + WRITE(kunit,*) ystring + CALL xchalt('(netcdf_def_vardb)') + stop '(netcdf_def_vardb)' + ENDIF + + ! + ! Set long name + ! + ncstat = & + &NF90_PUT_ATT(kcid,kcvarid,'long_name',ylong(1:klong)) + IF ( ncstat .NE. NF90_NOERR ) THEN + WRITE(kunit,*) 'Problems with definition of long name:' + WRITE(kunit,*) 'kcid : ',kcid + WRITE(kunit,*) 'kcvarid : ',kcvarid + WRITE(kunit,*) 'klong : ',klong + WRITE(kunit,*) 'ylong(klong) : ',ylong(1:klong),'---' + WRITE(ystring(22:24),'(I3)') klabel + WRITE(kunit,*) ystring + CALL xchalt('(netcdf_def_vardb)') + stop '(netcdf_def_vardb)' + ENDIF + + ! + ! Set missing value + ! + + ncstat = NF90_PUT_ATT & + &(kcid,kcvarid,'missing_value',pmissing) + IF ( ncstat .NE. NF90_NOERR ) THEN + WRITE(kunit,*) 'Problems with definition of missing value:' + WRITE(kunit,*) 'kcid : ',kcid + WRITE(kunit,*) 'kcvarid : ',kcvarid + WRITE(kunit,*) 'pmissing : ',pmissing + WRITE(ystring(22:24),'(I3)') klabel + WRITE(kunit,*) ystring + CALL xchalt('(netcdf_def_vardb)') + stop '(netcdf_def_vardb)' + ENDIF + ELSE IF(IOTYPE==1) THEN #ifdef PNETCDF -! -! Define variable -! - ncstat = nfmpi_def_var(kcid,yshort(1:kshort),nf_double,kdims, & - & kcdims,kcvarid) - - IF ( ncstat .NE. NF_NOERR ) THEN - WRITE(kunit,*) 'Problems with definition of NetCDF variable:' - WRITE(kunit,*) 'kcid : ',kcid - WRITE(kunit,*) 'kshort : ',kshort - WRITE(kunit,*) 'yshort(kshort) : ',yshort(1:kshort),'---' - WRITE(kunit,*) 'kdims : ',kdims - WRITE(kunit,*) 'kcdims : ',(kcdims(k),k=1,kdims) - WRITE(kunit,*) 'kcvarid : ',kcvarid - WRITE(ystring(22:24),'(I3)') klabel - WRITE(kunit,*) ystring - CALL xchalt('(pnetcdf_def_vardb)') - stop '(pnetcdf_def_vardb)' - ENDIF -! -! Set unit -! - clen=len(trim(yunit(1:kunitl))) - ncstat = & - &NFMPI_PUT_ATT_TEXT(kcid,kcvarid,'units',clen,yunit(1:kunitl)) - IF ( ncstat .NE. NF_NOERR ) THEN - WRITE(kunit,*) 'Problems with definition of unit:' - WRITE(kunit,*) 'kcid : ',kcid - WRITE(kunit,*) 'kcvarid : ',kcvarid - WRITE(kunit,*) 'kunitl : ',kunitl - WRITE(kunit,*) 'yunit(kunitl) : ',yunit(1:kunitl),'---' - WRITE(ystring(22:24),'(I3)') klabel - WRITE(kunit,*) ystring - CALL xchalt('(pnetcdf_def_vardb)') - stop '(pnetcdf_def_vardb)' - ENDIF - -! -! Set long name -! - clen=len(trim(ylong(1:klong))) - ncstat = & - &NFMPI_PUT_ATT_TEXT(kcid,kcvarid,'long_name',clen,ylong(1:klong)) - IF ( ncstat .NE. NF_NOERR ) THEN - WRITE(kunit,*) 'Problems with definition of long name:' - WRITE(kunit,*) 'kcid : ',kcid - WRITE(kunit,*) 'kcvarid : ',kcvarid - WRITE(kunit,*) 'klong : ',klong - WRITE(kunit,*) 'ylong(klong) : ',ylong(1:klong),'---' - WRITE(ystring(22:24),'(I3)') klabel - WRITE(kunit,*) ystring - CALL xchalt('(pnetcdf_def_vardb)') - stop '(pnetcdf_def_vardb)' - ENDIF - -! -! Set missing value -! - clen=1 - ncstat = NFMPI_PUT_ATT_DOUBLE & - &(kcid,kcvarid,'missing_value',NF_DOUBLE,clen,pmissing) - IF ( ncstat .NE. NF_NOERR ) THEN - WRITE(kunit,*) 'Problems with definition of missing value:' - WRITE(kunit,*) 'kcid : ',kcid - WRITE(kunit,*) 'kcvarid : ',kcvarid - WRITE(kunit,*) 'pmissing : ',pmissing - WRITE(ystring(22:24),'(I3)') klabel - WRITE(kunit,*) ystring - CALL xchalt('(pnetcdf_def_vardb)') - stop '(pnetcdf_def_vardb)' - ENDIF - -#endif - ENDIF - RETURN - END + ! + ! Define variable + ! + ncstat = nfmpi_def_var(kcid,yshort(1:kshort),nf_double,kdims, & + & kcdims,kcvarid) + + IF ( ncstat .NE. NF_NOERR ) THEN + WRITE(kunit,*) 'Problems with definition of NetCDF variable:' + WRITE(kunit,*) 'kcid : ',kcid + WRITE(kunit,*) 'kshort : ',kshort + WRITE(kunit,*) 'yshort(kshort) : ',yshort(1:kshort),'---' + WRITE(kunit,*) 'kdims : ',kdims + WRITE(kunit,*) 'kcdims : ',(kcdims(k),k=1,kdims) + WRITE(kunit,*) 'kcvarid : ',kcvarid + WRITE(ystring(22:24),'(I3)') klabel + WRITE(kunit,*) ystring + CALL xchalt('(pnetcdf_def_vardb)') + stop '(pnetcdf_def_vardb)' + ENDIF + ! + ! Set unit + ! + clen=len(trim(yunit(1:kunitl))) + ncstat = & + &NFMPI_PUT_ATT_TEXT(kcid,kcvarid,'units',clen,yunit(1:kunitl)) + IF ( ncstat .NE. NF_NOERR ) THEN + WRITE(kunit,*) 'Problems with definition of unit:' + WRITE(kunit,*) 'kcid : ',kcid + WRITE(kunit,*) 'kcvarid : ',kcvarid + WRITE(kunit,*) 'kunitl : ',kunitl + WRITE(kunit,*) 'yunit(kunitl) : ',yunit(1:kunitl),'---' + WRITE(ystring(22:24),'(I3)') klabel + WRITE(kunit,*) ystring + CALL xchalt('(pnetcdf_def_vardb)') + stop '(pnetcdf_def_vardb)' + ENDIF + + ! + ! Set long name + ! + clen=len(trim(ylong(1:klong))) + ncstat = & + &NFMPI_PUT_ATT_TEXT(kcid,kcvarid,'long_name',clen,ylong(1:klong)) + IF ( ncstat .NE. NF_NOERR ) THEN + WRITE(kunit,*) 'Problems with definition of long name:' + WRITE(kunit,*) 'kcid : ',kcid + WRITE(kunit,*) 'kcvarid : ',kcvarid + WRITE(kunit,*) 'klong : ',klong + WRITE(kunit,*) 'ylong(klong) : ',ylong(1:klong),'---' + WRITE(ystring(22:24),'(I3)') klabel + WRITE(kunit,*) ystring + CALL xchalt('(pnetcdf_def_vardb)') + stop '(pnetcdf_def_vardb)' + ENDIF + + ! + ! Set missing value + ! + clen=1 + ncstat = NFMPI_PUT_ATT_DOUBLE & + &(kcid,kcvarid,'missing_value',NF_DOUBLE,clen,pmissing) + IF ( ncstat .NE. NF_NOERR ) THEN + WRITE(kunit,*) 'Problems with definition of missing value:' + WRITE(kunit,*) 'kcid : ',kcid + WRITE(kunit,*) 'kcvarid : ',kcvarid + WRITE(kunit,*) 'pmissing : ',pmissing + WRITE(ystring(22:24),'(I3)') klabel + WRITE(kunit,*) ystring + CALL xchalt('(pnetcdf_def_vardb)') + stop '(pnetcdf_def_vardb)' + ENDIF + +#endif + ENDIF + RETURN +END SUBROUTINE NETCDF_DEF_VARDB diff --git a/hamocc/ocprod.F90 b/hamocc/ocprod.F90 index 81420df1..ec53af51 100644 --- a/hamocc/ocprod.F90 +++ b/hamocc/ocprod.F90 @@ -19,88 +19,88 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) -!****************************************************************************** -! -! OCPROD - biological production, remineralization and particle sinking. -! -! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 -! -! Modified -! -------- -! S.Legutke, *MPI-MaD, HH* 2010-04-01 -! -! J.Schwinger, *GFI, UiB* 2013-04-22 -! - Corrected bug in light penetration formulation -! - Cautious code clean-up -! -! J.Tjiputra, *UNI-RESEARCH* 2015-11-25 -! - Implemented natural DIC/ALK/CALC -! -! I.Kriest, *GEOMAR* 2016-08-11 -! - Modified stoichiometry for denitrification (affects NO3, N2, Alk) -! -! J.Schwinger, *UNI-RESEARCH* 2017-08-30 -! - Removed split of the layer that only partly falls into the -! euphotic zone. Loops are now calculated over -! (1) layers that are completely or partly in the euphotoc zone -! (2) layers that do not lie within the euphotic zone. -! - Moved the accumulation of global fields for output to routine -! hamocc4bgc. The accumulation of local fields has been moved to -! the end of this routine. -! -! A.Moree, *GFI, Bergen* 2018-04-12 -! - new version of carbon isotope code -! -! J.Schwinger, *Uni Research, Bergen* 2018-04-12 -! - moved accumulation of all output fields to seperate subroutine, -! related code-restructuring -! - added sediment bypass preprocessor option and related code -! -! J.Schwinger, *NORCE Climate, Bergen* 2020-05-29 -! - Cleaned up parameter list -! - Dust deposition field now passed as an argument -! -! Purpose -! ------- -! compute biological production, settling of debris, and related -! biogeochemistry -! -! -! -! Parameter list: -! --------------- -! *INTEGER* *kpie* - 1st dimension of model grid. -! *INTEGER* *kpje* - 2nd dimension of model grid. -! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. -! *INTEGER* *kbnd* - nb of halo grid points -! *REAL* *pdlxp* - size of scalar grid cell (1st dimension) [m]. -! *REAL* *pdlyp* - size of scalar grid cell (2nd dimension) [m]. -! *REAL* *pddpo* - size of scalar grid cell (3rd dimension) [m]. -! *REAL* *omask* - land/ocean mask (1=ocean) -! *REAL* *ptho* - potential temperature [deg C]. -! -!****************************************************************************** + !****************************************************************************** + ! + ! OCPROD - biological production, remineralization and particle sinking. + ! + ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 + ! + ! Modified + ! -------- + ! S.Legutke, *MPI-MaD, HH* 2010-04-01 + ! + ! J.Schwinger, *GFI, UiB* 2013-04-22 + ! - Corrected bug in light penetration formulation + ! - Cautious code clean-up + ! + ! J.Tjiputra, *UNI-RESEARCH* 2015-11-25 + ! - Implemented natural DIC/ALK/CALC + ! + ! I.Kriest, *GEOMAR* 2016-08-11 + ! - Modified stoichiometry for denitrification (affects NO3, N2, Alk) + ! + ! J.Schwinger, *UNI-RESEARCH* 2017-08-30 + ! - Removed split of the layer that only partly falls into the + ! euphotic zone. Loops are now calculated over + ! (1) layers that are completely or partly in the euphotoc zone + ! (2) layers that do not lie within the euphotic zone. + ! - Moved the accumulation of global fields for output to routine + ! hamocc4bgc. The accumulation of local fields has been moved to + ! the end of this routine. + ! + ! A.Moree, *GFI, Bergen* 2018-04-12 + ! - new version of carbon isotope code + ! + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - moved accumulation of all output fields to seperate subroutine, + ! related code-restructuring + ! - added sediment bypass preprocessor option and related code + ! + ! J.Schwinger, *NORCE Climate, Bergen* 2020-05-29 + ! - Cleaned up parameter list + ! - Dust deposition field now passed as an argument + ! + ! Purpose + ! ------- + ! compute biological production, settling of debris, and related + ! biogeochemistry + ! + ! + ! + ! Parameter list: + ! --------------- + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. + ! *INTEGER* *kbnd* - nb of halo grid points + ! *REAL* *pdlxp* - size of scalar grid cell (1st dimension) [m]. + ! *REAL* *pdlyp* - size of scalar grid cell (2nd dimension) [m]. + ! *REAL* *pddpo* - size of scalar grid cell (3rd dimension) [m]. + ! *REAL* *omask* - land/ocean mask (1=ocean) + ! *REAL* *ptho* - potential temperature [deg C]. + ! + !****************************************************************************** use mod_xc, only: mnproc use mo_carbch, only: ocetra,satoxy,hi,co2star use mo_sedmnt, only: prcaca,produs,prorca,silpro,pror13,pror14,prca13,prca14 use mo_param_bgc, only: drempoc,dremn2o,dremopal,dremsul,dyphy,ecan,epsher,fesoly,gammap,gammaz,grami,grazra,pi_alpha,phytomi, & - rcalc,rcar,rdn2o1,rdn2o2,rdnit0,rdnit1,rdnit2,relaxfe,remido,riron,rnit,rnoi,ro2ut,ropal, & - spemor,wcal,wdust,wopal,wpoc,zinges,alar1,alar2,alar3,alow1,alow2,alow3,calmax,cellmass, & - cellsink,dustd1,dustd2,dustd3,dustsink,fractdim,fse,fsh,nmldmin,plower,pupper,sinkexp,stick,tmfac, & - tsfac,vsmall,zdis,wmin,wmax,wlin,rbro,bifr13,bifr14,dmsp1,dmsp2,dmsp3,dmsp4,dmsp5,dmsp6,dms_gamma, & - fbro1,fbro2,atten_f,atten_c,atten_uv,atten_w,bkopal,bkphy,bkzoo + rcalc,rcar,rdn2o1,rdn2o2,rdnit0,rdnit1,rdnit2,relaxfe,remido,riron,rnit,rnoi,ro2ut,ropal, & + spemor,wcal,wdust,wopal,wpoc,zinges,alar1,alar2,alar3,alow1,alow2,alow3,calmax,cellmass, & + cellsink,dustd1,dustd2,dustd3,dustsink,fractdim,fse,fsh,nmldmin,plower,pupper,sinkexp,stick,tmfac, & + tsfac,vsmall,zdis,wmin,wmax,wlin,rbro,bifr13,bifr14,dmsp1,dmsp2,dmsp3,dmsp4,dmsp5,dmsp6,dms_gamma, & + fbro1,fbro2,atten_f,atten_c,atten_uv,atten_w,bkopal,bkphy,bkzoo use mo_biomod, only: bsiflx0100,bsiflx0500,bsiflx1000,bsiflx2000,bsiflx4000,bsiflx_bot, & - calflx0100,calflx0500,calflx1000,calflx2000,calflx4000,calflx_bot, & - carflx0100,carflx0500,carflx1000,carflx2000,carflx4000,carflx_bot, & - expoor,exposi,expoca,intdnit,intdms_bac,intdmsprod,intdms_uv,intphosy,int_chbr3_prod,int_chbr3_uv, & - phosy3d,abs_oce,strahl,asize3d,wmass,wnumb,eps3d,bifr13_perm,growth_co2 + calflx0100,calflx0500,calflx1000,calflx2000,calflx4000,calflx_bot, & + carflx0100,carflx0500,carflx1000,carflx2000,carflx4000,carflx_bot, & + expoor,exposi,expoca,intdnit,intdms_bac,intdmsprod,intdms_uv,intphosy,int_chbr3_prod,int_chbr3_uv, & + phosy3d,abs_oce,strahl,asize3d,wmass,wnumb,eps3d,bifr13_perm,growth_co2 use mo_param1_bgc, only: ialkali,ian2o,iano3,icalc,idet,idms,idoc,ifdust,igasnit,iiron,iopal,ioxygen,iphosph,iphy,isco212, & - isilica,izoo,iadust,inos,ibromo, & - icalc13,icalc14,idet13,idet14,idoc13,idoc14,iphy13,iphy14,isco213,isco214,izoo13,izoo14,safediv, & - inatalkali,inatcalc,inatsco212 + 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_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 mo_vgrid, only: kmle use mo_clim_swa, only: swa_clim @@ -170,7 +170,7 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) real :: bro_beta,bro_uv real :: abs_uv(kpie,kpje,kpke) -! set variables for diagnostic output to zero + ! set variables for diagnostic output to zero expoor (:,:) = 0. expoca (:,:) = 0. exposi (:,:) = 0. @@ -197,697 +197,697 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) phosy3d (:,:,:) = 0. if (use_BROMO) then - int_chbr3_uv (:,:) = 0. - int_chbr3_prod(:,:) = 0. + int_chbr3_uv (:,:) = 0. + int_chbr3_prod(:,:) = 0. end if if (use_AGG) then - eps3d(:,:,:) = 0. - asize3d(:,:,:) = 0. + eps3d(:,:,:) = 0. + asize3d(:,:,:) = 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) + 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 -! Calculate swr absorption by water and phytoplankton + ! Calculate swr absorption by water and phytoplankton abs_bgc(:,:,:) = 0. if (use_BROMO) then - abs_uv(:,:,:) = 0. + abs_uv(:,:,:) = 0. endif if (use_FB_BGC_OCE) then - abs_oce(:,:,:) = 0. - abs_oce(:,:,1) = 1. + abs_oce(:,:,:) = 0. + abs_oce(:,:,1) = 1. endif -!$OMP PARALLEL DO PRIVATE(i,k,absorption,absorption_uv,atten,dz) + !$OMP PARALLEL DO PRIVATE(i,k,absorption,absorption_uv,atten,dz) do j = 1,kpje - do i = 1,kpie + do i = 1,kpie - if(omask(i,j) > 0.5) then + if(omask(i,j) > 0.5) then absorption = 1. absorption_uv = 1. vloop: do k = 1,kwrbioz(i,j) - if(pddpo(i,j,k) > 0.0) then + if(pddpo(i,j,k) > 0.0) then - dz = pddpo(i,j,k) + dz = pddpo(i,j,k) - ! 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 - 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 + ! 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 + 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 - ! Radiation intensity I_0 at the top of next layer - absorption = absorption * exp(-atten*dz) - absorption_uv = absorption_uv * exp(-atten_uv*dz) + ! Radiation intensity I_0 at the top of next layer + absorption = absorption * exp(-atten*dz) + absorption_uv = absorption_uv * exp(-atten_uv*dz) - endif + endif enddo vloop - endif ! omask > 0.5 + endif ! omask > 0.5 + enddo enddo - enddo -!$OMP END PARALLEL DO - - -!$OMP PARALLEL DO PRIVATE(avphy,avgra,avsil,avanut,avanfe,pho,xa,xn & -!$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 & -!$OMP ,avmass,avnos,zmornos & -!$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 & -!$OMP ,bro_beta,bro_uv & -!$OMP ,i,k) + !$OMP END PARALLEL DO + + + !$OMP PARALLEL DO PRIVATE(avphy,avgra,avsil,avanut,avanfe,pho,xa,xn & + !$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 & + !$OMP ,avmass,avnos,zmornos & + !$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 & + !$OMP ,bro_beta,bro_uv & + !$OMP ,i,k) loop1: do j = 1,kpje - do i = 1,kpie - do k = 1,kwrbioz(i,j) - - if(pddpo(i,j,k) > dp_min .and. omask(i,j) > 0.5) then + do i = 1,kpie + do k = 1,kwrbioz(i,j) + if(pddpo(i,j,k) > dp_min .and. omask(i,j) > 0.5) then - 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))) - phofa = pi_alpha * strahl(i,j) * abs_bgc(i,j,k) - temfa = 0.6 * 1.066**temp -!taylor: temfa= 0.6*(1. + 0.0639*ptho(i,j,k) * & -! & (1. + 0.0639*ptho(i,j,k)/2. * (1. + 0.0639*ptho(i,j,k)/3.))) - pho = dtb * phofa * temfa / sqrt(phofa**2 + temfa**2) - - avphy = MAX(phytomi,ocetra(i,j,k,iphy)) ! 'available' phytoplankton - avgra = MAX(grami,ocetra(i,j,k,izoo)) ! 'available' zooplankton - avsil = MAX(0.,ocetra(i,j,k,isilica)) - avdic = MAX(0.,ocetra(i,j,k,isco212)) - avanut = MAX(0.,MIN(ocetra(i,j,k,iphosph), & - & rnoi*ocetra(i,j,k,iano3))) - avanfe = MAX(0.,MIN(avanut,ocetra(i,j,k,iiron)/riron)) - xa = avanfe - xn = xa/(1.+pho*avphy/(xa+bkphy)) - phosy = MAX(0.,xa-xn) - phosy = MERGE(avdic/rcar, phosy, avdic <= rcar*phosy) ! limit phosy by available DIC - ya = avphy+phosy - yn = (ya+grazra*avgra*phytomi/(avphy+bkzoo)) & - & /(1.+grazra*avgra/(avphy+bkzoo)) - grazing = MAX(0.,ya-yn) - graton = epsher*(1.-zinges)*grazing - gratpoc = (1.-epsher)*grazing - grawa = epsher*zinges*grazing - bacfra=remido*ocetra(i,j,k,idoc) - - phythresh = MAX(0.,(ocetra(i,j,k,iphy)-2.*phytomi)) - zoothresh = MAX(0.,(ocetra(i,j,k,izoo)-2.*grami)) - phymor = dyphy*phythresh - exud = gammap*phythresh - zoomor = spemor*zoothresh*zoothresh ! *10 compared to linear in tropics (tinka) - excdoc = gammaz*zoothresh ! excretion of doc by zooplankton - export = zoomor*(1.-ecan) + phymor + gratpoc ! ecan=.95, gratpoc= .2*grazing - if (use_cisonew) then - ! calculation of isotope fractionation during photosynthesis (Laws 1997) - if(ocetra(i,j,k,iphy) < phytomi) then + 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))) + phofa = pi_alpha * strahl(i,j) * abs_bgc(i,j,k) + temfa = 0.6 * 1.066**temp + !taylor: temfa= 0.6*(1. + 0.0639*ptho(i,j,k) * & + ! & (1. + 0.0639*ptho(i,j,k)/2. * (1. + 0.0639*ptho(i,j,k)/3.))) + pho = dtb * phofa * temfa / sqrt(phofa**2 + temfa**2) + + avphy = MAX(phytomi,ocetra(i,j,k,iphy)) ! 'available' phytoplankton + avgra = MAX(grami,ocetra(i,j,k,izoo)) ! 'available' zooplankton + avsil = MAX(0.,ocetra(i,j,k,isilica)) + avdic = MAX(0.,ocetra(i,j,k,isco212)) + avanut = MAX(0.,MIN(ocetra(i,j,k,iphosph), & + & rnoi*ocetra(i,j,k,iano3))) + avanfe = MAX(0.,MIN(avanut,ocetra(i,j,k,iiron)/riron)) + xa = avanfe + xn = xa/(1.+pho*avphy/(xa+bkphy)) + phosy = MAX(0.,xa-xn) + phosy = MERGE(avdic/rcar, phosy, avdic <= rcar*phosy) ! limit phosy by available DIC + ya = avphy+phosy + yn = (ya+grazra*avgra*phytomi/(avphy+bkzoo)) & + & /(1.+grazra*avgra/(avphy+bkzoo)) + grazing = MAX(0.,ya-yn) + graton = epsher*(1.-zinges)*grazing + gratpoc = (1.-epsher)*grazing + grawa = epsher*zinges*grazing + bacfra=remido*ocetra(i,j,k,idoc) + + phythresh = MAX(0.,(ocetra(i,j,k,iphy)-2.*phytomi)) + zoothresh = MAX(0.,(ocetra(i,j,k,izoo)-2.*grami)) + phymor = dyphy*phythresh + exud = gammap*phythresh + zoomor = spemor*zoothresh*zoothresh ! *10 compared to linear in tropics (tinka) + excdoc = gammaz*zoothresh ! excretion of doc by zooplankton + export = zoomor*(1.-ecan) + phymor + gratpoc ! ecan=.95, gratpoc= .2*grazing + + if (use_cisonew) then + ! calculation of isotope fractionation during photosynthesis (Laws 1997) + if(ocetra(i,j,k,iphy) < phytomi) then bifr13 = 1. - else + 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 + 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 - endif + export13 = zoomor13*(1.-ecan) + phymor13 + gratpoc13 + export14 = zoomor14*(1.-ecan) + phymor14 + gratpoc14 + 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 + 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) - endif - endif - - if(with_dmsph) then - dms_ph = 1. + (-log10(hi(i,j,1)) - pi_ph(i,j))*dms_gamma - else - dms_ph = 1. - endif - dmsprod = (dmsp5*delsil+dmsp4*delcar) & - & *(1.+1./(temp+dmsp1)**2)*dms_ph - dms_bac = dmsp3*abs(temp+3.)*ocetra(i,j,k,idms) & - & *(ocetra(i,j,k,idms)/(dmsp6+ocetra(i,j,k,idms))) - dms_uv = dmsp2*phofa/pi_alpha*ocetra(i,j,k,idms) - - dtr = bacfra-phosy+graton+ecan*zoomor - - ocetra(i,j,k,iphosph) = ocetra(i,j,k,iphosph)+dtr - ocetra(i,j,k,iano3) = ocetra(i,j,k,iano3)+dtr*rnit - ocetra(i,j,k,idet) = ocetra(i,j,k,idet)+export - ocetra(i,j,k,idms) = ocetra(i,j,k,idms)+dmsprod-dms_bac-dms_uv - ocetra(i,j,k,isco212) = ocetra(i,j,k,isco212)-delcar+rcar*dtr - ocetra(i,j,k,ialkali) = ocetra(i,j,k,ialkali)-2.*delcar-(rnit+1)*dtr - ocetra(i,j,k,ioxygen) = ocetra(i,j,k,ioxygen)-dtr*ro2ut - ocetra(i,j,k,iphy) = ocetra(i,j,k,iphy)+phosy-grazing-phymor-exud - 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 - 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 - endif - 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 - endif - 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.) - - 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 + endif + endif + + if(with_dmsph) then + dms_ph = 1. + (-log10(hi(i,j,1)) - pi_ph(i,j))*dms_gamma + else + dms_ph = 1. + endif + dmsprod = (dmsp5*delsil+dmsp4*delcar) & + & *(1.+1./(temp+dmsp1)**2)*dms_ph + dms_bac = dmsp3*abs(temp+3.)*ocetra(i,j,k,idms) & + & *(ocetra(i,j,k,idms)/(dmsp6+ocetra(i,j,k,idms))) + dms_uv = dmsp2*phofa/pi_alpha*ocetra(i,j,k,idms) + + dtr = bacfra-phosy+graton+ecan*zoomor + + ocetra(i,j,k,iphosph) = ocetra(i,j,k,iphosph)+dtr + ocetra(i,j,k,iano3) = ocetra(i,j,k,iano3)+dtr*rnit + ocetra(i,j,k,idet) = ocetra(i,j,k,idet)+export + ocetra(i,j,k,idms) = ocetra(i,j,k,idms)+dmsprod-dms_bac-dms_uv + ocetra(i,j,k,isco212) = ocetra(i,j,k,isco212)-delcar+rcar*dtr + ocetra(i,j,k,ialkali) = ocetra(i,j,k,ialkali)-2.*delcar-(rnit+1)*dtr + ocetra(i,j,k,ioxygen) = ocetra(i,j,k,ioxygen)-dtr*ro2ut + ocetra(i,j,k,iphy) = ocetra(i,j,k,iphy)+phosy-grazing-phymor-exud + 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 + 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 + endif + 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 + endif + 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.) + + 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 + else bro_uv = 0.0 - endif - ocetra(i,j,k,ibromo) = ocetra(i,j,k,ibromo)+bro_beta*phosy-bro_uv - endif - - 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) - !********************************************************************** - - if(avmass > 0.) then + endif + ocetra(i,j,k,ibromo) = ocetra(i,j,k,ibromo)+bro_beta*phosy-bro_uv + endif + + 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) + !********************************************************************** + + 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 - !*********************************************************************** - ! 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 - !*********************************************************************** + !*********************************************************************** + ! 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 - endif + zmornos = zoomor * (1.-ecan) * zdis * 1.e+6 + ocetra(i,j,k,inos) = ocetra(i,j,k,inos)+zmornos + endif - ! add up for total inventory and output - dz = pddpo(i,j,k) + ! add up for total inventory and output + dz = pddpo(i,j,k) - expoor(i,j) = expoor(i,j) +export*rcar*dz - expoca(i,j) = expoca(i,j) +delcar*dz - exposi(i,j) = exposi(i,j) +delsil*dz - 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 + expoor(i,j) = expoor(i,j) +export*rcar*dz + expoca(i,j) = expoca(i,j) +delcar*dz + exposi(i,j) = exposi(i,j) +delsil*dz + 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 - 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 - 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 + endif - 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 + 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 - endif ! pddpo(i,j,k) > dp_min - enddo ! kwrbioz - enddo ! kpie + endif ! pddpo(i,j,k) > dp_min + enddo ! kwrbioz + enddo ! kpie enddo loop1 ! kpje -!$OMP END PARALLEL DO + !$OMP END PARALLEL DO 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) + 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 -!$OMP PARALLEL DO PRIVATE(phythresh,zoothresh,sterph,sterzo,remin & -!$OMP ,opalrem,aou,refra,dms_bac,pocrem,docrem,phyrem,dz & -!$OMP ,avmass,avnos,zmornos & -!$OMP ,rphy13,rphy14,rzoo13,rzoo14,rdet13,rdet14,rdoc13,rdoc14 & -!$OMP ,sterph13,sterph14,sterzo13,sterzo14,pocrem13,pocrem14 & -!$OMP ,docrem13,docrem14,phyrem13,phyrem14 & -!$OMP ,i,k) + !$OMP PARALLEL DO PRIVATE(phythresh,zoothresh,sterph,sterzo,remin & + !$OMP ,opalrem,aou,refra,dms_bac,pocrem,docrem,phyrem,dz & + !$OMP ,avmass,avnos,zmornos & + !$OMP ,rphy13,rphy14,rzoo13,rzoo14,rdet13,rdet14,rdoc13,rdoc14 & + !$OMP ,sterph13,sterph14,sterzo13,sterzo14,pocrem13,pocrem14 & + !$OMP ,docrem13,docrem14,phyrem13,phyrem14 & + !$OMP ,i,k) loop2: do j = 1,kpje - do i = 1,kpie - do k = kwrbioz(i,j)+1,kpke - if(pddpo(i,j,k) > dp_min .and. omask(i,j) > 0.5) then - - 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 - 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 - 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 + do i = 1,kpie + do k = kwrbioz(i,j)+1,kpke + if(pddpo(i,j,k) > dp_min .and. omask(i,j) > 0.5) then - 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) - if (use_cisonew) then + 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 + 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 + 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) + 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. - if (use_cisonew) then + endif + else + pocrem = 0. + docrem = 0. + phyrem = 0. + 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 - ocetra(i,j,k,idoc) = ocetra(i,j,k,idoc) - docrem - ocetra(i,j,k,iphy) = ocetra(i,j,k,iphy) - phyrem - - remin = pocrem + docrem + phyrem - - ocetra(i,j,k,iphosph) = ocetra(i,j,k,iphosph)+remin - ocetra(i,j,k,iano3) = ocetra(i,j,k,iano3)+remin*rnit - ocetra(i,j,k,isco212) = ocetra(i,j,k,isco212)+rcar*remin - ocetra(i,j,k,ialkali) = ocetra(i,j,k,ialkali)-(rnit+1)*remin - 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.) - 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 -! so the expression dremopal*(Si(OH)4sat-Si(OH)4) would change the -! rate only from 0 to 100% -!*********************************************************************** - opalrem = dremopal*0.1*(temp+3.)*ocetra(i,j,k,iopal) - ocetra(i,j,k,iopal) = ocetra(i,j,k,iopal)-opalrem - ocetra(i,j,k,isilica) = ocetra(i,j,k,isilica)+opalrem - -!*********************************************************************** -! There is about 1.e4 O2 on 1 N2O molecule (Broeker&Peng) -! refra : Tim Rixton, private communication -!*********************************************************************** - aou = satoxy(i,j,k)-ocetra(i,j,k,ioxygen) - refra = 1.+3.*(0.5+sign(0.5,aou-1.97e-4)) - dms_bac = dmsp3 * abs(temp+3.) * ocetra(i,j,k,idms) & - & * (ocetra(i,j,k,idms) / (dmsp6+ocetra(i,j,k,idms))) - ocetra(i,j,k,ian2o) = ocetra(i,j,k,ian2o)+remin*1.e-4*ro2ut*refra - ocetra(i,j,k,igasnit) = ocetra(i,j,k,igasnit)-remin*1.e-4*ro2ut*refra - ocetra(i,j,k,ioxygen) = ocetra(i,j,k,ioxygen)-remin*1.e-4*ro2ut*refra*0.5 - ocetra(i,j,k,idms) = ocetra(i,j,k,idms)-dms_bac - - dz = pddpo(i,j,k) - intdms_bac(i,j) = intdms_bac(i,j)+dms_bac*dz - - 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 + endif + endif + + ocetra(i,j,k,idet) = ocetra(i,j,k,idet) - pocrem + sterph + sterzo + ocetra(i,j,k,idoc) = ocetra(i,j,k,idoc) - docrem + ocetra(i,j,k,iphy) = ocetra(i,j,k,iphy) - phyrem + + remin = pocrem + docrem + phyrem + + ocetra(i,j,k,iphosph) = ocetra(i,j,k,iphosph)+remin + ocetra(i,j,k,iano3) = ocetra(i,j,k,iano3)+remin*rnit + ocetra(i,j,k,isco212) = ocetra(i,j,k,isco212)+rcar*remin + ocetra(i,j,k,ialkali) = ocetra(i,j,k,ialkali)-(rnit+1)*remin + 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.) + 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 + ! so the expression dremopal*(Si(OH)4sat-Si(OH)4) would change the + ! rate only from 0 to 100% + !*********************************************************************** + opalrem = dremopal*0.1*(temp+3.)*ocetra(i,j,k,iopal) + ocetra(i,j,k,iopal) = ocetra(i,j,k,iopal)-opalrem + ocetra(i,j,k,isilica) = ocetra(i,j,k,isilica)+opalrem + + !*********************************************************************** + ! There is about 1.e4 O2 on 1 N2O molecule (Broeker&Peng) + ! refra : Tim Rixton, private communication + !*********************************************************************** + aou = satoxy(i,j,k)-ocetra(i,j,k,ioxygen) + refra = 1.+3.*(0.5+sign(0.5,aou-1.97e-4)) + dms_bac = dmsp3 * abs(temp+3.) * ocetra(i,j,k,idms) & + & * (ocetra(i,j,k,idms) / (dmsp6+ocetra(i,j,k,idms))) + ocetra(i,j,k,ian2o) = ocetra(i,j,k,ian2o)+remin*1.e-4*ro2ut*refra + ocetra(i,j,k,igasnit) = ocetra(i,j,k,igasnit)-remin*1.e-4*ro2ut*refra + ocetra(i,j,k,ioxygen) = ocetra(i,j,k,ioxygen)-remin*1.e-4*ro2ut*refra*0.5 + ocetra(i,j,k,idms) = ocetra(i,j,k,idms)-dms_bac + + dz = pddpo(i,j,k) + intdms_bac(i,j) = intdms_bac(i,j)+dms_bac*dz + + 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 - enddo + 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 + enddo enddo loop2 -!$OMP END PARALLEL DO + !$OMP END PARALLEL DO 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) + 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 -!$OMP PARALLEL DO PRIVATE(remin,remin2o,dz & -!$OMP ,avmass,avnos & -!$OMP ,rem13,rem14 & -!$OMP ,i,k) + !$OMP PARALLEL DO PRIVATE(remin,remin2o,dz & + !$OMP ,avmass,avnos & + !$OMP ,rem13,rem14 & + !$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 - if (use_AGG) then + 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 + if (use_AGG) then avmass = ocetra(i,j,k,iphy) + ocetra(i,j,k,idet) - endif + 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) + 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) - if (use_cisonew) then + 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) - ocetra(i,j,k,iphosph) = ocetra(i,j,k,iphosph)+(remin+remin2o) - ocetra(i,j,k,iano3) = ocetra(i,j,k,iano3)-rdnit1*remin - 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 - if (use_natDIC) then + 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) + ocetra(i,j,k,iphosph) = ocetra(i,j,k,iphosph)+(remin+remin2o) + ocetra(i,j,k,iano3) = ocetra(i,j,k,iano3)-rdnit1*remin + 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 + 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 + 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 + endif - ! nitrate loss through denitrification in kmol N m-2 - dz = pddpo(i,j,k) - intdnit(i,j) = intdnit(i,j) + rdnit0*remin*dz + ! nitrate loss through denitrification in kmol N m-2 + dz = pddpo(i,j,k) + intdnit(i,j) = intdnit(i,j) + rdnit0*remin*dz - if (use_AGG) then + 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 + avnos = ocetra(i,j,k,inos) + ocetra(i,j,k,inos) = ocetra(i,j,k,inos)-(remin+remin2o)*avnos/avmass endif - endif/*AGG*/ + endif/*AGG*/ + endif endif - endif - enddo - enddo + enddo + enddo enddo loop3 -!$OMP END PARALLEL DO + !$OMP END PARALLEL DO 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) + 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 -!sulphate reduction ! introduced 11.5.2007 to improve poc-remineralisation in the -! oxygen minimum zone in the subsurface equatorial Pacific -! assumption of endless pool of SO4 (typical concentration are on the order of mmol/l) -! js 02072007: for other runs than current millenium (cosmos-setup) experiments this seems -! to cause trouble as phosphate concentrations are too high at the depth of the oxygen -! minimum in the equatorial pacific/atlantic -! does it make sense to check for oxygen and nitrate deficit? + !sulphate reduction ! introduced 11.5.2007 to improve poc-remineralisation in the + ! oxygen minimum zone in the subsurface equatorial Pacific + ! assumption of endless pool of SO4 (typical concentration are on the order of mmol/l) + ! js 02072007: for other runs than current millenium (cosmos-setup) experiments this seems + ! to cause trouble as phosphate concentrations are too high at the depth of the oxygen + ! minimum in the equatorial pacific/atlantic + ! does it make sense to check for oxygen and nitrate deficit? -!$OMP PARALLEL DO PRIVATE(remin & -!$OMP ,avmass,avnos & -!$OMP ,rem13,rem14 & -!$OMP ,i,k) + !$OMP PARALLEL DO PRIVATE(remin & + !$OMP ,avmass,avnos & + !$OMP ,rem13,rem14 & + !$OMP ,i,k) loop4: do j = 1,kpje - do i = 1,kpie - do k = kwrbioz(i,j)+1,kpke - 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 + do i = 1,kpie + do k = kwrbioz(i,j)+1,kpke + 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 - if (use_AGG) then + if (use_AGG) then avmass = ocetra(i,j,k,iphy)+ocetra(i,j,k,idet) - endif - remin = dremsul*ocetra(i,j,k,idet) - if (use_cisonew) then + endif + remin = dremsul*ocetra(i,j,k,idet) + 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 - if (use_natDIC) then + 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 + 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 + 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 + endif - if (use_AGG) then + 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 + avnos = ocetra(i,j,k,inos) + ocetra(i,j,k,inos) = ocetra(i,j,k,inos)-remin*avnos/avmass endif - endif + endif + endif endif - endif - enddo - enddo + enddo + enddo enddo loop4 -!$OMP END PARALLEL DO -! end sulphate reduction + !$OMP END PARALLEL DO + ! end 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) + 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 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 + !**********************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)) + 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)) @@ -922,9 +922,9 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) ! As a first step, assume that shear in the mixed layer is high and ! zero below. if ( k <= kmle(i,j) ) then - fshear = fsh + fshear = fsh else - fshear = 0. + fshear = 0. endif @@ -963,12 +963,12 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) dsett = fse * dustd2 * ((e1+SinkExp*TopF*TSFac)/es1-dustsink/cellsink) dustagg(i,j,k) = effsti * avnos * ocetra(i,j,k,ifdust) & - & * (dshagg+dsett) + & * (dshagg+dsett) eps3d(i,j,k) = eps asize3d(i,j,k) = snow / avnos / cellmass - else + else wmass(i,j,k) = cellsink wnumb(i,j,k) = 0. @@ -979,185 +979,185 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) eps3d(i,j,k) = 1. asize3d(i,j,k) = 0. - endif ! avmass > 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 ! pddpo > dp_min .and. omask > 0.5 + enddo ! i=1,kpie + enddo ! j=1,kpje + enddo ! k=1,kpke endif ! use_AGG -! -! implicit method for sinking of particles: -! C(k,T+dt)=C(k,T) + (w*dt/ddpo(k))*(C(k-1,T+1)-C(k,T+1)) -! --> -! C(k,T+dt)=(ddpo(k)*C(k,T)+w*dt*C(k-1,T+dt))/(ddpo(k)+w*dt) -! sedimentation=w*dt*C(ks,T+dt) -! -!$OMP PARALLEL DO PRIVATE(kdonor,wpoc,wpocd,wcal,wcald,wopal,wopald & -!$OMP ,wnos,wnosd,dagg & -!$OMP ,i,k) + ! + ! implicit method for sinking of particles: + ! C(k,T+dt)=C(k,T) + (w*dt/ddpo(k))*(C(k-1,T+1)-C(k,T+1)) + ! --> + ! C(k,T+dt)=(ddpo(k)*C(k,T)+w*dt*C(k-1,T+dt))/(ddpo(k)+w*dt) + ! sedimentation=w*dt*C(ks,T+dt) + ! + !$OMP PARALLEL DO PRIVATE(kdonor,wpoc,wpocd,wcal,wcald,wopal,wopald & + !$OMP ,wnos,wnosd,dagg & + !$OMP ,i,k) do j = 1,kpje - do i = 1,kpie + do i = 1,kpie - tco(:) = 0.0 - tcn(:) = 0.0 + tco(:) = 0.0 + tcn(:) = 0.0 - if(omask(i,j) > 0.5) then + if(omask(i,j) > 0.5) then kdonor = 1 do k = 1,kpke - ! Sum up total column inventory before sinking scheme - 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) - 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) + ! Sum up total column inventory before sinking scheme + 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) + 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 (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 (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 + endif + + if( k == 1 ) then + wpocd = 0.0 + wcald = 0.0 + wopald = 0.0 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 (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) + wnosd = 0.0 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 + wpoc = wmin endif - - if( k == 1 ) then - wpocd = 0.0 - wcald = 0.0 - wopald = 0.0 - if (use_AGG) then - wnosd = 0.0 - else if (use_WLIN) then - wpoc = wmin - endif - 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 - ocetra(i,j,k,idet) = (ocetra(i,j,k ,idet)*pddpo(i,j,k) & - + ocetra(i,j,kdonor,idet)*wpocd)/ & - (pddpo(i,j,k)+wpoc) - 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) - 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 - 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) - 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) - 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 - - ! Sum up total column inventory after sinking scheme - ! flux to sediment added after kpke-loop - 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) - 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 (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 + 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 + ocetra(i,j,k,idet) = (ocetra(i,j,k ,idet)*pddpo(i,j,k) & + + ocetra(i,j,kdonor,idet)*wpocd)/ & + (pddpo(i,j,k)+wpoc) + 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) + 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 + 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) + 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) + 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 + + ! Sum up total column inventory after sinking scheme + ! flux to sediment added after kpke-loop + 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) + 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 (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 @@ -1166,196 +1166,196 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) tcn( 1) = tcn( 1) + ocetra(i,j,kdonor,idet )*wpoc tcn( 2) = tcn( 2) + ocetra(i,j,kdonor,icalc )*wcal if (use_natDIC) then - tcn( 3) = tcn( 3) + ocetra(i,j,kdonor,inatcalc)*wcal + 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 (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 + 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 + 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 do is = 1,nsinkmax - if( tco(is) > 1.e-12 .and. tcn(is) > 1.e-12 ) q(is) = tco(is)/tcn(is) + if( tco(is) > 1.e-12 .and. tcn(is) > 1.e-12 ) q(is) = tco(is)/tcn(is) enddo do k = 1,kpke - 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) - 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 (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 + 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) + 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 (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. + ! 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 (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 - endif + 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 + 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 - 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 + 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 endif - endif ! omask > 0.5 - enddo ! loop i=1,kpie + endif ! omask > 0.5 + enddo ! loop i=1,kpie enddo ! loop j=1,kpje -!$OMP END PARALLEL DO + !$OMP END PARALLEL DO -! Calculate mass sinking flux for carbon, opal and calcium carbonate -! through the 100 m, 500 m, 1000 m, 2000 m, and 4000 m depth surfaces. These -! fluxes are intentionally calculated using values at the NEW timelevel -! to be fully consistent with the implicit sinking scheme + ! Calculate mass sinking flux for carbon, opal and calcium carbonate + ! through the 100 m, 500 m, 1000 m, 2000 m, and 4000 m depth surfaces. These + ! fluxes are intentionally calculated using values at the NEW timelevel + ! to be fully consistent with the implicit sinking scheme -!$OMP PARALLEL DO PRIVATE(i,k,wpoc,wcal,wopal) + !$OMP PARALLEL DO PRIVATE(i,k,wpoc,wcal,wopal) do j = 1,kpje - do i = 1,kpie - if(omask(i,j) > 0.5) then + do i = 1,kpie + if(omask(i,j) > 0.5) then ! 100 m k = k0100(i,j) if(k > 0) then - 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) - endif - - 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 - endif - bsiflx0100(i,j) = ocetra(i,j,k,iopal)*wopal - calflx0100(i,j) = ocetra(i,j,k,icalc)*wcal + 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) + endif + + 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 + endif + bsiflx0100(i,j) = ocetra(i,j,k,iopal)*wopal + calflx0100(i,j) = ocetra(i,j,k,icalc)*wcal endif ! 500 m k = k0500(i,j) if(k > 0) then - 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) - endif - - 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 - endif - bsiflx0500(i,j) = ocetra(i,j,k,iopal)*wopal - calflx0500(i,j) = ocetra(i,j,k,icalc)*wcal + 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) + endif + + 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 + endif + bsiflx0500(i,j) = ocetra(i,j,k,iopal)*wopal + calflx0500(i,j) = ocetra(i,j,k,icalc)*wcal endif ! 1000 m k = k1000(i,j) if(k > 0) then - 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) - endif - - 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 - endif - bsiflx1000(i,j) = ocetra(i,j,k,iopal)*wopal - calflx1000(i,j) = ocetra(i,j,k,icalc)*wcal + 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) + endif + + 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 + endif + bsiflx1000(i,j) = ocetra(i,j,k,iopal)*wopal + calflx1000(i,j) = ocetra(i,j,k,icalc)*wcal endif ! 2000 m k = k2000(i,j) if(k > 0) then - 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) - endif - - 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 - endif - bsiflx2000(i,j) = ocetra(i,j,k,iopal)*wopal - calflx2000(i,j) = ocetra(i,j,k,icalc)*wcal + 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) + endif + + 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 + endif + bsiflx2000(i,j) = ocetra(i,j,k,iopal)*wopal + calflx2000(i,j) = ocetra(i,j,k,icalc)*wcal endif ! 4000 m k = k4000(i,j) if(k > 0) then - 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) - endif - - 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 - endif - bsiflx4000(i,j) = ocetra(i,j,k,iopal)*wopal - calflx4000(i,j) = ocetra(i,j,k,icalc)*wcal + 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) + endif + + 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 + endif + bsiflx4000(i,j) = ocetra(i,j,k,iopal)*wopal + calflx4000(i,j) = ocetra(i,j,k,icalc)*wcal endif ! bottom fluxes @@ -1363,77 +1363,77 @@ subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) bsiflx_bot(i,j) = silpro(i,j) calflx_bot(i,j) = prcaca(i,j) - endif ! omask > 0.5 + endif ! omask > 0.5 + enddo enddo - enddo -!$OMP END PARALLEL DO + !$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 + ! 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 + !$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 - - 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 + ! 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 + + 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 - + enddo + enddo + endif ! use_sedbypass 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) + 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 end subroutine ocprod diff --git a/hamocc/powach.F90 b/hamocc/powach.F90 index cb3c63bf..3e9cc2f5 100644 --- a/hamocc/powach.F90 +++ b/hamocc/powach.F90 @@ -4,64 +4,64 @@ ! 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 powach(kpie,kpje,kpke,kbnd,prho,omask,psao,lspin) -!****************************************************************************** -! -!**** *POWACH* - . -! -! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 -! -! Modified -! -------- -! S.Legutke, *MPI-MaD, HH* 10.04.01 -! -! Purpose -! ------- -! . -! -! Method -! ------- -! . -! -!** Interface. -! ---------- -! -! *CALL* *POWACH* -! -! *COMMON* *PARAM1_BGC.h* - declaration of ocean/sediment tracer. -! -!** Interface to ocean model (parameter list): -! ----------------------------------------- -! -! *INTEGER* *kpie* - 1st dimension of model grid. -! *INTEGER* *kpje* - 2nd dimension of model grid. -! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. -! *INTEGER* *kbnd* - nb of halo grid points -! *REAL* *prho* - seawater density [g/cm^3]. -! *REAL* *psao* - salinity [psu]. -! *REAL* *omask* - land/ocean mask -! -! Externals -! --------- -! none. -! -!****************************************************************************** + !****************************************************************************** + ! + !**** *POWACH* - . + ! + ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 + ! + ! Modified + ! -------- + ! S.Legutke, *MPI-MaD, HH* 10.04.01 + ! + ! Purpose + ! ------- + ! . + ! + ! Method + ! ------- + ! . + ! + !** Interface. + ! ---------- + ! + ! *CALL* *POWACH* + ! + ! *COMMON* *PARAM1_BGC.h* - declaration of ocean/sediment tracer. + ! + !** Interface to ocean model (parameter list): + ! ----------------------------------------- + ! + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. + ! *INTEGER* *kbnd* - nb of halo grid points + ! *REAL* *prho* - seawater density [g/cm^3]. + ! *REAL* *psao* - salinity [psu]. + ! *REAL* *omask* - land/ocean mask + ! + ! Externals + ! --------- + ! none. + ! + !****************************************************************************** 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,ipowc13,ipowc14,isssc13,isssc14,issso13,issso14,safediv + issster,ks,ipowc13,ipowc14,isssc13,isssc14,issso13,issso14,safediv use mo_carbch, only: co3,keqb,ocetra,sedfluxo use mo_chemcon, only: calcon use mo_param_bgc, only: rnit,ro2ut,disso_sil,silsat,disso_poc,sed_denit,disso_caco3 @@ -90,461 +90,461 @@ subroutine powach(kpie,kpje,kpke,kbnd,prho,omask,psao,lspin) real :: ratc13, ratc14, rato13, rato14, poso13, poso14 integer, parameter :: niter = 5 ! number of iterations for carchm_solve -!****************************************************************************** + !****************************************************************************** -! Set array for saving diffusive sediment-water-column fluxes to zero + ! Set array for saving diffusive sediment-water-column fluxes to zero sedfluxo(:,:,:) = 0.0 -! A LOOP OVER J -! RJ: This loop must go from 1 to kpje in the parallel version, -! otherways we had to do a boundary exchange + ! A LOOP OVER J + ! RJ: This loop must go from 1 to kpje in the parallel version, + ! otherways we had to do a boundary exchange -!$OMP PARALLEL DO & -!$OMP&PRIVATE(sedb1,sediso,solrat,powcar,aerob,anaerob, & -!$OMP& dissot,undsa,posol, & -!$OMP& umfa,denit,saln,rrho,alk,c,sit,pt, & -!$OMP& K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p, & -!$OMP& ah1,ac,cu,cb,cc,satlev, & -!$OMP& ratc13,ratc14,rato13,rato14,poso13,poso14, & -!$OMP& k,i) + !$OMP PARALLEL DO & + !$OMP&PRIVATE(sedb1,sediso,solrat,powcar,aerob,anaerob, & + !$OMP& dissot,undsa,posol, & + !$OMP& umfa,denit,saln,rrho,alk,c,sit,pt, & + !$OMP& K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p, & + !$OMP& ah1,ac,cu,cb,cc,satlev, & + !$OMP& ratc13,ratc14,rato13,rato14,poso13,poso14, & + !$OMP& k,i) j_loop: do j = 1, kpje - do k = 1, ks - do i = 1, kpie + do k = 1, ks + do i = 1, kpie solrat(i,k) = 0. powcar(i,k) = 0. anaerob(i,k)= 0. aerob(i,k) = 0. if (use_cisonew) then - anaerob13(i,k)=0. - aerob13(i,k) =0. - anaerob14(i,k)=0. - aerob14(i,k) =0. + anaerob13(i,k)=0. + aerob13(i,k) =0. + anaerob14(i,k)=0. + aerob14(i,k) =0. endif - enddo - enddo + enddo + enddo - do k = 0, ks - do i = 1, kpie + do k = 0, ks + do i = 1, kpie sedb1(i,k) = 0. sediso(i,k) = 0. - enddo - enddo + enddo + enddo -! Calculate silicate-opal cycle and simultaneous silicate diffusion -!****************************************************************** + ! Calculate silicate-opal cycle and simultaneous silicate diffusion + !****************************************************************** -! Dissolution rate constant of opal (disso) [1/(kmol Si(OH)4/m3)*1/sec]*dtbgc - dissot=disso_sil + ! Dissolution rate constant of opal (disso) [1/(kmol Si(OH)4/m3)*1/sec]*dtbgc + dissot=disso_sil -! Evaluate boundary conditions for sediment-water column exchange. -! Current undersaturation of bottom water: sedb(i,0) and -! Approximation for new solid sediment, as from sedimentation flux: solrat(i,1) + ! Evaluate boundary conditions for sediment-water column exchange. + ! Current undersaturation of bottom water: sedb(i,0) and + ! Approximation for new solid sediment, as from sedimentation flux: solrat(i,1) - do i = 1, kpie - if(omask(i,j) > 0.5) then + do i = 1, kpie + if(omask(i,j) > 0.5) then undsa = silsat - powtra(i,j,1,ipowasi) sedb1(i,0) = bolay(i,j) * (silsat - ocetra(i,j,kbo(i,j),isilica)) solrat(i,1) = ( sedlay(i,j,1,issssil) & & + silpro(i,j) / (porsol(i,j,1) * seddw(1)) ) & & * dissot / (1. + dissot * undsa) * porsol(i,j,1) / porwat(i,j,1) - endif - enddo + endif + enddo -! Evaluate sediment undersaturation and degradation. -! Current undersaturation in pore water: sedb(i,k) and -! Approximation for new solid sediment, as from degradation: solrat(i,k) + ! Evaluate sediment undersaturation and degradation. + ! Current undersaturation in pore water: sedb(i,k) and + ! Approximation for new solid sediment, as from degradation: solrat(i,k) - do k = 1, ks - do i = 1, kpie + do k = 1, ks + do i = 1, kpie if(omask(i,j) > 0.5) then - undsa = silsat - powtra(i,j,k,ipowasi) - sedb1(i,k) = seddw(k) * porwat(i,j,k) * (silsat - powtra(i,j,k,ipowasi)) - if ( k > 1 ) solrat(i,k) = sedlay(i,j,k,issssil) & - & * dissot / (1. + dissot * undsa) * porsol(i,j,k) / porwat(i,j,k) + undsa = silsat - powtra(i,j,k,ipowasi) + sedb1(i,k) = seddw(k) * porwat(i,j,k) * (silsat - powtra(i,j,k,ipowasi)) + if ( k > 1 ) solrat(i,k) = sedlay(i,j,k,issssil) & + & * dissot / (1. + dissot * undsa) * porsol(i,j,k) / porwat(i,j,k) endif - enddo - enddo + enddo + enddo -! Solve for new undersaturation sediso, from current undersaturation sedb1, -! and first guess of new solid sediment solrat. + ! Solve for new undersaturation sediso, from current undersaturation sedb1, + ! and first guess of new solid sediment solrat. - call powadi(j,kpie,kpje,solrat,sedb1,sediso,omask) + call powadi(j,kpie,kpje,solrat,sedb1,sediso,omask) -! Update water column silicate, and store the flux for budget. -! Add sedimentation to first layer. + ! Update water column silicate, and store the flux for budget. + ! Add sedimentation to first layer. - do i = 1, kpie - if(omask(i,j) > 0.5) then + do i = 1, kpie + if(omask(i,j) > 0.5) then if(.not. lspin) then - sedfluxo(i,j,ipowasi) = & - & -(silsat - sediso(i,0) - ocetra(i,j,kbo(i,j),isilica)) & - & * bolay(i,j) - ocetra(i,j,kbo(i,j),isilica) = silsat - sediso(i,0) + sedfluxo(i,j,ipowasi) = & + & -(silsat - sediso(i,0) - ocetra(i,j,kbo(i,j),isilica)) & + & * bolay(i,j) + ocetra(i,j,kbo(i,j),isilica) = silsat - sediso(i,0) endif sedlay(i,j,1,issssil) = & & sedlay(i,j,1,issssil) + silpro(i,j) / (porsol(i,j,1) * seddw(1)) - endif - enddo + endif + enddo -! Calculate updated degradation rate from updated undersaturation. -! Calculate new solid sediment. -! Update pore water concentration from new undersaturation. + ! Calculate updated degradation rate from updated undersaturation. + ! Calculate new solid sediment. + ! Update pore water concentration from new undersaturation. - do k = 1, ks - do i = 1, kpie + do k = 1, ks + do i = 1, kpie if(omask(i,j) > 0.5) then - umfa = porsol(i,j,k)/porwat(i,j,k) - solrat(i,k) = sedlay(i,j,k,issssil) * dissot & - & / (1. + dissot * sediso(i,k)) - posol = sediso(i,k) * solrat(i,k) - sedlay(i,j,k,issssil) = sedlay(i,j,k,issssil) - posol - powtra(i,j,k,ipowasi) = silsat - sediso(i,k) + umfa = porsol(i,j,k)/porwat(i,j,k) + solrat(i,k) = sedlay(i,j,k,issssil) * dissot & + & / (1. + dissot * sediso(i,k)) + posol = sediso(i,k) * solrat(i,k) + sedlay(i,j,k,issssil) = sedlay(i,j,k,issssil) - posol + powtra(i,j,k,ipowasi) = silsat - sediso(i,k) endif - enddo - enddo + enddo + enddo -! Calculate oxygen-POC cycle and simultaneous oxygen diffusion -!************************************************************* + ! Calculate oxygen-POC cycle and simultaneous oxygen diffusion + !************************************************************* -! Degradation rate constant of POP (disso) [1/(kmol O2/m3)*1/sec]*dtbgc - dissot = disso_poc + ! Degradation rate constant of POP (disso) [1/(kmol O2/m3)*1/sec]*dtbgc + dissot = disso_poc -! This scheme is not based on undersaturation, but on O2 itself + ! This scheme is not based on undersaturation, but on O2 itself -! Evaluate boundary conditions for sediment-water column exchange. -! Current concentration of bottom water: sedb(i,0) and -! Approximation for new solid sediment, as from sedimentation flux: solrat(i,1) + ! Evaluate boundary conditions for sediment-water column exchange. + ! Current concentration of bottom water: sedb(i,0) and + ! Approximation for new solid sediment, as from sedimentation flux: solrat(i,1) - do i = 1, kpie - if(omask(i,j) > 0.5) then + do i = 1, kpie + if(omask(i,j) > 0.5) then undsa = powtra(i,j,1,ipowaox) sedb1(i,0) = bolay(i,j) * ocetra(i,j,kbo(i,j),ioxygen) solrat(i,1) = ( sedlay(i,j,1,issso12) + prorca(i,j) & & / (porsol(i,j,1) * seddw(1)) ) & & * ro2ut * dissot / (1. + dissot * undsa) & & * porsol(i,j,1) / porwat(i,j,1) - endif - enddo + endif + enddo -! Evaluate sediment concentration and degradation. -! Current concentration in pore water: sedb(i,k) and -! Approximation for new solid sediment, as from degradation: solrat(i,k) + ! Evaluate sediment concentration and degradation. + ! Current concentration in pore water: sedb(i,k) and + ! Approximation for new solid sediment, as from degradation: solrat(i,k) - do k = 1, ks - do i = 1, kpie + do k = 1, ks + do i = 1, kpie if(omask(i,j) > 0.5) then - undsa = powtra(i,j,k,ipowaox) - sedb1(i,k) = seddw(k) * porwat(i,j,k) * powtra(i,j,k,ipowaox) - if (k > 1) solrat(i,k) = sedlay(i,j,k,issso12) * ro2ut * dissot & - & / (1. + dissot*undsa) * porsol(i,j,k) / porwat(i,j,k) + undsa = powtra(i,j,k,ipowaox) + sedb1(i,k) = seddw(k) * porwat(i,j,k) * powtra(i,j,k,ipowaox) + if (k > 1) solrat(i,k) = sedlay(i,j,k,issso12) * ro2ut * dissot & + & / (1. + dissot*undsa) * porsol(i,j,k) / porwat(i,j,k) endif - enddo - enddo + enddo + enddo -! Solve for new O2 concentration sediso, from current concentration sedb1, -! and first guess of new solid sediment solrat. + ! Solve for new O2 concentration sediso, from current concentration sedb1, + ! and first guess of new solid sediment solrat. - call powadi(j,kpie,kpje,solrat,sedb1,sediso,omask) + call powadi(j,kpie,kpje,solrat,sedb1,sediso,omask) -! Update water column oxygen, and store the diffusive flux for budget (sedfluxo, -! positive downward). Add sedimentation to first layer. + ! Update water column oxygen, and store the diffusive flux for budget (sedfluxo, + ! positive downward). Add sedimentation to first layer. - do i = 1, kpie - if(omask(i,j) > 0.5) then + do i = 1, kpie + if(omask(i,j) > 0.5) then if(.not. lspin) then - sedfluxo(i,j,ipowaox) = & - & -(sediso(i,0) - ocetra(i,j,kbo(i,j),ioxygen)) & - & * bolay(i,j) - ocetra(i,j,kbo(i,j),ioxygen) = sediso(i,0) + sedfluxo(i,j,ipowaox) = & + & -(sediso(i,0) - ocetra(i,j,kbo(i,j),ioxygen)) & + & * bolay(i,j) + ocetra(i,j,kbo(i,j),ioxygen) = sediso(i,0) endif sedlay(i,j,1,issso12) = & & sedlay(i,j,1,issso12) + prorca(i,j) / (porsol(i,j,1)*seddw(1)) 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)) + 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 - endif - enddo + endif + enddo -! Calculate updated degradation rate from updated concentration. -! Calculate new solid sediment. -! Update pore water concentration. -! Store flux in array aerob, for later computation of DIC and alkalinity. - do k = 1, ks - do i = 1, kpie + ! Calculate updated degradation rate from updated concentration. + ! Calculate new solid sediment. + ! Update pore water concentration. + ! Store flux in array aerob, for later computation of DIC and alkalinity. + do k = 1, ks + do i = 1, kpie if(omask(i,j) > 0.5) then - umfa = porsol(i,j,k) / porwat(i,j,k) - 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 - 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 - endif - 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) - 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 - endif + umfa = porsol(i,j,k) / porwat(i,j,k) + 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 + 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 + endif + 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) + 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 + endif endif - enddo - enddo + enddo + enddo -! Calculate nitrate reduction under anaerobic conditions explicitely -!******************************************************************* + ! Calculate nitrate reduction under anaerobic conditions explicitely + !******************************************************************* - ! Denitrification rate constant of POP (disso) [1/sec]*dtbgc - denit = sed_denit - do k = 1, ks - do i = 1, kpie + ! Denitrification rate constant of POP (disso) [1/sec]*dtbgc + denit = sed_denit + do k = 1, ks + do i = 1, kpie if(omask(i,j) > 0.5) then - if(powtra(i,j,k,ipowaox) < 1.e-6) then - posol = denit * MIN(0.5*powtra(i,j,k,ipowno3)/114., & - & 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 - 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 - endif - 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 - 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 - endif - endif + if(powtra(i,j,k,ipowaox) < 1.e-6) then + posol = denit * MIN(0.5*powtra(i,j,k,ipowno3)/114., & + & 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 + 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 + endif + 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 + 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 + endif + endif endif - enddo - enddo + enddo + enddo -! sulphate reduction in sediments - do k = 1, ks - do i = 1, kpie + ! sulphate reduction in sediments + do k = 1, ks + do i = 1, kpie if(omask(i,j) > 0.5) then - if(powtra(i,j,k,ipowaox) < 3.e-6 .and. powtra(i,j,k,ipowno3) < 3.e-6) then - posol = denit * sedlay(i,j,k,issso12) ! remineralization of poc - 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 - 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 - endif - 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*rnit - 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 - endif - endif + if(powtra(i,j,k,ipowaox) < 3.e-6 .and. powtra(i,j,k,ipowno3) < 3.e-6) then + posol = denit * sedlay(i,j,k,issso12) ! remineralization of poc + 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 + 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 + endif + 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*rnit + 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 + endif + endif endif - enddo - enddo ! end sulphate reduction + enddo + enddo ! end sulphate reduction -! Calculate CaCO3-CO3 cycle and simultaneous CO3-undersaturation diffusion -!************************************************************************* + ! Calculate CaCO3-CO3 cycle and simultaneous CO3-undersaturation diffusion + !************************************************************************* -! Compute new powcar, carbonate ion concentration in the sediment -! from changed alkalinity (nitrate production during remineralisation) -! and DIC gain. Iterate 5 times. This changes pH (sedhpl) of sediment. + ! Compute new powcar, carbonate ion concentration in the sediment + ! from changed alkalinity (nitrate production during remineralisation) + ! and DIC gain. Iterate 5 times. This changes pH (sedhpl) of sediment. - do k = 1, ks - do i = 1, kpie + do k = 1, ks + do i = 1, kpie if(omask(i,j) > 0.5) then - saln= min( 40., max( 0., psao(i,j,kbo(i,j)))) - rrho= prho(i,j,kbo(i,j)) - alk = (powtra(i,j,k,ipowaal) - (anaerob(i,k)+aerob(i,k))*16.) / rrho - c = (powtra(i,j,k,ipowaic) + (anaerob(i,k)+aerob(i,k))*122.) / rrho - sit = powtra(i,j,k,ipowasi) / rrho - pt = powtra(i,j,k,ipowaph) / rrho - ah1 = sedhpl(i,j,k) - K1 = keqb( 1,i,j) - K2 = keqb( 2,i,j) - Kb = keqb( 3,i,j) - Kw = keqb( 4,i,j) - Ks1 = keqb( 5,i,j) - Kf = keqb( 6,i,j) - Ksi = keqb( 7,i,j) - K1p = keqb( 8,i,j) - K2p = keqb( 9,i,j) - K3p = keqb(10,i,j) - - call carchm_solve(saln,c,alk,sit,pt, & - & K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p, & - & ah1,ac,niter) - - cu = ( 2. * c - ac ) / ( 2. + K1 / ah1 ) - cb = K1 * cu / ah1 - cc = K2 * cb / ah1 - sedhpl(i,j,k) = max( 1.e-20, ah1 ) - powcar(i,k) = cc * rrho + saln= min( 40., max( 0., psao(i,j,kbo(i,j)))) + rrho= prho(i,j,kbo(i,j)) + alk = (powtra(i,j,k,ipowaal) - (anaerob(i,k)+aerob(i,k))*16.) / rrho + c = (powtra(i,j,k,ipowaic) + (anaerob(i,k)+aerob(i,k))*122.) / rrho + sit = powtra(i,j,k,ipowasi) / rrho + pt = powtra(i,j,k,ipowaph) / rrho + ah1 = sedhpl(i,j,k) + K1 = keqb( 1,i,j) + K2 = keqb( 2,i,j) + Kb = keqb( 3,i,j) + Kw = keqb( 4,i,j) + Ks1 = keqb( 5,i,j) + Kf = keqb( 6,i,j) + Ksi = keqb( 7,i,j) + K1p = keqb( 8,i,j) + K2p = keqb( 9,i,j) + K3p = keqb(10,i,j) + + call carchm_solve(saln,c,alk,sit,pt, & + & K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p, & + & ah1,ac,niter) + + cu = ( 2. * c - ac ) / ( 2. + K1 / ah1 ) + cb = K1 * cu / ah1 + cc = K2 * cb / ah1 + sedhpl(i,j,k) = max( 1.e-20, ah1 ) + powcar(i,k) = cc * rrho endif - enddo - enddo + enddo + enddo -! Dissolution rate constant of CaCO3 (disso) [1/(kmol CO3--/m3)*1/sec]*dtbgc - dissot = disso_caco3 + ! Dissolution rate constant of CaCO3 (disso) [1/(kmol CO3--/m3)*1/sec]*dtbgc + dissot = disso_caco3 -! Evaluate boundary conditions for sediment-water column exchange. -! Current undersaturation of bottom water: sedb(i,0) and -! Approximation for new solid sediment, as from sedimentation flux: solrat(i,1) + ! Evaluate boundary conditions for sediment-water column exchange. + ! Current undersaturation of bottom water: sedb(i,0) and + ! Approximation for new solid sediment, as from sedimentation flux: solrat(i,1) -! CO3 saturation concentration is aksp/calcon as in CARCHM -! (calcon defined in MO_CHEMCON with 1.028e-2; 1/calcon =~ 97.) + ! CO3 saturation concentration is aksp/calcon as in CARCHM + ! (calcon defined in MO_CHEMCON with 1.028e-2; 1/calcon =~ 97.) - do i = 1, kpie - if(omask(i,j) > 0.5) then + do i = 1, kpie + if(omask(i,j) > 0.5) then satlev = keqb(11,i,j) / calcon + 2.e-5 undsa = MAX( satlev-powcar(i,1), 0. ) sedb1(i,0) = bolay(i,j) * (satlev-co3(i,j,kbo(i,j))) solrat(i,1) = (sedlay(i,j,1,isssc12) & & + prcaca(i,j) / (porsol(i,j,1)*seddw(1))) & & * dissot / (1.+dissot*undsa) * porsol(i,j,1) / porwat(i,j,1) - endif - enddo + endif + enddo -! Evaluate sediment undersaturation and degradation. -! Current undersaturation in pore water: sedb(i,k) and -! Approximation for new solid sediment, as from degradation: solrat(i,k) + ! Evaluate sediment undersaturation and degradation. + ! Current undersaturation in pore water: sedb(i,k) and + ! Approximation for new solid sediment, as from degradation: solrat(i,k) - do k = 1, ks - do i = 1, kpie + do k = 1, ks + do i = 1, kpie if(omask(i,j) > 0.5) then - undsa = MAX( keqb(11,i,j) / calcon - powcar(i,k), 0. ) - sedb1(i,k) = seddw(k) * porwat(i,j,k) * undsa - if (k > 1) solrat(i,k) = sedlay(i,j,k,isssc12) & - & * dissot/(1.+dissot*undsa) * porsol(i,j,k)/porwat(i,j,k) - if (undsa <= 0.) solrat(i,k) = 0. + undsa = MAX( keqb(11,i,j) / calcon - powcar(i,k), 0. ) + sedb1(i,k) = seddw(k) * porwat(i,j,k) * undsa + if (k > 1) solrat(i,k) = sedlay(i,j,k,isssc12) & + & * dissot/(1.+dissot*undsa) * porsol(i,j,k)/porwat(i,j,k) + if (undsa <= 0.) solrat(i,k) = 0. endif - enddo - enddo + enddo + enddo -! Solve for new undersaturation sediso, from current undersaturation sedb1, -! and first guess of new solid sediment solrat. + ! Solve for new undersaturation sediso, from current undersaturation sedb1, + ! and first guess of new solid sediment solrat. - call powadi(j,kpie,kpje,solrat,sedb1,sediso,omask) + call powadi(j,kpie,kpje,solrat,sedb1,sediso,omask) -! There is no exchange between water and sediment with respect to co3 so far. -! Add sedimentation to first layer. - do i = 1, kpie - if(omask(i,j) > 0.5) then + ! There is no exchange between water and sediment with respect to co3 so far. + ! Add sedimentation to first layer. + do i = 1, kpie + 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)) 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)) + 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 - endif - enddo + endif + enddo -! Calculate updated degradation rate from updated undersaturation. -! Calculate new solid sediment. -! No update of powcar pore water concentration from new undersaturation so far. -! Instead, only update DIC, and, of course, alkalinity. -! This also includes gains from aerobic and anaerobic decomposition. + ! Calculate updated degradation rate from updated undersaturation. + ! Calculate new solid sediment. + ! No update of powcar pore water concentration from new undersaturation so far. + ! Instead, only update DIC, and, of course, alkalinity. + ! This also includes gains from aerobic and anaerobic decomposition. - do k = 1, ks - do i = 1, kpie + do k = 1, ks + do i = 1, kpie if(omask(i,j) > 0.5) then - umfa = porsol(i,j,k) / porwat(i,j,k) - solrat(i,k) = sedlay(i,j,k,isssc12) & - & * dissot / (1. + dissot * sediso(i,k)) - posol = sediso(i,k) * solrat(i,k) - 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 - endif - 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)) - 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. - endif + umfa = porsol(i,j,k) / porwat(i,j,k) + solrat(i,k) = sedlay(i,j,k,isssc12) & + & * dissot / (1. + dissot * sediso(i,k)) + posol = sediso(i,k) * solrat(i,k) + 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 + endif + 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)) + 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. + endif endif - enddo - enddo + enddo + enddo enddo j_loop -!$OMP END PARALLEL DO + !$OMP END PARALLEL DO call dipowa(kpie,kpje,kpke,omask,lspin) -!ik add clay sedimentation onto sediment -!ik this is currently assumed to depend on total and corg sedimentation: -!ik f(POC) [kg C] / f(total) [kg] = 0.05 -!ik thus it is -!$OMP PARALLEL DO PRIVATE(i) + !ik add clay sedimentation onto sediment + !ik this is currently assumed to depend on total and corg sedimentation: + !ik f(POC) [kg C] / f(total) [kg] = 0.05 + !ik thus it is + !$OMP PARALLEL DO PRIVATE(i) do j = 1, kpje - do i = 1, kpie - sedlay(i,j,1,issster) = sedlay(i,j,1,issster) & - & + produs(i,j) / (porsol(i,j,1) * seddw(1)) - enddo + do i = 1, kpie + sedlay(i,j,1,issster) = sedlay(i,j,1,issster) & + & + produs(i,j) / (porsol(i,j,1) * seddw(1)) + enddo enddo -!$OMP END PARALLEL DO + !$OMP END PARALLEL DO if(.not. lspin) then -!$OMP PARALLEL DO PRIVATE(i) - do j = 1, kpje - do i = 1, kpie + !$OMP PARALLEL DO PRIVATE(i) + do j = 1, kpje + do i = 1, kpie silpro(i,j) = 0. prorca(i,j) = 0. prcaca(i,j) = 0. if (use_cisonew) then - pror13(i,j) = 0. - pror14(i,j) = 0. - prca13(i,j) = 0. - prca14(i,j) = 0. + pror13(i,j) = 0. + pror14(i,j) = 0. + prca13(i,j) = 0. + prca14(i,j) = 0. endif produs(i,j) = 0. - enddo - enddo -!$OMP END PARALLEL DO + enddo + enddo + !$OMP END PARALLEL DO endif - + end subroutine powach diff --git a/hamocc/powadi.F90 b/hamocc/powadi.F90 index 8608e630..46ccf03a 100644 --- a/hamocc/powadi.F90 +++ b/hamocc/powadi.F90 @@ -4,57 +4,57 @@ ! 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 powadi(j,kpie,kpje,solrat,sedb1,sediso,omask) -!********************************************************************** -! -!**** *POWADI* - vertical diffusion with simultaneous dissolution. -! -! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 -! -! Modified -! -------- -! S.Legutke, *MPI-MaD, HH* 10.04.01 -! -! Purpose -! ------- -! . -! -! Method -! ------- -! implicit discretisation. -! -!** Interface. -! ---------- -! -! *CALL* *POWADI(j,solrat,sedb1,sediso)* -! -! Input solrat : dissolution rate -! ===== j : zonal grid index -! sedb1 : tracer at entry -! -! Output: sediso: diffused tracer at exit -! ====== -! -! *PARAMETER* *PARAM1_BGC.h* - declaration of ocean/sediment tracer. -! -! Externals -! --------- -! none. -! -!********************************************************************** + !********************************************************************** + ! + !**** *POWADI* - vertical diffusion with simultaneous dissolution. + ! + ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 + ! + ! Modified + ! -------- + ! S.Legutke, *MPI-MaD, HH* 10.04.01 + ! + ! Purpose + ! ------- + ! . + ! + ! Method + ! ------- + ! implicit discretisation. + ! + !** Interface. + ! ---------- + ! + ! *CALL* *POWADI(j,solrat,sedb1,sediso)* + ! + ! Input solrat : dissolution rate + ! ===== j : zonal grid index + ! sedb1 : tracer at entry + ! + ! Output: sediso: diffused tracer at exit + ! ====== + ! + ! *PARAMETER* *PARAM1_BGC.h* - declaration of ocean/sediment tracer. + ! + ! Externals + ! --------- + ! none. + ! + !********************************************************************** use mo_sedmnt, only: porwah,porwat,seddw,seddzi use mo_param_bgc, only: sedict @@ -73,64 +73,64 @@ subroutine powadi(j,kpie,kpje,solrat,sedb1,sediso,omask) real :: asu, alo real, dimension(kpie,0:ks,3) :: tredsy -!********************************************************************** + !********************************************************************** do k = 1, ks - do i = 1, kpie - asu = sedict * seddzi(k) * porwah(i,j,k) - alo = 0. - if(k < ks) alo = sedict * seddzi(k+1) * porwah(i,j,k+1) - tredsy(i,k,1) = -asu - tredsy(i,k,3) = -alo - tredsy(i,k,2) = seddw(k) * porwat(i,j,k) - tredsy(i,k,1) & - & - tredsy(i,k,3) + solrat(i,k) * porwat(i,j,k) * seddw(k) - enddo + do i = 1, kpie + asu = sedict * seddzi(k) * porwah(i,j,k) + alo = 0. + if(k < ks) alo = sedict * seddzi(k+1) * porwah(i,j,k+1) + tredsy(i,k,1) = -asu + tredsy(i,k,3) = -alo + tredsy(i,k,2) = seddw(k) * porwat(i,j,k) - tredsy(i,k,1) & + & - tredsy(i,k,3) + solrat(i,k) * porwat(i,j,k) * seddw(k) + enddo enddo k = 0 asu = 0. do i = 1, kpie - alo = sedict * seddzi(1) * porwah(i,j,1) - if(omask(i,j) > 0.5) then - tredsy(i,k,1) = -asu - tredsy(i,k,3) = -alo - tredsy(i,k,2) = bolay(i,j) - tredsy(i,k,1) - tredsy(i,k,3) - else - tredsy(i,k,1) = 0 - tredsy(i,k,3) = 0 - tredsy(i,k,2) = 0 - endif + alo = sedict * seddzi(1) * porwah(i,j,1) + if(omask(i,j) > 0.5) then + tredsy(i,k,1) = -asu + tredsy(i,k,3) = -alo + tredsy(i,k,2) = bolay(i,j) - tredsy(i,k,1) - tredsy(i,k,3) + else + tredsy(i,k,1) = 0 + tredsy(i,k,3) = 0 + tredsy(i,k,2) = 0 + endif enddo do k = 1, ks - do i = 1, kpie - if(omask(i,j) > 0.5) then - tredsy(i,k-1,1) = tredsy(i,k,1) / tredsy(i,k-1,2) - tredsy(i,k,2) = tredsy(i,k,2) & - & - tredsy(i,k-1,3) * tredsy(i,k,1) / tredsy(i,k-1,2) - endif - enddo + do i = 1, kpie + if(omask(i,j) > 0.5) then + tredsy(i,k-1,1) = tredsy(i,k,1) / tredsy(i,k-1,2) + tredsy(i,k,2) = tredsy(i,k,2) & + & - tredsy(i,k-1,3) * tredsy(i,k,1) / tredsy(i,k-1,2) + endif + enddo enddo do k = 1, ks - do i = 1, kpie - sedb1(i,k) = sedb1(i,k) - tredsy(i,k-1,1) * sedb1(i,k-1) - enddo + do i = 1, kpie + sedb1(i,k) = sedb1(i,k) - tredsy(i,k-1,1) * sedb1(i,k-1) + enddo enddo k = ks do i = 1, kpie - if(omask(i,j) > 0.5) sediso(i,k) = sedb1(i,k) / tredsy(i,k,2) + if(omask(i,j) > 0.5) sediso(i,k) = sedb1(i,k) / tredsy(i,k,2) enddo do k = 1, ks - l = ks - k - do i = 1, kpie - if(omask(i,j) > 0.5) then - sediso(i,l) = ( sedb1(i,l) - tredsy(i,l,3) * sediso(i,l+1) ) & - & / tredsy(i,l,2) - endif - enddo + l = ks - k + do i = 1, kpie + if(omask(i,j) > 0.5) then + sediso(i,l) = ( sedb1(i,l) - tredsy(i,l,3) * sediso(i,l+1) ) & + & / tredsy(i,l,2) + endif + enddo enddo end subroutine powadi diff --git a/hamocc/preftrc.F90 b/hamocc/preftrc.F90 index a33280d1..a0f4e29a 100644 --- a/hamocc/preftrc.F90 +++ b/hamocc/preftrc.F90 @@ -3,45 +3,45 @@ ! 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 PREFTRC(kpie,kpje,omask) -!**************************************************************** -! -!**** *PREFTRC* - update preformed tracers in the mixed layer. -! -! J. Tjiputra, J.Schwinger, *BCCR, Bergen* 2015-01-23 -! -! Modified -! -------- -! J.Tjiputra, *Uni Research, Bergen* 2018-04-12 -! - added preformed DIC tracer -! -! -! Method -! ------- -! Preformed tracers are set to the value of their full counterparts -! in the mixed layer. -! -! -!** Interface to ocean model (parameter list): -! ----------------------------------------- -! -! *INTEGER* *kpie* - 1st dimension of model grid. -! *INTEGER* *kpje* - 2nd dimension of model grid. -! -!************************************************************************** + !**************************************************************** + ! + !**** *PREFTRC* - update preformed tracers in the mixed layer. + ! + ! J. Tjiputra, J.Schwinger, *BCCR, Bergen* 2015-01-23 + ! + ! Modified + ! -------- + ! J.Tjiputra, *Uni Research, Bergen* 2018-04-12 + ! - added preformed DIC tracer + ! + ! + ! Method + ! ------- + ! Preformed tracers are set to the value of their full counterparts + ! in the mixed layer. + ! + ! + !** Interface to ocean model (parameter list): + ! ----------------------------------------- + ! + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! + !************************************************************************** use mo_carbch, only: ocetra use mo_param1_bgc, only: ialkali,ioxygen,iphosph,iprefalk,iprefdic,iprefo2,iprefpo4,isco212 @@ -55,14 +55,14 @@ SUBROUTINE PREFTRC(kpie,kpje,omask) INTEGER :: i,j do j=1,kpje - do i=1,kpie - if (omask(i,j) .gt. 0.5 ) then - ocetra(i,j,1:kmle(i,j),iprefo2) = ocetra(i,j,1:kmle(i,j),ioxygen) - ocetra(i,j,1:kmle(i,j),iprefpo4) = ocetra(i,j,1:kmle(i,j),iphosph) - ocetra(i,j,1:kmle(i,j),iprefalk) = ocetra(i,j,1:kmle(i,j),ialkali) - ocetra(i,j,1:kmle(i,j),iprefdic) = ocetra(i,j,1:kmle(i,j),isco212) - endif - enddo + do i=1,kpie + if (omask(i,j) .gt. 0.5 ) then + ocetra(i,j,1:kmle(i,j),iprefo2) = ocetra(i,j,1:kmle(i,j),ioxygen) + ocetra(i,j,1:kmle(i,j),iprefpo4) = ocetra(i,j,1:kmle(i,j),iphosph) + ocetra(i,j,1:kmle(i,j),iprefalk) = ocetra(i,j,1:kmle(i,j),ialkali) + ocetra(i,j,1:kmle(i,j),iprefdic) = ocetra(i,j,1:kmle(i,j),isco212) + endif + enddo enddo diff --git a/hamocc/profile_gd.F90 b/hamocc/profile_gd.F90 index 688027e5..0b4bfd24 100644 --- a/hamocc/profile_gd.F90 +++ b/hamocc/profile_gd.F90 @@ -3,186 +3,186 @@ ! 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 profile_gd(kpie,kpje,kpke,kbnd,pglon,pglat,omask) -!******************************************************************************* -! J.Schwinger, *Gfi, Bergen* 2011-05-19 -! -! Modified -! -------- -! J.Schwinger, *Uni Climate, BCCR* 2017-07-07 -! - moved conversion from mumol to mol to mod_gdata_read -! - changed linear interpolation from data-levels to model levels to propper -! mapping of data profile to model-levels -! -! J.Schwinger, *Uni Research, Bergen* 2018-04-12 -! - adaptions for reading c-isotope initial values as d13C and d14C -! -! Purpose -! ------- -! - initialise HAMOCC fields with gridded (1x1 deg) WOA and GLODAP -! data using the module mo_Gdata_read. Note that the routine get_profile -! returns the mean of all data profiles within a rectangular region -! ("smoothing region") of dxy x dxy degrees extent, where dxy is an -! adjustable parameter. -! -! -!******************************************************************************* - -use mod_xc, only: xchalt -use mo_carbch, only: ocetra -use mo_Gdata_read, only: set_Gdata,clean_Gdata,get_profile,nzmax,nz,zlev_bnds,fillval -use mo_control_bgc, only: io_stdo_bgc -use mo_vgrid, only: ptiestw -use mo_param1_bgc, only: ialkali,iano3,ioxygen,iphosph,isco212,isilica -! 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 -real, intent(in) :: omask(kpie,kpje) -real, intent(in) :: pglon(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) -real, intent(in) :: pglat(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - -! Local variables -integer :: i,j,k,l,ll,n -integer :: idx,izmax -real :: prf(nzmax),wgt(nzmax),zbnds(2,nzmax),clon,clat - -! Extent of "smoothing region" -real, parameter :: dxy = 5.0 - -! Number of fields to read -integer, parameter :: nread_base = 6 -integer, parameter :: nread_ndic = 2 -integer, parameter :: nread_ciso = 2 -integer, parameter :: maxflds = nread_base+nread_ndic+nread_ciso - -integer :: nflds, no -integer :: ifld(maxflds) -character(len=3) :: vname(maxflds) - -nflds = nread_base -vname( 1:nflds) = (/ 'dic', 'alk', 'pho', 'nit','sil', 'oxy' /) - ifld( 1:nflds) = (/ isco212,ialkali,iphosph,iano3,isilica,ioxygen/) - - if (use_natDIC) then + !******************************************************************************* + ! J.Schwinger, *Gfi, Bergen* 2011-05-19 + ! + ! Modified + ! -------- + ! J.Schwinger, *Uni Climate, BCCR* 2017-07-07 + ! - moved conversion from mumol to mol to mod_gdata_read + ! - changed linear interpolation from data-levels to model levels to propper + ! mapping of data profile to model-levels + ! + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - adaptions for reading c-isotope initial values as d13C and d14C + ! + ! Purpose + ! ------- + ! - initialise HAMOCC fields with gridded (1x1 deg) WOA and GLODAP + ! data using the module mo_Gdata_read. Note that the routine get_profile + ! returns the mean of all data profiles within a rectangular region + ! ("smoothing region") of dxy x dxy degrees extent, where dxy is an + ! adjustable parameter. + ! + ! + !******************************************************************************* + + use mod_xc, only: xchalt + use mo_carbch, only: ocetra + use mo_Gdata_read, only: set_Gdata,clean_Gdata,get_profile,nzmax,nz,zlev_bnds,fillval + use mo_control_bgc, only: io_stdo_bgc + use mo_vgrid, only: ptiestw + use mo_param1_bgc, only: ialkali,iano3,ioxygen,iphosph,isco212,isilica + ! 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 + real, intent(in) :: omask(kpie,kpje) + real, intent(in) :: pglon(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) + real, intent(in) :: pglat(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) + + ! Local variables + integer :: i,j,k,l,ll,n + integer :: idx,izmax + real :: prf(nzmax),wgt(nzmax),zbnds(2,nzmax),clon,clat + + ! Extent of "smoothing region" + real, parameter :: dxy = 5.0 + + ! Number of fields to read + integer, parameter :: nread_base = 6 + integer, parameter :: nread_ndic = 2 + integer, parameter :: nread_ciso = 2 + integer, parameter :: maxflds = nread_base+nread_ndic+nread_ciso + + integer :: nflds, no + integer :: ifld(maxflds) + character(len=3) :: vname(maxflds) + + nflds = nread_base + vname( 1:nflds) = (/ 'dic', 'alk', 'pho', 'nit','sil', 'oxy' /) + ifld( 1:nflds) = (/ isco212,ialkali,iphosph,iano3,isilica,ioxygen/) + + if (use_natDIC) then no = nflds+1 nflds = nflds+nread_ndic vname(no:nflds) = (/'dic', 'alk'/) ifld(no:nflds) = (/inatsco212,inatalkali/) - endif + endif - if (use_cisonew) then + if (use_cisonew) then no = nflds+1 nflds = nflds+nread_ciso vname(no:nflds) = (/'d13', 'd14'/) ifld(no:nflds) = (/isco213,isco214/) - endif + endif -do n = 1, nflds ! Loop over tracer + do n = 1, nflds ! Loop over tracer - call set_Gdata(vname(n),dxy) + call set_Gdata(vname(n),dxy) - do j=1,kpje + do j=1,kpje do i=1,kpie - If(omask(i,j) > 0.5) THEN - - clon = pglon(i,j) - clat = pglat(i,j) - idx = ifld(n) - call get_profile(clon,clat,prf) - - ! Find depest z-level with valid data - izmax=nz - do l=2,nz - if( prf(l) < fillval*0.1 ) then - izmax = l-1 - exit - endif - enddo - ! Set data level-boundaries for this profile - zbnds = fillval - zbnds(:,1:nz) = zlev_bnds - zbnds(1,1) = 0.0 ! make sure that upper data bnd is 0 - if(zbnds(2,izmax) < ptiestw(i,j,kpke+1)) then - zbnds(2,izmax) = ptiestw(i,j,kpke+1)+10.0 ! extend lower bound of bottom layer + If(omask(i,j) > 0.5) THEN + + clon = pglon(i,j) + clat = pglat(i,j) + idx = ifld(n) + call get_profile(clon,clat,prf) + + ! Find depest z-level with valid data + izmax=nz + do l=2,nz + if( prf(l) < fillval*0.1 ) then + izmax = l-1 + exit endif - - Do k=1,kpke - - wgt(:)=0.0 - - loop_obs: do l=1,izmax - - ! 1st case: Model layer completely within data-layer - if(zbnds(1,l) <= ptiestw(i,j,k) .and. zbnds(2,l) >= ptiestw(i,j,k+1)) then - ocetra(i,j,k,idx)=prf(l) - exit loop_obs - endif - - ! 2nd case: one (or both) data-layer boundary are within model layer - - ! a) The lower data level-boundary is lower than the upper model level-interface. - ! and the upper data level-boundary is higher than the lower model - ! level-interface => some overlap between data and model level exists. - ! Calculate the corresponding weight. - if(zbnds(2,l) > ptiestw(i,j,k) .and. zbnds(1,l) <= ptiestw(i,j,k+1)) & - wgt(l) = zbnds(2,l)-ptiestw(i,j,k) & - - max(zbnds(1,l)-ptiestw(i,j,k), 0.0) & - - max(zbnds(2,l)-ptiestw(i,j,k+1),0.0) - - ! b) The upper data level-boundary is lower than the lower model level-interface - ! => all weights have been calculated, calculate concentration and exit - if(zbnds(1,l) > ptiestw(i,j,k+1) .or. l==izmax) then - wgt(:) = wgt(:)/(ptiestw(i,j,k+1)-ptiestw(i,j,k)) - if( abs(sum(wgt(:))-1.0) > 1.0e-6 ) then - write(io_stdo_bgc,*) 'profile_gd error: inconsisten weihts' - write(io_stdo_bgc,*) 'profile_gd error: ', k,l,abs(sum(wgt(:))-1.0) - write(io_stdo_bgc,*) 'profile_gd error: ', wgt(1:izmax) - write(io_stdo_bgc,*) 'profile_gd error: ', ptiestw(i,j,k),ptiestw(i,j,k+1) - call flush(io_stdo_bgc) - call xchalt('(profile_gd)') - endif - do ll=1,l - ocetra(i,j,k,idx) = ocetra(i,j,k,idx) + prf(ll)*wgt(ll) - enddo - exit loop_obs - endif - - - enddo loop_obs - - ENDDO ! k=1,kpke - - ENDIF ! omask > 0.5 - - ENDDO - ENDDO - - call clean_Gdata() - -enddo ! Loop over fields - -RETURN - -!******************************************************************************** + enddo + ! Set data level-boundaries for this profile + zbnds = fillval + zbnds(:,1:nz) = zlev_bnds + zbnds(1,1) = 0.0 ! make sure that upper data bnd is 0 + if(zbnds(2,izmax) < ptiestw(i,j,kpke+1)) then + zbnds(2,izmax) = ptiestw(i,j,kpke+1)+10.0 ! extend lower bound of bottom layer + endif + + Do k=1,kpke + + wgt(:)=0.0 + + loop_obs: do l=1,izmax + + ! 1st case: Model layer completely within data-layer + if(zbnds(1,l) <= ptiestw(i,j,k) .and. zbnds(2,l) >= ptiestw(i,j,k+1)) then + ocetra(i,j,k,idx)=prf(l) + exit loop_obs + endif + + ! 2nd case: one (or both) data-layer boundary are within model layer + + ! a) The lower data level-boundary is lower than the upper model level-interface. + ! and the upper data level-boundary is higher than the lower model + ! level-interface => some overlap between data and model level exists. + ! Calculate the corresponding weight. + if(zbnds(2,l) > ptiestw(i,j,k) .and. zbnds(1,l) <= ptiestw(i,j,k+1)) & + wgt(l) = zbnds(2,l)-ptiestw(i,j,k) & + - max(zbnds(1,l)-ptiestw(i,j,k), 0.0) & + - max(zbnds(2,l)-ptiestw(i,j,k+1),0.0) + + ! b) The upper data level-boundary is lower than the lower model level-interface + ! => all weights have been calculated, calculate concentration and exit + if(zbnds(1,l) > ptiestw(i,j,k+1) .or. l==izmax) then + wgt(:) = wgt(:)/(ptiestw(i,j,k+1)-ptiestw(i,j,k)) + if( abs(sum(wgt(:))-1.0) > 1.0e-6 ) then + write(io_stdo_bgc,*) 'profile_gd error: inconsisten weihts' + write(io_stdo_bgc,*) 'profile_gd error: ', k,l,abs(sum(wgt(:))-1.0) + write(io_stdo_bgc,*) 'profile_gd error: ', wgt(1:izmax) + write(io_stdo_bgc,*) 'profile_gd error: ', ptiestw(i,j,k),ptiestw(i,j,k+1) + call flush(io_stdo_bgc) + call xchalt('(profile_gd)') + endif + do ll=1,l + ocetra(i,j,k,idx) = ocetra(i,j,k,idx) + prf(ll)*wgt(ll) + enddo + exit loop_obs + endif + + + enddo loop_obs + + ENDDO ! k=1,kpke + + ENDIF ! omask > 0.5 + + ENDDO + ENDDO + + call clean_Gdata() + + enddo ! Loop over fields + + RETURN + + !******************************************************************************** END subroutine profile_gd diff --git a/hamocc/read_netcdf_var.F90 b/hamocc/read_netcdf_var.F90 index 90b56067..630fab94 100644 --- a/hamocc/read_netcdf_var.F90 +++ b/hamocc/read_netcdf_var.F90 @@ -3,153 +3,153 @@ ! 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 READ_NETCDF_VAR(ncid,desc,arr,klev,time,typeio) -!************************************************************************** -! -! Reads a variable from a NETCDF file and distributes it to all PEs -! -! The NETCDF File is only accessed by mnproc=1 -! -!************************************************************************** - use netcdf, only: nf90_noerr,nf90_inq_varid,nf90_strerror,nf90_get_var - use mod_xc, only: idm,itdm,jtdm,jdm,lp,mnproc,nbdy,xchalt,xcaput +SUBROUTINE READ_NETCDF_VAR(ncid,desc,arr,klev,time,typeio) + !************************************************************************** + ! + ! Reads a variable from a NETCDF file and distributes it to all PEs + ! + ! The NETCDF File is only accessed by mnproc=1 + ! + !************************************************************************** + use netcdf, only: nf90_noerr,nf90_inq_varid,nf90_strerror,nf90_get_var + use mod_xc, only: idm,itdm,jtdm,jdm,lp,mnproc,nbdy,xchalt,xcaput #ifdef PNETCDF - use mod_xc, only: i0,ii,jj,j0 + use mod_xc, only: i0,ii,jj,j0 #endif - implicit none + implicit none #ifdef PNETCDF #include #include #endif - integer ncid, klev, time, ndims - character (len=*) desc - real arr(idm,jdm,klev),arr_g(itdm,jtdm) + integer ncid, klev, time, ndims + character (len=*) desc + real arr(idm,jdm,klev),arr_g(itdm,jtdm) - real, allocatable :: arr_l(:,:,:) + real, allocatable :: arr_l(:,:,:) - integer ncstat,ncvarid,i,j,k,typeio - integer :: start(4),count(4) + integer ncstat,ncvarid,i,j,k,typeio + integer :: start(4),count(4) #ifdef PNETCDF - integer (kind=MPI_OFFSET_KIND) :: istart(4),icount(4) + integer (kind=MPI_OFFSET_KIND) :: istart(4),icount(4) #endif -! Read NETCDF data + ! Read NETCDF data - IF(TYPEIO==0) THEN - start=1 - count=0 - start(1)=1 - count(1)=itdm - start(2)=1 - count(2)=jtdm - if (klev.gt.1.or.time.gt.0) then - if (klev.gt.1.and.time.gt.0) then - start(3)=1 - count(3)=1 - start(4)=time - count(4)=1 - else if (klev.gt.1.and.time.eq.0) then - start(3)=1 - count(3)=1 - else - start(3)=time - count(3)=1 - endif + IF(TYPEIO==0) THEN + start=1 + count=0 + start(1)=1 + count(1)=itdm + start(2)=1 + count(2)=jtdm + if (klev.gt.1.or.time.gt.0) then + if (klev.gt.1.and.time.gt.0) then + start(3)=1 + count(3)=1 + start(4)=time + count(4)=1 + else if (klev.gt.1.and.time.eq.0) then + start(3)=1 + count(3)=1 + else + start(3)=time + count(3)=1 endif - allocate(arr_l(1-nbdy:idm+nbdy,1-nbdy:jdm+nbdy,1)) - + endif + allocate(arr_l(1-nbdy:idm+nbdy,1-nbdy:jdm+nbdy,1)) + + if (mnproc.eq.1) then + ncstat=nf90_inq_varid(ncid,desc,ncvarid) + if (ncstat.ne.nf90_noerr) then + write(lp,'(4a)') 'nf90_inq_varid: ',trim(desc),': ', & + & nf90_strerror(ncstat) + call xchalt('(read_netcdf_var)') + stop '(read_netcdf_var)' + endif + endif + do k=1,klev if (mnproc.eq.1) then - ncstat=nf90_inq_varid(ncid,desc,ncvarid) + if (k.gt.1) then + start(3)=k + count(3)=1 + endif + ncstat=nf90_get_var(ncid,ncvarid,arr_g,start,count) if (ncstat.ne.nf90_noerr) then - write(lp,'(4a)') 'nf90_inq_varid: ',trim(desc),': ', & - & nf90_strerror(ncstat) + write(lp,'(4a)') 'nf90_get_vara_double: ',trim(desc),': ', & + & nf90_strerror(ncstat) call xchalt('(read_netcdf_var)') - stop '(read_netcdf_var)' + stop '(read_netcdf_var)' endif endif - do k=1,klev - if (mnproc.eq.1) then - if (k.gt.1) then - start(3)=k - count(3)=1 - endif - ncstat=nf90_get_var(ncid,ncvarid,arr_g,start,count) - if (ncstat.ne.nf90_noerr) then - write(lp,'(4a)') 'nf90_get_vara_double: ',trim(desc),': ', & - & nf90_strerror(ncstat) - call xchalt('(read_netcdf_var)') - stop '(read_netcdf_var)' - endif - endif - call xcaput(arr_g,arr_l,1) - do j=1,jdm - do i=1,idm - arr(i,j,k)=arr_l(i,j,1) - enddo + call xcaput(arr_g,arr_l,1) + do j=1,jdm + do i=1,idm + arr(i,j,k)=arr_l(i,j,1) enddo enddo - ELSE IF(TYPEIO==1) THEN + enddo + ELSE IF(TYPEIO==1) THEN #ifdef PNETCDF - allocate(arr_l(ii,jj,klev)) - arr=0.0 - istart=1 - icount=0 - istart(1)=i0+1 - icount(1)=ii - istart(2)=j0+1 - icount(2)=jj - if (klev.gt.1.or.time.gt.0) then - if (klev.gt.1.and.time.gt.0) then - istart(3)=1 - icount(3)=klev - istart(4)=time - icount(4)=1 - else if (klev.gt.1.and.time.eq.0) then - istart(3)=1 - icount(3)=klev - else - istart(3)=time - icount(3)=1 - endif + allocate(arr_l(ii,jj,klev)) + arr=0.0 + istart=1 + icount=0 + istart(1)=i0+1 + icount(1)=ii + istart(2)=j0+1 + icount(2)=jj + if (klev.gt.1.or.time.gt.0) then + if (klev.gt.1.and.time.gt.0) then + istart(3)=1 + icount(3)=klev + istart(4)=time + icount(4)=1 + else if (klev.gt.1.and.time.eq.0) then + istart(3)=1 + icount(3)=klev + else + istart(3)=time + icount(3)=1 endif + endif - ncstat=nfmpi_inq_varid(ncid,desc,ncvarid) - if (ncstat.ne.nf_noerr) then - write(lp,'(4a)') 'nfmpi_inq_varid: ',trim(desc),': ', & - & nfmpi_strerror(ncstat) - call xchalt('(read_pnetcdf_var)') - stop '(read_pnetcdf_var)' - endif + ncstat=nfmpi_inq_varid(ncid,desc,ncvarid) + if (ncstat.ne.nf_noerr) then + write(lp,'(4a)') 'nfmpi_inq_varid: ',trim(desc),': ', & + & nfmpi_strerror(ncstat) + call xchalt('(read_pnetcdf_var)') + stop '(read_pnetcdf_var)' + endif - ncstat=nfmpi_get_vara_double_all(ncid,ncvarid,istart,icount,arr_l) - if (ncstat.ne.nf_noerr) then - write(lp,'(4a)') 'nfmpi_get_vara_double: ',trim(desc),': ', & - & nfmpi_strerror(ncstat) - call xchalt('(read_pnetcdf_var)') - stop '(read_pnetcdf_var)' - endif - do k=1,klev + ncstat=nfmpi_get_vara_double_all(ncid,ncvarid,istart,icount,arr_l) + if (ncstat.ne.nf_noerr) then + write(lp,'(4a)') 'nfmpi_get_vara_double: ',trim(desc),': ', & + & nfmpi_strerror(ncstat) + call xchalt('(read_pnetcdf_var)') + stop '(read_pnetcdf_var)' + endif + do k=1,klev do j=1,jj - do i=1,ii - arr(i,j,k)=arr_l(i,j,k) - enddo + do i=1,ii + arr(i,j,k)=arr_l(i,j,k) enddo enddo + enddo #endif - ELSE - call xchalt('(read_pnetcdf_var) WRONG IOTYPE') - ENDIF - END + ELSE + call xchalt('(read_pnetcdf_var) WRONG IOTYPE') + ENDIF +END SUBROUTINE READ_NETCDF_VAR diff --git a/hamocc/restart_hamoccwt.F90 b/hamocc/restart_hamoccwt.F90 index 728e2b5b..e9eebf59 100644 --- a/hamocc/restart_hamoccwt.F90 +++ b/hamocc/restart_hamoccwt.F90 @@ -17,9 +17,9 @@ subroutine restart_hamoccwt(rstfnm_ocn) -! -! write restart for HAMOCC -! + ! + ! write restart for HAMOCC + ! use mod_time, only: date,nstep use mod_xc, only: idm,jdm,kdm use mod_tracers, only: ntrbgc,ntr,itrbgc,trc diff --git a/hamocc/sedshi.F90 b/hamocc/sedshi.F90 index 10f32ac3..71365024 100644 --- a/hamocc/sedshi.F90 +++ b/hamocc/sedshi.F90 @@ -5,300 +5,300 @@ ! 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 SEDSHI(kpie,kpje,omask) -!********************************************************************** -! -!**** *SEDSHI* - . -! -! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 -! -! Modified -! -------- -! S.Legutke, *MPI-MaD, HH* 10.04.01 -! - rename ssssil(i,j,k)=sedlay(i,j,k,issssil) etc. -! I. Kriest *MPI-Met, HH*, 27.05.03 -! - change specific weights for opal, CaCO3, POC -! - include upward transport -! Purpose -! ------- -! . -! -! Method -! ------- -! . -! -!** Interface. -! ---------- -! -! *CALL* *SEDSHI* -! -! Externals -! --------- -! none. -! -!********************************************************************** +SUBROUTINE SEDSHI(kpie,kpje,omask) + !********************************************************************** + ! + !**** *SEDSHI* - . + ! + ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 + ! + ! Modified + ! -------- + ! S.Legutke, *MPI-MaD, HH* 10.04.01 + ! - rename ssssil(i,j,k)=sedlay(i,j,k,issssil) etc. + ! I. Kriest *MPI-Met, HH*, 27.05.03 + ! - change specific weights for opal, CaCO3, POC + ! - include upward transport + ! Purpose + ! ------- + ! . + ! + ! Method + ! ------- + ! . + ! + !** Interface. + ! ---------- + ! + ! *CALL* *SEDSHI* + ! + ! Externals + ! --------- + ! none. + ! + !********************************************************************** - use mo_sedmnt, only: burial,calfa,clafa,oplfa,orgfa,porsol,sedlay,seddw,solfu - use mo_param_bgc, only: rcar - use mo_param1_bgc, only: isssc12,issssil,issso12,issster,ks,nsedtra, & - isssc13,isssc14,issso13,issso14 - use mo_control_bgc, only: use_cisonew + use mo_sedmnt, only: burial,calfa,clafa,oplfa,orgfa,porsol,sedlay,seddw,solfu + use mo_param_bgc, only: rcar + use mo_param1_bgc, only: isssc12,issssil,issso12,issster,ks,nsedtra, & + isssc13,isssc14,issso13,issso14 + use mo_control_bgc, only: use_cisonew - implicit none + implicit none - INTEGER :: kpie,kpje,i,j,k,l,iv - REAL :: pdlxp(kpie,kpje),pdlyp(kpie,kpje),omask(kpie,kpje) - REAL :: wsed(kpie,kpje), fulsed(kpie,kpje) - REAL :: sedlo,uebers,seddef,spresent,buried - REAL :: refill,frac + INTEGER :: kpie,kpje,i,j,k,l,iv + REAL :: pdlxp(kpie,kpje),pdlyp(kpie,kpje),omask(kpie,kpje) + REAL :: wsed(kpie,kpje), fulsed(kpie,kpje) + REAL :: sedlo,uebers,seddef,spresent,buried + REAL :: refill,frac -! DOWNWARD SHIFTING -! shift solid sediment sediment downwards, if layer is full, i.e., if -! the volume filled by the four constituents poc, opal, caco3, clay -! is more than porsol*seddw -! the outflow of layer i is given by sedlay(i)*porsol(i)*seddw(i), it is -! distributed in the layer below over a volume of porsol(i+1)*seddw(i+1) + ! DOWNWARD SHIFTING + ! shift solid sediment sediment downwards, if layer is full, i.e., if + ! the volume filled by the four constituents poc, opal, caco3, clay + ! is more than porsol*seddw + ! the outflow of layer i is given by sedlay(i)*porsol(i)*seddw(i), it is + ! distributed in the layer below over a volume of porsol(i+1)*seddw(i+1) - do k=1,ks-1 + do k=1,ks-1 -!$OMP PARALLEL DO PRIVATE(i,sedlo) - do j=1,kpje - do i=1,kpie - if(omask(i,j).gt.0.5) then -!ka if(bolay(i,j).gt.0.) then - sedlo = orgfa*rcar*sedlay(i,j,k,issso12) & - & +calfa*sedlay(i,j,k,isssc12) & - & +oplfa*sedlay(i,j,k,issssil) & - & +clafa*sedlay(i,j,k,issster) -! "full sediment has sedlo=1 - wsed(i,j)=max(0.,(sedlo-1.)/(sedlo+1.e-10)) - endif - enddo !end i-loop - enddo !end j-loop -!$OMP END PARALLEL DO - -! filling downward (accumulation) - do iv=1,nsedtra -!$OMP PARALLEL DO PRIVATE(i,uebers) - do j=1,kpje + !$OMP PARALLEL DO PRIVATE(i,sedlo) + do j=1,kpje + do i=1,kpie + if(omask(i,j).gt.0.5) then + !ka if(bolay(i,j).gt.0.) then + sedlo = orgfa*rcar*sedlay(i,j,k,issso12) & + & +calfa*sedlay(i,j,k,isssc12) & + & +oplfa*sedlay(i,j,k,issssil) & + & +clafa*sedlay(i,j,k,issster) + ! "full sediment has sedlo=1 + wsed(i,j)=max(0.,(sedlo-1.)/(sedlo+1.e-10)) + endif + enddo !end i-loop + enddo !end j-loop + !$OMP END PARALLEL DO + + ! filling downward (accumulation) + do iv=1,nsedtra + !$OMP PARALLEL DO PRIVATE(i,uebers) + do j=1,kpje do i=1,kpie if(omask(i,j).gt.0.5) then -!ka if(bolay(i,j).gt.0.) then + !ka if(bolay(i,j).gt.0.) then uebers=wsed(i,j)*sedlay(i,j,k,iv) sedlay(i,j,k ,iv)=sedlay(i,j,k ,iv)-uebers sedlay(i,j,k+1,iv)=sedlay(i,j,k+1,iv)+uebers & - & *(seddw(k)*porsol(i,j,k))/(seddw(k+1)*porsol(i,j,k+1)) + & *(seddw(k)*porsol(i,j,k))/(seddw(k+1)*porsol(i,j,k+1)) endif enddo !end i-loop - enddo !end j-loop -!$OMP END PARALLEL DO - enddo !end iv-loop + enddo !end j-loop + !$OMP END PARALLEL DO + enddo !end iv-loop - enddo !end k-loop + enddo !end k-loop -! store amount lost from last sediment layer - this is a kind of -! permanent burial in deep consolidated layer, and this stuff is -! effectively lost from the whole ocean+sediment(+atmosphere) system. -! Would have to be supplied by river runoff or simple addition e.g. -! to surface layers in the long range. Can be supplied again if a -! sediment column has a deficiency in volume. + ! store amount lost from last sediment layer - this is a kind of + ! permanent burial in deep consolidated layer, and this stuff is + ! effectively lost from the whole ocean+sediment(+atmosphere) system. + ! Would have to be supplied by river runoff or simple addition e.g. + ! to surface layers in the long range. Can be supplied again if a + ! sediment column has a deficiency in volume. -!$OMP PARALLEL DO PRIVATE(i,sedlo) - do j=1,kpje - do i=1,kpie - if(omask(i,j).gt.0.5) then -!ka if(bolay(i,j).gt.0.) then - sedlo = orgfa*rcar*sedlay(i,j,ks,issso12) & - & +calfa*sedlay(i,j,ks,isssc12) & - & +oplfa*sedlay(i,j,ks,issssil) & - & +clafa*sedlay(i,j,ks,issster) - wsed(i,j)=max(0.,(sedlo-1.)/(sedlo+1.e-10)) - endif - enddo !end i-loop - enddo !end j-loop -!$OMP END PARALLEL DO + !$OMP PARALLEL DO PRIVATE(i,sedlo) + do j=1,kpje + do i=1,kpie + if(omask(i,j).gt.0.5) then + !ka if(bolay(i,j).gt.0.) then + sedlo = orgfa*rcar*sedlay(i,j,ks,issso12) & + & +calfa*sedlay(i,j,ks,isssc12) & + & +oplfa*sedlay(i,j,ks,issssil) & + & +clafa*sedlay(i,j,ks,issster) + wsed(i,j)=max(0.,(sedlo-1.)/(sedlo+1.e-10)) + endif + enddo !end i-loop + enddo !end j-loop + !$OMP END PARALLEL DO - do iv=1,nsedtra -!$OMP PARALLEL DO PRIVATE(i,uebers) - do j=1,kpje + do iv=1,nsedtra + !$OMP PARALLEL DO PRIVATE(i,uebers) + do j=1,kpje do i=1,kpie - if(omask(i,j).gt.0.5) then -!ka if(bolay(i,j).gt.0.) then - uebers=wsed(i,j)*sedlay(i,j,k,iv) - sedlay(i,j,ks ,iv)=sedlay(i,j,ks ,iv)-uebers - burial(i,j,iv)=burial(i,j,iv)+uebers*seddw(k)*porsol(i,j,k) - endif - enddo !end i-loop - enddo !end j-loop -!$OMP END PARALLEL DO - enddo !end iv-loop - -! now the loading nowhere excceds 1 - -! digging from below in case of erosion -! UPWARD SHIFTING -! shift solid sediment sediment upwards, if total sediment volume is less -! than required, i.e., if the volume filled by the four constituents -! poc, opal, caco3, claycik (integrated over total sediment column) -! is less than porsol*seddw (integrated over total sediment column) -! first, the last box is filled from below with total required volume; -! then, successively, the following layers are filled upwards. -! if there is not enough solid matter to fill the column, add clay. - -!$OMP PARALLEL DO PRIVATE(i) - do j=1,kpje - do i=1,kpie - fulsed(i,j)=0. + if(omask(i,j).gt.0.5) then + !ka if(bolay(i,j).gt.0.) then + uebers=wsed(i,j)*sedlay(i,j,k,iv) + sedlay(i,j,ks ,iv)=sedlay(i,j,ks ,iv)-uebers + burial(i,j,iv)=burial(i,j,iv)+uebers*seddw(k)*porsol(i,j,k) + endif enddo !end i-loop - enddo !end j-loop -!$OMP END PARALLEL DO - -! determine how the total sediment column is filled - do k=1,ks -!$OMP PARALLEL DO PRIVATE(i,sedlo) - do j=1,kpje + enddo !end j-loop + !$OMP END PARALLEL DO + enddo !end iv-loop + + ! now the loading nowhere excceds 1 + + ! digging from below in case of erosion + ! UPWARD SHIFTING + ! shift solid sediment sediment upwards, if total sediment volume is less + ! than required, i.e., if the volume filled by the four constituents + ! poc, opal, caco3, claycik (integrated over total sediment column) + ! is less than porsol*seddw (integrated over total sediment column) + ! first, the last box is filled from below with total required volume; + ! then, successively, the following layers are filled upwards. + ! if there is not enough solid matter to fill the column, add clay. + + !$OMP PARALLEL DO PRIVATE(i) + do j=1,kpje + do i=1,kpie + fulsed(i,j)=0. + enddo !end i-loop + enddo !end j-loop + !$OMP END PARALLEL DO + + ! determine how the total sediment column is filled + do k=1,ks + !$OMP PARALLEL DO PRIVATE(i,sedlo) + do j=1,kpje do i=1,kpie if(omask(i,j).gt.0.5) then -!ka if(bolay(i,j).gt.0.) then + !ka if(bolay(i,j).gt.0.) then sedlo=orgfa*rcar*sedlay(i,j,k,issso12) & - & +calfa*sedlay(i,j,k,isssc12) & - & +oplfa*sedlay(i,j,k,issssil) & - & +clafa*sedlay(i,j,k,issster) + & +calfa*sedlay(i,j,k,isssc12) & + & +oplfa*sedlay(i,j,k,issssil) & + & +clafa*sedlay(i,j,k,issster) fulsed(i,j)=fulsed(i,j)+porsol(i,j,k)*seddw(k)*sedlo endif enddo !end i-loop - enddo !end j-loop -!$OMP END PARALLEL DO - enddo !end k-loop + enddo !end j-loop + !$OMP END PARALLEL DO + enddo !end k-loop -! shift the sediment deficiency from the deepest (burial) -! layer into layer ks -!$OMP PARALLEL DO & -!$OMP&PRIVATE(i,seddef,spresent,buried,refill,frac) - do j=1,kpje - do i=1,kpie + ! shift the sediment deficiency from the deepest (burial) + ! layer into layer ks + !$OMP PARALLEL DO & + !$OMP&PRIVATE(i,seddef,spresent,buried,refill,frac) + do j=1,kpje + do i=1,kpie if(omask(i,j).gt.0.5) then -!ka if(bolay(i,j).gt.0.) then + !ka if(bolay(i,j).gt.0.) then -! deficiency to fully loaded sediment packed in sedlay(i,j,ks) -! this is the volume required from the buried layer + ! deficiency to fully loaded sediment packed in sedlay(i,j,ks) + ! this is the volume required from the buried layer seddef=solfu(i,j)-fulsed(i,j) -! total volume of solid constituents in buried layer + ! total volume of solid constituents in buried layer spresent=orgfa*rcar*burial(i,j,issso12) & - & +calfa*burial(i,j,isssc12) & - & +oplfa*burial(i,j,issssil) & - & +clafa*burial(i,j,issster) + & +calfa*burial(i,j,isssc12) & + & +oplfa*burial(i,j,issssil) & + & +clafa*burial(i,j,issster) -! determine whether an additional amount of clay is needed in the burial -! layer to fill the whole sediment; I assume that there is an infinite -! supply of clay from below + ! determine whether an additional amount of clay is needed in the burial + ! layer to fill the whole sediment; I assume that there is an infinite + ! supply of clay from below burial(i,j,issster) = burial(i,j,issster) & - & + MAX(0.,seddef-spresent)/clafa + & + MAX(0.,seddef-spresent)/clafa -! determine new volume of buried layer + ! determine new volume of buried layer buried=orgfa*rcar*burial(i,j,issso12) & - & +calfa*burial(i,j,isssc12) & - & +oplfa*burial(i,j,issssil) & - & +clafa*burial(i,j,issster) + & +calfa*burial(i,j,isssc12) & + & +oplfa*burial(i,j,issssil) & + & +clafa*burial(i,j,issster) -! fill the last active layer - refill=seddef/(buried+1.e-10) + ! fill the last active layer + refill=seddef/(buried+1.e-10) frac = porsol(i,j,ks)*seddw(ks) - + sedlay(i,j,ks,issso12)=sedlay(i,j,ks,issso12) & - & +refill*burial(i,j,issso12)/frac + & +refill*burial(i,j,issso12)/frac sedlay(i,j,ks,isssc12)=sedlay(i,j,ks,isssc12) & - & +refill*burial(i,j,isssc12)/frac + & +refill*burial(i,j,isssc12)/frac sedlay(i,j,ks,issssil)=sedlay(i,j,ks,issssil) & - & +refill*burial(i,j,issssil)/frac + & +refill*burial(i,j,issssil)/frac sedlay(i,j,ks,issster)=sedlay(i,j,ks,issster) & - & +refill*burial(i,j,issster)/frac + & +refill*burial(i,j,issster)/frac 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 + 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 -! account for losses in buried sediment + ! account for losses in buried sediment burial(i,j,issso12) = burial(i,j,issso12) & - & - refill*burial(i,j,issso12) + & - refill*burial(i,j,issso12) burial(i,j,isssc12) = burial(i,j,isssc12) & - & - refill*burial(i,j,isssc12) + & - refill*burial(i,j,isssc12) burial(i,j,issssil) = burial(i,j,issssil) & - & - refill*burial(i,j,issssil) + & - refill*burial(i,j,issssil) burial(i,j,issster) = burial(i,j,issster) & - & - refill*burial(i,j,issster) + & - refill*burial(i,j,issster) 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) + 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 endif - enddo !end i-loop - enddo !end j-loop -!$OMP END PARALLEL DO + enddo !end i-loop + enddo !end j-loop + !$OMP END PARALLEL DO -! redistribute overload of layer ks - do k=ks,2,-1 -!$OMP PARALLEL DO PRIVATE(i,sedlo) - do j=1,kpje + ! redistribute overload of layer ks + do k=ks,2,-1 + !$OMP PARALLEL DO PRIVATE(i,sedlo) + do j=1,kpje do i=1,kpie if(omask(i,j).gt.0.5) then -!ka if(bolay(i,j).gt.0.) then + !ka if(bolay(i,j).gt.0.) then sedlo=orgfa*rcar*sedlay(i,j,k,issso12) & - & +calfa*sedlay(i,j,k,isssc12) & - & +oplfa*sedlay(i,j,k,issssil) & - & +clafa*sedlay(i,j,k,issster) + & +calfa*sedlay(i,j,k,isssc12) & + & +oplfa*sedlay(i,j,k,issssil) & + & +clafa*sedlay(i,j,k,issster) wsed(i,j)=max(0.,(sedlo-1.)/(sedlo+1.e-10)) endif enddo !end i-loop - enddo !end j-loop -!$OMP END PARALLEL DO + enddo !end j-loop + !$OMP END PARALLEL DO - do iv=1,nsedtra -!$OMP PARALLEL DO PRIVATE(i,uebers,frac) + do iv=1,nsedtra + !$OMP PARALLEL DO PRIVATE(i,uebers,frac) do j=1,kpje - do i=1,kpie - if(omask(i,j).gt.0.5) then -!ka if(bolay(i,j).gt.0.) then - uebers=sedlay(i,j,k,iv)*wsed(i,j) - frac=porsol(i,j,k)*seddw(k)/(porsol(i,j,k-1)*seddw(k-1)) - sedlay(i,j,k,iv)=sedlay(i,j,k,iv)-uebers - sedlay(i,j,k-1,iv)=sedlay(i,j,k-1,iv)+uebers*frac - endif - enddo !end i-loop + do i=1,kpie + if(omask(i,j).gt.0.5) then + !ka if(bolay(i,j).gt.0.) then + uebers=sedlay(i,j,k,iv)*wsed(i,j) + frac=porsol(i,j,k)*seddw(k)/(porsol(i,j,k-1)*seddw(k-1)) + sedlay(i,j,k,iv)=sedlay(i,j,k,iv)-uebers + sedlay(i,j,k-1,iv)=sedlay(i,j,k-1,iv)+uebers*frac + endif + enddo !end i-loop enddo !end j-loop -!$OMP END PARALLEL DO - enddo !end iv-loop + !$OMP END PARALLEL DO + enddo !end iv-loop - enddo !end k-loop + enddo !end k-loop - RETURN - END SUBROUTINE SEDSHI + RETURN +END SUBROUTINE SEDSHI diff --git a/hamocc/trc_limitc.F90 b/hamocc/trc_limitc.F90 index c3345237..ed268dcb 100644 --- a/hamocc/trc_limitc.F90 +++ b/hamocc/trc_limitc.F90 @@ -17,31 +17,31 @@ subroutine trc_limitc(nn) -!*********************************************************************** -! -!**** *SUBROUTINE trc_limitc* - remove negative tracer values. -! -! J. Schwinger *GFI, UiB initial version, 2014-06-17 -! - -! -! Modified -! -------- -! J.Schwinger, *Uni Research, Bergen* 2018-04-12 -! - fixed a bug related to the 2 time-level scheme -! -! -! -! Purpose -! ------- -! Remove negative tracer values in the first layer in a mass -! conservative fashion (i.e. the mass deficit removed is -! transfered to non-negative points by a multiplicative -! correction). This is done since the virtual tracer fluxes -! (applied in mxlayr.F directly before HAMOCC is called) can -! cause negative tracer values in regions with low concentration -! and strong precipitation. -! -!*********************************************************************** + !*********************************************************************** + ! + !**** *SUBROUTINE trc_limitc* - remove negative tracer values. + ! + ! J. Schwinger *GFI, UiB initial version, 2014-06-17 + ! - + ! + ! Modified + ! -------- + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - fixed a bug related to the 2 time-level scheme + ! + ! + ! + ! Purpose + ! ------- + ! Remove negative tracer values in the first layer in a mass + ! conservative fashion (i.e. the mass deficit removed is + ! transfered to non-negative points by a multiplicative + ! correction). This is done since the virtual tracer fluxes + ! (applied in mxlayr.F directly before HAMOCC is called) can + ! cause negative tracer values in regions with low concentration + ! and strong precipitation. + ! + !*********************************************************************** use mod_xc, only: ii,jj,ips,ifp,isp,ilp,xcsum use mod_grid, only: scp2 use mod_state, only: dp @@ -62,19 +62,19 @@ subroutine trc_limitc(nn) do nt=1,ntrbgc - util1(:,:)=0. + util1(:,:)=0. -!$OMP PARALLEL DO PRIVATE(l,i) - do j=1,jj - do l=1,isp(j) + !$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)) - util1(i,j) = util1(i,j)+trc(i,j,kn,itrbgc+nt-1)*dp(i,j,kn)*scp2(i,j) - enddo + util1(i,j) = util1(i,j)+trc(i,j,kn,itrbgc+nt-1)*dp(i,j,kn)*scp2(i,j) enddo - enddo -!$OMP END PARALLEL DO + enddo + enddo + !$OMP END PARALLEL DO - call xcsum(trbudo(nt),util1,ips) + call xcsum(trbudo(nt),util1,ips) enddo @@ -82,17 +82,17 @@ subroutine trc_limitc(nn) ! --- - remove negative tracer values in the surface layer ! --- ------------------------------------------------------------------ -!$OMP PARALLEL DO PRIVATE(j,l,i) + !$OMP PARALLEL DO PRIVATE(j,l,i) do nt=itrbgc,itrbgc+ntrbgc-1 - do j=1,jj - do l=1,isp(j) + do j=1,jj + do l=1,isp(j) do i=max(1,ifp(j,l)),min(ii,ilp(j,l)) - trc(i,j,kn,nt) = max(trc(i,j,kn,nt),0.0) - enddo + trc(i,j,kn,nt) = max(trc(i,j,kn,nt),0.0) enddo - enddo + enddo + enddo enddo -!$OMP END PARALLEL DO + !$OMP END PARALLEL DO ! --- ------------------------------------------------------------------ ! --- - recalculate and correct tracer budgets @@ -100,30 +100,30 @@ subroutine trc_limitc(nn) do nt=1,ntrbgc - util1(:,:)=0. + util1(:,:)=0. -!$OMP PARALLEL DO PRIVATE(l,i) - do j=1,jj - do l=1,isp(j) + !$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)) - util1(i,j) = util1(i,j)+trc(i,j,kn,itrbgc+nt-1)*dp(i,j,kn)*scp2(i,j) + util1(i,j) = util1(i,j)+trc(i,j,kn,itrbgc+nt-1)*dp(i,j,kn)*scp2(i,j) enddo - enddo - enddo -!$OMP END PARALLEL DO + enddo + enddo + !$OMP END PARALLEL DO - call xcsum(trbudn,util1,ips) - q = trbudo(nt)/max(1.e-14,trbudn) + call xcsum(trbudn,util1,ips) + q = trbudo(nt)/max(1.e-14,trbudn) -!$OMP PARALLEL DO PRIVATE(l,i) - do j=1,jj - do l=1,isp(j) + !$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)) - trc(i,j,kn,itrbgc+nt-1) = trc(i,j,kn,itrbgc+nt-1)*q - enddo + trc(i,j,kn,itrbgc+nt-1) = trc(i,j,kn,itrbgc+nt-1)*q enddo - enddo -!$OMP END PARALLEL DO + enddo + enddo + !$OMP END PARALLEL DO enddo diff --git a/hamocc/write_netcdf_var.F90 b/hamocc/write_netcdf_var.F90 index d07eb4f5..bf6eeeae 100644 --- a/hamocc/write_netcdf_var.F90 +++ b/hamocc/write_netcdf_var.F90 @@ -3,187 +3,187 @@ ! 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 WRITE_NETCDF_VAR(ncid,desc,arr,klev,time) -!************************************************************************** -! -! Gathers a global variable from all PEs and writes it to a NETCDF file -! -! The NETCDF File is only accessed by mnproc=1 -! -!************************************************************************** - use netcdf, only: nf90_noerr,nf90_inq_varid,nf90_strerror,nf90_put_var - use mod_xc, only: itdm,jtdm,jdm,lp,mnproc,nbdy,idm,xchalt,xcaget - use mod_dia, only: iotype +SUBROUTINE WRITE_NETCDF_VAR(ncid,desc,arr,klev,time) + !************************************************************************** + ! + ! Gathers a global variable from all PEs and writes it to a NETCDF file + ! + ! The NETCDF File is only accessed by mnproc=1 + ! + !************************************************************************** + use netcdf, only: nf90_noerr,nf90_inq_varid,nf90_strerror,nf90_put_var + use mod_xc, only: itdm,jtdm,jdm,lp,mnproc,nbdy,idm,xchalt,xcaget + use mod_dia, only: iotype #ifdef PNETCDF - use mod_xc, only: i0,ii,jj,j0,mproc,mpe_1,nproc,xcgetrow + use mod_xc, only: i0,ii,jj,j0,mproc,mpe_1,nproc,xcgetrow #endif - implicit none + implicit none #ifdef PNETCDF # include # include #endif - integer ncid, klev, time, ndims - character (len=*) desc - real arr(idm,jdm,klev) + integer ncid, klev, time, ndims + character (len=*) desc + real arr(idm,jdm,klev) - real arr_g(itdm,jtdm) - real , allocatable :: arr_g1(:,:,:),arr_l(:,:,:) - integer ncstat,ncvarid,k,i,j - integer, allocatable :: start(:),count(:) + real arr_g(itdm,jtdm) + real , allocatable :: arr_g1(:,:,:),arr_l(:,:,:) + integer ncstat,ncvarid,k,i,j + integer, allocatable :: start(:),count(:) #ifdef PNETCDF - integer (kind=MPI_OFFSET_KIND), allocatable :: istart(:),icount(:) + integer (kind=MPI_OFFSET_KIND), allocatable :: istart(:),icount(:) #endif -! Write NETCDF data - - if (klev.eq.1.and.time.eq.0) then - ndims=2 - elseif (klev.eq.1.or.time.eq.0) then - ndims=3 + ! Write NETCDF data + + if (klev.eq.1.and.time.eq.0) then + ndims=2 + elseif (klev.eq.1.or.time.eq.0) then + ndims=3 + else + ndims=4 + endif + IF(IOTYPE==0) THEN + allocate(start(ndims)) + allocate(count(ndims)) + allocate(arr_l(1-nbdy:idm+nbdy,1-nbdy:jdm+nbdy,1)) + arr_l=0.0 + start(1)=1 + count(1)=itdm + start(2)=1 + count(2)=jtdm + if (klev.gt.1.or.time.gt.0) then + if (klev.gt.1.and.time.gt.0) then + start(3)=1 + count(3)=1 + start(4)=time + count(4)=1 + else if (klev.gt.1.and.time.eq.0) then + start(3)=1 + count(3)=1 else - ndims=4 - endif - IF(IOTYPE==0) THEN - allocate(start(ndims)) - allocate(count(ndims)) - allocate(arr_l(1-nbdy:idm+nbdy,1-nbdy:jdm+nbdy,1)) - arr_l=0.0 - start(1)=1 - count(1)=itdm - start(2)=1 - count(2)=jtdm - if (klev.gt.1.or.time.gt.0) then - if (klev.gt.1.and.time.gt.0) then - start(3)=1 - count(3)=1 - start(4)=time - count(4)=1 - else if (klev.gt.1.and.time.eq.0) then - start(3)=1 - count(3)=1 - else - start(3)=time - count(3)=1 - endif + start(3)=time + count(3)=1 endif + endif - do k=1,klev - do j=1,jdm - do i=1,idm - arr_l(i,j,1)=arr(i,j,k) - enddo + do k=1,klev + do j=1,jdm + do i=1,idm + arr_l(i,j,1)=arr(i,j,k) enddo - call xcaget(arr_g,arr_l,1) - if (mnproc.eq.1) then - if (k.gt.1) then - start(3)=k - count(3)=1 - endif - ncstat=nf90_inq_varid(ncid,desc,ncvarid) - if (ncstat.ne.nf90_noerr) then - write(lp,'(4a)') 'nf90_inq_varid: ',trim(desc),': ', & - & nf90_strerror(ncstat) - call xchalt('(write_netcdf_var)') - stop '(write_netcdf_var)' - endif - ncstat=nf90_put_var(ncid,ncvarid,arr_g,start,count) - if (ncstat.ne.nf90_noerr) then - write(lp,'(4a)') 'nf90_put_var: ',trim(desc),': ', & - & nf90_strerror(ncstat) - call xchalt('(write_netcdf_var)') - stop '(write_netcdf_var)' - endif -! ncstat=nf90_sync(ncid) -! if (ncstat.ne.nf90_noerr) then -! write(lp,'(4a)') 'nf90_sync: ',trim(desc),': ', & -! & nf90_strerror(ncstat) -! call xchalt('(write_netcdf_var)') -! stop '(write_netcdf_var)' -! endif - endif enddo - deallocate(start,count) - ELSE IF(IOTYPE==1) THEN -#ifdef PNETCDF - allocate(istart(ndims)) - allocate(icount(ndims)) - allocate(arr_l(ii,jj,klev)) - arr_l=0.0 - if (klev.gt.1.or.time.gt.0) then - if (klev.gt.1.and.time.gt.0) then - istart(3)=1 - icount(3)=klev - istart(4)=time - icount(4)=1 - else if (klev.gt.1.and.time.eq.0) then - istart(3)=1 - icount(3)=klev - else - istart(3)=time - icount(3)=1 + call xcaget(arr_g,arr_l,1) + if (mnproc.eq.1) then + if (k.gt.1) then + start(3)=k + count(3)=1 + endif + ncstat=nf90_inq_varid(ncid,desc,ncvarid) + if (ncstat.ne.nf90_noerr) then + write(lp,'(4a)') 'nf90_inq_varid: ',trim(desc),': ', & + & nf90_strerror(ncstat) + call xchalt('(write_netcdf_var)') + stop '(write_netcdf_var)' endif + ncstat=nf90_put_var(ncid,ncvarid,arr_g,start,count) + if (ncstat.ne.nf90_noerr) then + write(lp,'(4a)') 'nf90_put_var: ',trim(desc),': ', & + & nf90_strerror(ncstat) + call xchalt('(write_netcdf_var)') + stop '(write_netcdf_var)' + endif + ! ncstat=nf90_sync(ncid) + ! if (ncstat.ne.nf90_noerr) then + ! write(lp,'(4a)') 'nf90_sync: ',trim(desc),': ', & + ! & nf90_strerror(ncstat) + ! call xchalt('(write_netcdf_var)') + ! stop '(write_netcdf_var)' + ! endif + endif + enddo + deallocate(start,count) + ELSE IF(IOTYPE==1) THEN +#ifdef PNETCDF + allocate(istart(ndims)) + allocate(icount(ndims)) + allocate(arr_l(ii,jj,klev)) + arr_l=0.0 + if (klev.gt.1.or.time.gt.0) then + if (klev.gt.1.and.time.gt.0) then + istart(3)=1 + icount(3)=klev + istart(4)=time + icount(4)=1 + else if (klev.gt.1.and.time.eq.0) then + istart(3)=1 + icount(3)=klev + else + istart(3)=time + icount(3)=1 endif + endif - istart(1)=1 - istart(2)=j0+1 + istart(1)=1 + istart(2)=j0+1 - if(mproc .eq. mpe_1(nproc) ) then + if(mproc .eq. mpe_1(nproc) ) then icount(1)=itdm icount(2)=jj - else + else do i=1,ndims - icount(i)=0 + icount(i)=0 enddo - endif + endif - do k=1,klev - do j=1,jj - do i=1,ii - arr_l(i,j,k)=arr(i,j,k) - enddo + do k=1,klev + do j=1,jj + do i=1,ii + arr_l(i,j,k)=arr(i,j,k) enddo - enddo - allocate(arr_g1(itdm,jj,klev)) - arr_g1=0.0 - call xcgetrow(arr_g1, arr_l, klev) + enddo + enddo + allocate(arr_g1(itdm,jj,klev)) + arr_g1=0.0 + call xcgetrow(arr_g1, arr_l, klev) - ncstat=nfmpi_inq_varid(ncid,desc,ncvarid) - if (ncstat.ne.nf_noerr) then - write(lp,'(4a)') 'nfmpi_inq_varid: ',trim(desc),': ', & - & nfmpi_strerror(ncstat) - call xchalt('(write_pnetcdf_var)') - stop '(write_pnetcdf_var)' - endif - ncstat=nfmpi_put_vara_double_all(ncid,ncvarid,istart, & - & icount,arr_g1) - if (ncstat.ne.nf_noerr) then - write(lp,'(4a)') 'nfmpi_put_var: ',trim(desc),': ', & - & nfmpi_strerror(ncstat) - call xchalt('(write_pnetcdf_var)') - stop '(write_pnetcdf_var)' - endif -! ncstat=nfmpi_sync(ncid) -! if (ncstat.ne.nf_noerr) then -! write(lp,'(4a)') 'nfmpi_sync: ',trim(desc),': ', & -! & nfmpi_strerror(ncstat) -! call xchalt('(write_pnetcdf_var)') -! stop '(write_pnetcdf_var)' -! endif + ncstat=nfmpi_inq_varid(ncid,desc,ncvarid) + if (ncstat.ne.nf_noerr) then + write(lp,'(4a)') 'nfmpi_inq_varid: ',trim(desc),': ', & + & nfmpi_strerror(ncstat) + call xchalt('(write_pnetcdf_var)') + stop '(write_pnetcdf_var)' + endif + ncstat=nfmpi_put_vara_double_all(ncid,ncvarid,istart, & + & icount,arr_g1) + if (ncstat.ne.nf_noerr) then + write(lp,'(4a)') 'nfmpi_put_var: ',trim(desc),': ', & + & nfmpi_strerror(ncstat) + call xchalt('(write_pnetcdf_var)') + stop '(write_pnetcdf_var)' + endif + ! ncstat=nfmpi_sync(ncid) + ! if (ncstat.ne.nf_noerr) then + ! write(lp,'(4a)') 'nfmpi_sync: ',trim(desc),': ', & + ! & nfmpi_strerror(ncstat) + ! call xchalt('(write_pnetcdf_var)') + ! stop '(write_pnetcdf_var)' + ! endif - deallocate(istart,icount,arr_g1) + deallocate(istart,icount,arr_g1) #endif - ENDIF + ENDIF - END +END SUBROUTINE WRITE_NETCDF_VAR From 7091e176e17793a058e931172049788fe59880da Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 6 Nov 2023 16:21:38 +0100 Subject: [PATCH 2/5] moved carchm_kequi, carchm_solve and carchm_solve_DICsat into carchm --- hamocc/carchm.F90 | 1494 ++++++++++++++++++++++++++++----------------- 1 file changed, 932 insertions(+), 562 deletions(-) diff --git a/hamocc/carchm.F90 b/hamocc/carchm.F90 index 9862a504..9844982c 100644 --- a/hamocc/carchm.F90 +++ b/hamocc/carchm.F90 @@ -17,610 +17,980 @@ ! 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 CARCHM(kpie,kpje,kpke,kbnd, & - pdlxp,pdlyp,pddpo,prho,pglat,omask, & - psicomo,ppao,pfu10,ptho,psao) - - !****************************************************************************** - ! - !**** *CARCHM* - . - ! - ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 - ! - ! Modified - ! -------- - ! S.Legutke, *MPI-MaD, HH* 10.04.01 - ! - rename: ssso12(i,j,k)=sedlay(i,j,k,issso12 ) etc.; no equivalence statements - ! - rename: powasi(i,j,k )=powtra(i,j,1,ipowasi) etc.; no equivalence statements - ! - interfacing with ocean model - ! - ! J.Tjiputra, *BCCR* 09.18.08 - ! - modified all carbon chemistry formulations following the OCMIP protocols - ! - ! J.Schwinger, *GFI, UiB* 2013-04-22 - ! - Use density prho consistent with MICOM for conversion to mol/kg - ! - Calculate solubility of O2 and N2 every timestep, consistent with - ! what is done for carbon chemistry. Array chemcm not used any more. - ! - Added J.Tjiputras code for cfc- and sf6-fluxes - ! - Cautious code clean-up - ! - ! J.Schwinger, *UNI-RESEARCH* 2017-08-30 - ! - Moved the accumulation of global fields for output to routine - ! hamocc4bgc. - ! - ! A.Moree, *GFI, Bergen* 2018-04-12 - ! - new version of carbon isotope code - ! - ! J.Tjiputra, *Uni Research, Bergen* 2018-04-12 - ! - added preformed and saturated DIC tracers - ! - ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 - ! - moved accumulation of all output fields to seperate subroutine, - ! related code-restructuring - ! - dissolution of CaCO3 moved into main loop - ! - added sediment bypass preprocessor option - ! - ! Purpose - ! ------- - ! Inorganic carbon cycle. - ! - ! Method - ! ------- - ! Surface fluxes of CO2 / N2O / dms - ! Dissolution of calcium - ! - ! - !**** Parameter list: - ! --------------- - ! - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. - ! *INTEGER* *kbnd* - nb of halo grid points - ! *REAL* *pdlxp* - size of scalar grid cell (1st dimension) [m]. - ! *REAL* *pdlyp* - size of scalar grid cell (2nd dimension) [m]. - ! *REAL* *pddpo* - size of scalar grid cell (3rd dimension) [m]. - ! *REAL* *prho* - density [g/cm^3]. - ! *REAL* *pglat* - latitude of grid cells [deg north]. - ! *REAL* *omask* - ocean mask. - ! *REAL* *psicomo* - sea ice. - ! *REAL* *ppao* - sea level presure [Pascal]. - ! *REAL* *pfu10* - forcing field wind speed. - ! *REAL* *ptho* - potential temperature. - ! *REAL* *psao* - salinity [psu]. - ! - ! Externals - ! --------- - ! none. - ! - !********************************************************************** - 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,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, & - 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_param_bgc, only: c14dec,atm_co2_nat - use mo_vgrid, only: dp_min,kmle,kbo,ptiestu - 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, & - nathi,natco3,natpco2d,natomegaa,natomegac - use mo_sedmnt, only: sedlay,powtra,burial +MODULE MO_CARCHM implicit none - - INTEGER, intent(in) :: kpie,kpje,kpke,kbnd - REAL, intent(in) :: pdlxp(kpie,kpje) - REAL, intent(in) :: pdlyp(kpie,kpje) - REAL, intent(in) :: pddpo(kpie,kpje,kpke) - REAL, intent(in) :: prho(kpie,kpje,kpke) - REAL, intent(in) :: pglat(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - REAL, intent(in) :: omask(kpie,kpje) - REAL, intent(in) :: psicomo(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - REAL, intent(in) :: ppao(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - REAL, intent(in) :: pfu10(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - REAL, intent(in) :: ptho(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) - REAL, intent(in) :: psao(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) - - ! 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 - REAL :: scco2,sco2,scn2,scdms,scn2o - REAL :: Xconvxa - REAL :: oxflux,niflux,dmsflux,n2oflux - REAL :: ato2,atn2,atco2,pco2 - REAL :: oxy,ani,anisa - REAL :: rrho,t,t2,t3,t4,tk,tk100,prb,s,rs - 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 - 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. - pco2d (:,:)=0. - pco2m (:,:)=0. - kwco2d (:,:)=0. - co2sold (:,:)=0. - co2solm (:,:)=0. - kwco2sol (:,:)=0. - co2star(:,:,:)=0. - co3 (:,:,:)=0. - satoxy (:,:,:)=0. - omegaA (:,:,:)=0. - omegaC (:,:,:)=0. - if (use_cisonew) then - co213fxd (:,:)=0. - co213fxu (:,:)=0. - co214fxd (:,:)=0. - co214fxu (:,:)=0. - endif - if (use_natDIC) then - natpco2d (:,:)=0. - natco3 (:,:,:)=0. - natomegaA(:,:,:)=0. - natomegaC(:,:,:)=0. - endif - - !$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 & - !$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 & - !$OMP ,natcu,natcb,natcc,natpco2,natfluxd,natfluxu,natomega & - !$OMP ,natsupsat,natundsa,natdissol & - !$OMP ,atco213,atco214,rco213,rco214,pco213,pco214,frac_aqg & - !$OMP ,frac_dicg,flux13d,flux13u,flux14d,flux14u,dissol13,dissol14 & - !$OMP ,flx_bromo,sch_bromo,kw_bromo,a_bromo,atbrf,Kb1,lsub & - !$OMP ,j,i) - 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 - - ! Carbon chemistry: Calculate equilibrium constants and solve for [H+] and - ! carbonate alkalinity (ac) - t = min(40.,max(-3.,ptho(i,j,k))) - t2 = t**2 - t3 = t**3 - t4 = t**4 - tk = t + tzero - tk100= tk/100.0 - s = min(40.,max( 25.,psao(i,j,k))) - rrho = prho(i,j,k) ! seawater density [g/cm3] - prb = ptiestu(i,j,k)*98060*1.027e-6 ! pressure in unit bars, 98060 = onem - - tc = ocetra(i,j,k,isco212) / rrho ! convert to mol/kg - ta = ocetra(i,j,k,ialkali) / rrho - sit = ocetra(i,j,k,isilica) / rrho - pt = ocetra(i,j,k,iphosph) / rrho - ah1 = hi(i,j,k) - - CALL CARCHM_KEQUI(t,s,prb,Kh,Khd,K1,K2,Kb,Kw,Ks1,Kf,Ksi, & - K1p,K2p,K3p,Kspc,Kspa) - - 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 - hi(i,j,k)=max(1.e-20,ah1) - endif - - ! Determine CO2*, HCO3- and CO3-- concentrations (in mol/kg soln) - cu = ( 2. * tc - ac ) / ( 2. + K1 / ah1 ) - cb = K1 * cu / ah1 - cc = K2 * cb / ah1 - co2star(i,j,k)=cu - - ! Carbonate ion concentration, convert from mol/kg to kmol/m^3 - co3(i,j,k) = cc * rrho - - 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) + private + + public :: CARCHM + private :: CARCHM_KEQUI + private :: CARCHM_SOLVE + private :: CARCHM_SOLVE_DICSAT + +CONTAINS + + SUBROUTINE CARCHM(kpie,kpje,kpke,kbnd, & + pdlxp,pdlyp,pddpo,prho,pglat,omask, & + psicomo,ppao,pfu10,ptho,psao) + + !****************************************************************************** + ! + !**** *CARCHM* - . + ! + ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 + ! + ! Modified + ! -------- + ! S.Legutke, *MPI-MaD, HH* 10.04.01 + ! - rename: ssso12(i,j,k)=sedlay(i,j,k,issso12 ) etc.; no equivalence statements + ! - rename: powasi(i,j,k )=powtra(i,j,1,ipowasi) etc.; no equivalence statements + ! - interfacing with ocean model + ! + ! J.Tjiputra, *BCCR* 09.18.08 + ! - modified all carbon chemistry formulations following the OCMIP protocols + ! + ! J.Schwinger, *GFI, UiB* 2013-04-22 + ! - Use density prho consistent with MICOM for conversion to mol/kg + ! - Calculate solubility of O2 and N2 every timestep, consistent with + ! what is done for carbon chemistry. Array chemcm not used any more. + ! - Added J.Tjiputras code for cfc- and sf6-fluxes + ! - Cautious code clean-up + ! + ! J.Schwinger, *UNI-RESEARCH* 2017-08-30 + ! - Moved the accumulation of global fields for output to routine + ! hamocc4bgc. + ! + ! A.Moree, *GFI, Bergen* 2018-04-12 + ! - new version of carbon isotope code + ! + ! J.Tjiputra, *Uni Research, Bergen* 2018-04-12 + ! - added preformed and saturated DIC tracers + ! + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - moved accumulation of all output fields to seperate subroutine, + ! related code-restructuring + ! - dissolution of CaCO3 moved into main loop + ! - added sediment bypass preprocessor option + ! + ! Purpose + ! ------- + ! Inorganic carbon cycle. + ! + ! Method + ! ------- + ! Surface fluxes of CO2 / N2O / dms + ! Dissolution of calcium + ! + ! + !**** Parameter list: + ! --------------- + ! + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. + ! *INTEGER* *kbnd* - nb of halo grid points + ! *REAL* *pdlxp* - size of scalar grid cell (1st dimension) [m]. + ! *REAL* *pdlyp* - size of scalar grid cell (2nd dimension) [m]. + ! *REAL* *pddpo* - size of scalar grid cell (3rd dimension) [m]. + ! *REAL* *prho* - density [g/cm^3]. + ! *REAL* *pglat* - latitude of grid cells [deg north]. + ! *REAL* *omask* - ocean mask. + ! *REAL* *psicomo* - sea ice. + ! *REAL* *ppao* - sea level presure [Pascal]. + ! *REAL* *pfu10* - forcing field wind speed. + ! *REAL* *ptho* - potential temperature. + ! *REAL* *psao* - salinity [psu]. + ! + ! Externals + ! --------- + ! none. + ! + !********************************************************************** + 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,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, & + 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_param_bgc, only: c14dec,atm_co2_nat + use mo_vgrid, only: dp_min,kmle,kbo,ptiestu + 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, & + nathi,natco3,natpco2d,natomegaa,natomegac + use mo_sedmnt, only: sedlay,powtra,burial + + implicit none + + INTEGER, intent(in) :: kpie,kpje,kpke,kbnd + REAL, intent(in) :: pdlxp(kpie,kpje) + REAL, intent(in) :: pdlyp(kpie,kpje) + REAL, intent(in) :: pddpo(kpie,kpje,kpke) + REAL, intent(in) :: prho(kpie,kpje,kpke) + REAL, intent(in) :: pglat(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) + REAL, intent(in) :: omask(kpie,kpje) + REAL, intent(in) :: psicomo(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) + REAL, intent(in) :: ppao(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) + REAL, intent(in) :: pfu10(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) + REAL, intent(in) :: ptho(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) + REAL, intent(in) :: psao(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) + + ! 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 + REAL :: scco2,sco2,scn2,scdms,scn2o + REAL :: Xconvxa + REAL :: oxflux,niflux,dmsflux,n2oflux + REAL :: ato2,atn2,atco2,pco2 + REAL :: oxy,ani,anisa + REAL :: rrho,t,t2,t3,t4,tk,tk100,prb,s,rs + 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 + 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. + pco2d (:,:)=0. + pco2m (:,:)=0. + kwco2d (:,:)=0. + co2sold (:,:)=0. + co2solm (:,:)=0. + kwco2sol (:,:)=0. + co2star(:,:,:)=0. + co3 (:,:,:)=0. + satoxy (:,:,:)=0. + omegaA (:,:,:)=0. + omegaC (:,:,:)=0. + if (use_cisonew) then + co213fxd (:,:)=0. + co213fxu (:,:)=0. + co214fxd (:,:)=0. + co214fxu (:,:)=0. + endif + if (use_natDIC) then + natpco2d (:,:)=0. + natco3 (:,:,:)=0. + natomegaA(:,:,:)=0. + natomegaC(:,:,:)=0. + endif + + !$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 & + !$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 & + !$OMP ,natcu,natcb,natcc,natpco2,natfluxd,natfluxu,natomega & + !$OMP ,natsupsat,natundsa,natdissol & + !$OMP ,atco213,atco214,rco213,rco214,pco213,pco214,frac_aqg & + !$OMP ,frac_dicg,flux13d,flux13u,flux14d,flux14u,dissol13,dissol14 & + !$OMP ,flx_bromo,sch_bromo,kw_bromo,a_bromo,atbrf,Kb1,lsub & + !$OMP ,j,i) + 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 + + ! Carbon chemistry: Calculate equilibrium constants and solve for [H+] and + ! carbonate alkalinity (ac) + t = min(40.,max(-3.,ptho(i,j,k))) + t2 = t**2 + t3 = t**3 + t4 = t**4 + tk = t + tzero + tk100= tk/100.0 + s = min(40.,max( 25.,psao(i,j,k))) + rrho = prho(i,j,k) ! seawater density [g/cm3] + prb = ptiestu(i,j,k)*98060*1.027e-6 ! pressure in unit bars, 98060 = onem + + tc = ocetra(i,j,k,isco212) / rrho ! convert to mol/kg + ta = ocetra(i,j,k,ialkali) / rrho + sit = ocetra(i,j,k,isilica) / rrho + pt = ocetra(i,j,k,iphosph) / rrho + ah1 = hi(i,j,k) + + CALL CARCHM_KEQUI(t,s,prb,Kh,Khd,K1,K2,Kb,Kw,Ks1,Kf,Ksi, & + K1p,K2p,K3p,Kspc,Kspa) 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) + hi(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 CO2*, HCO3- and CO3-- concentrations (in mol/kg soln) + cu = ( 2. * tc - ac ) / ( 2. + K1 / ah1 ) + cb = K1 * cu / ah1 + cc = K2 * cb / ah1 + co2star(i,j,k)=cu - ! 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 - oxy=ox0+ox1/tk100+ox2*alog(tk100)+ox3*tk100+s*(ox4+ox5*tk100+ox6*tk100**2) - satoxy(i,j,k)=exp(oxy)*oxyco + ! Carbonate ion concentration, convert from mol/kg to kmol/m^3 + co3(i,j,k) = cc * rrho - if (k.eq.1) then - ! Determine CO2 pressure and fugacity (in micoatm) - ! NOTE: equation below for pCO2 needs requires CO2 in mol/kg - pco2 = cu * 1.e6 / Kh if (use_natDIC) then - natpco2 = natcu * 1.e6 / Kh + 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) + + 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 - - ! Schmidt numbers according to Wanninkhof (2014), Table 1 - scco2 = 2116.8 - 136.25*t + 4.7353*t2 - 0.092307*t3 + 0.0007555 *t4 - sco2 = 1920.4 - 135.6 *t + 5.2122*t2 - 0.10939 *t3 + 0.00093777*t4 - 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 - 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 - endif - 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 - endif - - ! solubility of N2 (Weiss, R.F. 1970, Deep-Sea Res., 17, 721-735) for moist air + ! 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 - ani=an0+an1/tk100+an2*alog(tk100)+an3*tk100+s*(an4+an5*tk100+an6*tk100**2) - anisa=exp(ani)*oxyco - - ! solubility of laughing gas (Weiss and Price 1980, Marine Chemistry, 8, 347-359) - ! for moist air at 1 atm in kmol/m^3/atm - rs=al1+al2/tk100+al3*log(tk100)+al4*tk100**2+s*(bl1+bl2*tk100+bl3*tk100**2) - satn2o(i,j)=exp(rs) - - 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 - 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 + oxy=ox0+ox1/tk100+ox2*alog(tk100)+ox3*tk100+s*(ox4+ox5*tk100+ox6*tk100**2) + satoxy(i,j,k)=exp(oxy)*oxyco + + if (k.eq.1) then + ! Determine CO2 pressure and fugacity (in micoatm) + ! NOTE: equation below for pCO2 needs requires CO2 in mol/kg + pco2 = cu * 1.e6 / Kh + if (use_natDIC) then + natpco2 = natcu * 1.e6 / Kh + endif + + + ! Schmidt numbers according to Wanninkhof (2014), Table 1 + scco2 = 2116.8 - 136.25*t + 4.7353*t2 - 0.092307*t3 + 0.0007555 *t4 + sco2 = 1920.4 - 135.6 *t + 5.2122*t2 - 0.10939 *t3 + 0.00093777*t4 + 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 + 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 + endif + 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 + endif + + ! 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 + ani=an0+an1/tk100+an2*alog(tk100)+an3*tk100+s*(an4+an5*tk100+an6*tk100**2) + anisa=exp(ani)*oxyco + + ! solubility of laughing gas (Weiss and Price 1980, Marine Chemistry, 8, 347-359) + ! for moist air at 1 atm in kmol/m^3/atm + rs=al1+al2/tk100+al3*log(tk100)+al4*tk100**2+s*(bl1+bl2*tk100+bl3*tk100**2) + satn2o(i,j)=exp(rs) + + 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 + 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 + + ! 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 + kwco2 = (1.-psicomo(i,j)) * Xconvxa * pfu10(i,j)**2*(660./scco2)**0.5 + kwo2 = (1.-psicomo(i,j)) * Xconvxa * pfu10(i,j)**2*(660./sco2)**0.5 + 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 + 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 + endif + 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 + + atco2 = atm(i,j,iatmco2) + ato2 = atm(i,j,iatmo2) + atn2 = atm(i,j,iatmn2) + if (use_cisonew) then + atco213 = atm(i,j,iatmc13) + atco214 = atm(i,j,iatmc14) + endif + if (use_BROMO) then + atbrf = atm(i,j,iatmbromo) + endif + + ! 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 + ! mixing ratio (i.e. partial presure = mixing ratio*SLP/P_0 [atm]) + rpp0 = ppao(i,j)/101325.0 + + fluxd=atco2*rpp0*kwco2*dtbgc*Kh*1e-6*rrho ! Kh is in mol/kg/atm. Multiply by rrho (g/cm^3) + 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)) + 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)) + endif + + ! Calculate saturation DIC concentration in mixed layer + ta = ocetra(i,j,k,ialkali) / rrho + CALL carchm_solve_DICsat(s,atco2*rpp0,ta,sit,pt,Kh,K1,K2,Kb,Kw,Ks1,Kf, & + 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 + + 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 + + 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 + + ! Update DIC + ocetra(i,j,1,isco212)=ocetra(i,j,1,isco212)+(fluxd-fluxu)/pddpo(i,j,1) + if (use_natDIC) then + ocetra(i,j,1,inatsco212)=ocetra(i,j,1,inatsco212)+(natfluxd-natfluxu)/pddpo(i,j,1) + endif + 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) + endif + + ! Surface flux of oxygen + oxflux=kwo2*dtbgc*(ocetra(i,j,1,ioxygen)-satoxy(i,j,1)*(ato2/196800)*rpp0) + ocetra(i,j,1,ioxygen)=ocetra(i,j,1,ioxygen)-oxflux/pddpo(i,j,1) + ! Surface flux of gaseous nitrogen (same piston velocity as for O2) + niflux=kwn2*dtbgc*(ocetra(i,j,1,igasnit)-anisa*(atn2/802000)*rpp0) + ocetra(i,j,1,igasnit)=ocetra(i,j,1,igasnit)-niflux/pddpo(i,j,1) + ! 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) + 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)) + ! flx12=kw_12*(a_12*cfc12_atm(i,j)*ppair/p0-trc(i,j,1,2)) + ! 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 + + ! 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) + ! 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) + ! 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 + + ! Surface flux of dms + ! 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) + atmflx(i,j,iatmbromo) = -flx_bromo + endif + + ! Save surface fluxes + atmflx(i,j,iatmco2)=fluxu-fluxd + atmflx(i,j,iatmo2)=oxflux + atmflx(i,j,iatmn2)=niflux + atmflx(i,j,iatmn2o)=n2oflux + if (use_cisonew) then + atmflx(i,j,iatmc13)=flux13u-flux13d + atmflx(i,j,iatmc14)=flux14u-flux14d + endif + if (use_CFC) then + atmflx(i,j,iatmf11)=flx11 + atmflx(i,j,iatmf12)=flx12 + atmflx(i,j,iatmsf6)=flxsf + endif + if (use_natDIC) then + atmflx(i,j,iatmnco2)=natfluxu-natfluxd + endif + + ! Save up- and downward components of carbon fluxes for output + co2fxd(i,j) = fluxd + co2fxu(i,j) = fluxu + if (use_cisonew) then + co213fxd(i,j)= flux13d + co213fxu(i,j)= flux13u + co214fxd(i,j)= flux14d + co214fxu(i,j)= flux14u + endif + + ! 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 + if (use_natDIC) then + natpco2d(i,j) = natcu * 1.e6 / Khd + endif + + ! Save product of piston velocity and solubility for output + kwco2sol(i,j) = kwco2*Kh*1e-6 !m/s mol/kg/muatm + kwco2d(i,j) = kwco2 ! m/s (incl. ice fraction!) + co2sold(i,j) = Khd ! mol/kg/atm + co2solm(i,j) = Kh ! mol/kg/atm + + endif ! k==1 - ! 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 - kwco2 = (1.-psicomo(i,j)) * Xconvxa * pfu10(i,j)**2*(660./scco2)**0.5 - kwo2 = (1.-psicomo(i,j)) * Xconvxa * pfu10(i,j)**2*(660./sco2)**0.5 - 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 - 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 - endif 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 - - atco2 = atm(i,j,iatmco2) - ato2 = atm(i,j,iatmo2) - atn2 = atm(i,j,iatmn2) - if (use_cisonew) then - atco213 = atm(i,j,iatmc13) - atco214 = atm(i,j,iatmc14) + ! 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)) + ! 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 - if (use_BROMO) then - atbrf = atm(i,j,iatmbromo) - endif - - ! 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 - ! mixing ratio (i.e. partial presure = mixing ratio*SLP/P_0 [atm]) - rpp0 = ppao(i,j)/101325.0 - - fluxd=atco2*rpp0*kwco2*dtbgc*Kh*1e-6*rrho ! Kh is in mol/kg/atm. Multiply by rrho (g/cm^3) - 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)) + ! ----------------------------------------------------------------- + ! Deep ocean processes + + ! Determine Omega Calcite/Aragonite and dissolution of caco3 based on OmegaC: + ! omegaC=([CO3]*[Ca])/([CO3]sat*[Ca]sat) + ! Following Sarmiento and Gruber book, assumed that [Ca]=[Ca]sat + ! Thus, [CO3]sat=[CO3]/OmegaC. + omega = ( calcon * s / 35. ) * cc + OmegaA(i,j,k) = omega / Kspa + OmegaC(i,j,k) = omega / Kspc + 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)) 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)) + 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 - - ! Calculate saturation DIC concentration in mixed layer - ta = ocetra(i,j,k,ialkali) / rrho - CALL carchm_solve_DICsat(s,atco2*rpp0,ta,sit,pt,Kh,K1,K2,Kb,Kw,Ks1,Kf, & - 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 - - 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 - - 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) + 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) endif - - ! Update DIC - ocetra(i,j,1,isco212)=ocetra(i,j,1,isco212)+(fluxd-fluxu)/pddpo(i,j,1) + 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 if (use_natDIC) then - ocetra(i,j,1,inatsco212)=ocetra(i,j,1,inatsco212)+(natfluxd-natfluxu)/pddpo(i,j,1) + 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 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) + 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 - ! Surface flux of oxygen - oxflux=kwo2*dtbgc*(ocetra(i,j,1,ioxygen)-satoxy(i,j,1)*(ato2/196800)*rpp0) - ocetra(i,j,1,ioxygen)=ocetra(i,j,1,ioxygen)-oxflux/pddpo(i,j,1) - ! Surface flux of gaseous nitrogen (same piston velocity as for O2) - niflux=kwn2*dtbgc*(ocetra(i,j,1,igasnit)-anisa*(atn2/802000)*rpp0) - ocetra(i,j,1,igasnit)=ocetra(i,j,1,igasnit)-niflux/pddpo(i,j,1) - ! 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) - 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)) - ! flx12=kw_12*(a_12*cfc12_atm(i,j)*ppair/p0-trc(i,j,1,2)) - ! 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 - - ! 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) - ! 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) - ! 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 - - ! Surface flux of dms - ! 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) - atmflx(i,j,iatmbromo) = -flx_bromo - endif - - ! Save surface fluxes - atmflx(i,j,iatmco2)=fluxu-fluxd - atmflx(i,j,iatmo2)=oxflux - atmflx(i,j,iatmn2)=niflux - atmflx(i,j,iatmn2o)=n2oflux if (use_cisonew) then - atmflx(i,j,iatmc13)=flux13u-flux13d - atmflx(i,j,iatmc14)=flux14u-flux14d - endif - if (use_CFC) then - atmflx(i,j,iatmf11)=flx11 - atmflx(i,j,iatmf12)=flx12 - atmflx(i,j,iatmsf6)=flxsf - endif - if (use_natDIC) then - atmflx(i,j,iatmnco2)=natfluxu-natfluxd + ! 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 - ! Save up- and downward components of carbon fluxes for output - co2fxd(i,j) = fluxd - co2fxu(i,j) = fluxu - if (use_cisonew) then - co213fxd(i,j)= flux13d - co213fxu(i,j)= flux13u - co214fxd(i,j)= flux14d - co214fxu(i,j)= flux14u - endif + ! Save bottom level dissociation konstants for use in sediment module + if( k==kbo(i,j) ) then + + keqb( 1,i,j) = K1 + keqb( 2,i,j) = K2 + keqb( 3,i,j) = Kb + keqb( 4,i,j) = Kw + keqb( 5,i,j) = Ks1 + keqb( 6,i,j) = Kf + keqb( 7,i,j) = Ksi + keqb( 8,i,j) = K1p + keqb( 9,i,j) = K2p + keqb(10,i,j) = K3p + keqb(11,i,j) = Kspc - ! 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 - if (use_natDIC) then - natpco2d(i,j) = natcu * 1.e6 / Khd endif - ! Save product of piston velocity and solubility for output - kwco2sol(i,j) = kwco2*Kh*1e-6 !m/s mol/kg/muatm - kwco2d(i,j) = kwco2 ! m/s (incl. ice fraction!) - co2sold(i,j) = Khd ! mol/kg/atm - co2solm(i,j) = Kh ! mol/kg/atm - - endif ! k==1 - - 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)) - ! 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 - ! ----------------------------------------------------------------- - ! Deep ocean processes - - ! Determine Omega Calcite/Aragonite and dissolution of caco3 based on OmegaC: - ! omegaC=([CO3]*[Ca])/([CO3]sat*[Ca]sat) - ! Following Sarmiento and Gruber book, assumed that [Ca]=[Ca]sat - ! Thus, [CO3]sat=[CO3]/OmegaC. - omega = ( calcon * s / 35. ) * cc - OmegaA(i,j,k) = omega / Kspa - OmegaC(i,j,k) = omega / Kspc - 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)) - 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)) - endif - 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) - endif - 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 - 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 - endif - 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 - endif - - - 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 - endif - - ! Save bottom level dissociation konstants for use in sediment module - if( k==kbo(i,j) ) then - - keqb( 1,i,j) = K1 - keqb( 2,i,j) = K2 - keqb( 3,i,j) = Kb - keqb( 4,i,j) = Kw - keqb( 5,i,j) = Ks1 - keqb( 6,i,j) = Kf - keqb( 7,i,j) = Ksi - keqb( 8,i,j) = K1p - keqb( 9,i,j) = K2p - keqb(10,i,j) = K3p - keqb(11,i,j) = Kspc - - endif - - ENDIF ! omask>0.5 + ENDIF ! omask>0.5 + ENDDO ENDDO ENDDO - ENDDO - !$OMP END PARALLEL DO + !$OMP END PARALLEL DO + + ! 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 - ! 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 + 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 - 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 ! end of use_cisonew and not use_sedbypass + endif ! end of use_cisonew and not use_sedbypass + + END SUBROUTINE CARCHM + + SUBROUTINE CARCHM_KEQUI(temp,saln,prb,Kh,Khd,K1,K2,Kb,Kw,Ks1,Kf,Ksi, & + K1p,K2p,K3p,Kspc,Kspa) + + !******************************************************************************* + ! + !**** *CARCHM_SOLVE* - . + ! + ! J. Schwinger, *BCCR, Bergen* 09.02.16 + ! + ! Modified + ! -------- + ! + ! Purpose + ! ------- + ! Calculate equilibrium constant for the carbonate system + ! + ! Method + ! ------- + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - added output Khd (CO2 solubility w.r.t. dry air) and + ! Kspa + ! + ! + !**** Parameter list: + ! --------------- + ! + ! *REAL* *temp* - potential temperature [degr C]. + ! *REAL* *saln* - salinity [psu]. + ! *REAL* *prb* - pressure [bar]. + ! *REAL* *Kh* - equilibrium constant Kh = [CO2]/pCO2, moist air. + ! *REAL* *Khd* - equilibrium constant Kh = [CO2]/pCO2, dry air. + ! *REAL* *K1* - equilibrium constant K1 = [H][HCO3]/[H2CO3]. + ! *REAL* *K2* - equilibrium constant K2 = [H][CO3]/[HCO3]. + ! *REAL* *Kb* - equilibrium constant Kb = [H][BO2]/[HBO2]. + ! *REAL* *Kw* - equilibrium constant Kw = [H][OH]. + ! *REAL* *Ks1* - equilibrium constant Ks1 = [H][SO4]/[HSO4]. + ! *REAL* *Kf* - equilibrium constant Kf = [H][F]/[HF]. + ! *REAL* *Ksi* - equilibrium constant Ksi = [H][SiO(OH)3]/[Si(OH)4]. + ! *REAL* *K1p* - equilibrium constant K1p = [H][H2PO4]/[H3PO4]. + ! *REAL* *K2p* - equilibrium constant K2p = [H][HPO4]/[H2PO4]. + ! *REAL* *K3p* - equilibrium constant K3p = [H][PO4]/[HPO4]. + ! *REAL* *Kspc* - equilibrium constant Kspc= [Ca2+]T [CO3]T. + ! *REAL* *Kspa* - equilibrium constant Kspa= [Ca2+]T [CO3]T. + ! + ! Externals + ! --------- + ! none. + ! + !******************************************************************************* + + use mo_chemcon, only: tzero,rgas,bor1,bor2,salchl,ac1,ac2,ac3,ac4,bc1,bc2,bc3,ad1,ad2,ad3,bd1,bd2,bd3,a0,a1,a2,b0,b1,b2 + + IMPLICIT NONE + REAL, INTENT(IN) :: temp,saln,prb + REAL, INTENT(OUT) :: Kh,Khd,K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p,Kspc,Kspa + + ! Local varibles + INTEGER :: js + REAL :: tk,tk100,invtk,dlogtk + REAL :: s,is,is2,sqrtis,s15,s2,sqrts,scl + REAL :: nKhwe74,deltav,deltak,zprb,zprb2 + REAL :: lnkpok0(11) + + s = MAX(25.,saln) + tk = temp + tzero + tk100 = tk/100.0 + invtk = 1.0 / tk + dlogtk = log(tk) + is = 19.924 * s / ( 1000. - 1.005 * s ) + is2 = is * is + sqrtis = SQRT(is) + s15 = s**1.5 + s2 = s * s + sqrts = SQRT(s) + scl = s * salchl + + ! Kh = [CO2]/ p CO2 + ! Weiss (1974), refitted for moist air Weiss and Price (1980) [mol/kg/atm] + nKhwe74 = ac1+ac2/tk100+ac3*log(tk100)+ac4*tk100**2+s*(bc1+bc2*tk100+bc3*tk100**2) + Kh = exp( nKhwe74 ) + ! Khd = [CO2]/ p CO2 + ! Weiss (1974) for dry air [mol/kg/atm] + nKhwe74 = ad1+ad2/tk100+ad3*log(tk100)+s*(bd1+bd2*tk100+bd3*tk100**2) + Khd = exp( nKhwe74 ) + ! K1 = [H][HCO3]/[H2CO3] ; K2 = [H][CO3]/[HCO3] + ! Millero p.664 (1995) using Mehrbach et al. data on seawater scale + K1 = 10**( -1.0 * ( 3670.7 * invtk - 62.008 + 9.7944 * dlogtk - 0.0118 * s + 0.000116 * s2 ) ) + K2 = 10**( -1.0 * ( 1394.7 * invtk + 4.777 - 0.0184 * s + 0.000118 * s2 ) ) + ! Kb = [H][BO2]/[HBO2] ! + ! Millero p.669 (1995) using DATA from Dickson (1990) + Kb = exp( ( -8966.90 - 2890.53 * sqrts - 77.942 * s + 1.728 * s15 - 0.0996 * s2 ) * invtk + & + ( 148.0248 + 137.1942 * sqrts + 1.62142 * s ) + & + ( -24.4344 - 25.085 * sqrts - 0.2474 * s ) * dlogtk + 0.053105 * sqrts * tk ) + ! K1p = [H][H2PO4]/[H3PO4] ; K2p = [H][HPO4]/[H2PO4] ; K3p = [H][PO4]/[HPO4] + ! DOE(1994) eq 7.2.20 with footnote using data from Millero (1974) + K1p = exp( -4576.752 * invtk + 115.525 - 18.453 * dlogtk + ( -106.736 * invtk + 0.69171 ) * & + sqrts + ( -0.65643 * invtk - 0.01844 ) * s ) + K2p = exp( -8814.715 * invtk + 172.0883 - 27.927 * dlogtk + ( -160.340 * invtk + 1.3566 ) * & + sqrts + ( 0.37335 * invtk - 0.05778 ) *s ); + K3p = exp( -3070.75 * invtk - 18.141 + ( 17.27039 * invtk + 2.81197 ) * sqrts + ( -44.99486 * & + invtk - 0.09984 ) * s ); + ! Ksi = [H][SiO(OH)3]/[Si(OH)4] + ! Millero p.671 (1995) using data from Yao and Millero (1995) + Ksi = exp( -8904.2 * invtk + 117.385 - 19.334 * dlogtk + ( -458.79 * invtk + 3.5913 ) * sqrtis & + + ( 188.74 * invtk - 1.5998) * is + ( -12.1652 * invtk + 0.07871) * is2 + & + log(1.0-0.001005*s)) + ! Kw = [H][OH] + ! Millero p.670 (1995) using composite data + Kw = exp( -13847.26 * invtk + 148.9652 - 23.6521 * dlogtk + ( 118.67 * invtk - 5.977 + 1.0495 * & + dlogtk ) * sqrts - 0.01615 * s) + ! Ks = [H][SO4]/[HSO4] + ! Dickson (1990, J. chem. Thermodynamics 22, 113) + Ks1 = exp( -4276.1 * invtk + 141.328 - 23.093 * dlogtk + ( -13856. * invtk + 324.57 - 47.986 * & + dlogtk ) * sqrtis + ( 35474. * invtk - 771.54 + 114.723 * dlogtk ) * is - 2698. * & + invtk * is**1.5 + 1776. * invtk * is2 + log(1.0 - 0.001005 * s ) ) + ! Kf = [H][F]/[HF] + ! Dickson and Riley (1979) -- change pH scale to total + Kf = exp( 1590.2 * invtk - 12.641 + 1.525 * sqrtis + log( 1.0 - 0.001005 * s ) + log( 1.0 + ( & + 0.1400 / 96.062 ) * scl / Ks1 ) ) + ! Kspc (calcite) + ! apparent solubility product of calcite : Kspc = [Ca2+]T [CO32-]T + ! where $[]_T$ refers to the equilibrium total (free + complexed) ion concentration. + ! Mucci 1983 mol/kg-soln + Kspc = 10**( -171.9065 - 0.077993 * tk + 2839.319 / tk + 71.595 * log10( tk ) + ( - 0.77712 + & + 0.0028426 * tk + 178.34 / tk ) * sqrts - 0.07711 * s + 0.0041249 * s15 ); + ! Kspa (aragonite) + ! apparent solubility product of aragonite : Kspa = [Ca2+]T [CO32-]T + ! where $[]_T$ refers to the equilibrium total (free + complexed) ion concentration. + ! Mucci 1983 mol/kg-soln + Kspa = 10**( -171.945 - 0.077993 * tk + 2903.293 / tk + 71.595 * log10( tk ) + ( -0.068393 + & + 0.0017276 * tk + 88.135 / tk ) * sqrts - 0.10018 * s + 0.0059415 * s15 ); + + + !---------------------- Pressure effect on Ks (Millero, 95) -------------------- + ! index: K1 1, K2 2, Kb 3, Kw 4, Ks 5, Kf 6, Kspc 7, Kspa 8, K1p 9, K2p 10, K3p 11 + DO js = 1,11 + deltav = a0(js) + a1(js) * temp + a2(js) * temp * temp + deltak = b0(js) + b1(js) * temp + b2(js) * temp * temp + zprb = prb / ( rgas * tk ) + zprb2 = prb * zprb + lnkpok0(js) = - ( deltav * zprb + 0.5 * deltak * zprb2 ) + ENDDO - RETURN -END SUBROUTINE CARCHM + K1 = K1 * exp( lnkpok0(1) ) + K2 = K2 * exp( lnkpok0(2) ) + Kb = Kb * exp( lnkpok0(3) ) + Kw = Kw * exp( lnkpok0(4) ) + Ks1 = Ks1 * exp( lnkpok0(5) ) + Kf = Kf * exp( lnkpok0(6) ) + Kspc = Kspc * exp( lnkpok0(7) ) + Kspa = Kspa * exp( lnkpok0(8) ) + K1p = K1p * exp( lnkpok0(9) ) + K2p = K2p * exp( lnkpok0(10) ) + K3p = K3p * exp( lnkpok0(11) ) + + END SUBROUTINE CARCHM_KEQUI + + + SUBROUTINE CARCHM_SOLVE(saln,tc,ta,sit,pt, & + K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p, & + ah1,ac,niter) + + !********************************************************************** + ! + !**** *CARCHM_SOLVE* - . + ! + ! J. Schwinger, *BCCR, Bergen* 09.02.16 + ! + ! Modified + ! -------- + ! + ! Purpose + ! ------- + ! Solve carbon chemistry. + ! + ! Method + ! ------- + ! + ! + !**** Parameter list: + ! --------------- + ! *REAL* *saln* - salinity [psu]. + ! *REAL* *tc* - total DIC concentraion [mol/kg]. + ! *REAL* *ta* - total alkalinity [eq/kg]. + ! *REAL* *sit* - silicate concentration [mol/kg]. + ! *REAL* *pt* - phosphate concentration [mol/kg]. + ! *REAL* *K1* - equilibrium constant K1 = [H][HCO3]/[H2CO3]. + ! *REAL* *K2* - equilibrium constant K2 = [H][CO3]/[HCO3]. + ! *REAL* *Kb* - equilibrium constant Kb = [H][BO2]/[HBO2]. + ! *REAL* *Kw* - equilibrium constant Kw = [H][OH]. + ! *REAL* *Ks1* - equilibrium constant Ks1 = [H][SO4]/[HSO4]. + ! *REAL* *Kf* - equilibrium constant Kf = [H][F]/[HF]. + ! *REAL* *Ksi* - equilibrium constant Ksi = [H][SiO(OH)3]/[Si(OH)4]. + ! *REAL* *K1p* - equilibrium constant K1p = [H][H2PO4]/[H3PO4]. + ! *REAL* *K2p* - equilibrium constant K2p = [H][HPO4]/[H2PO4]. + ! *REAL* *K3p* - equilibrium constant K3p = [H][PO4]/[HPO4]. + ! *REAL* *ah1* - hydrogen ion concentration. + ! *REAL* *ac* - carbonate alkalinity. + ! *INTEGER* *niter* - maximum number of iteration + ! + ! Externals + ! --------- + ! none. + ! + !********************************************************************** + + use mo_chemcon, only: bor1,bor2,salchl + + IMPLICIT NONE + REAL, INTENT(IN) :: saln,tc,ta,sit,pt + REAL, INTENT(IN) :: K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p + REAL, INTENT(INOUT) :: ah1 + REAL, INTENT(OUT) :: ac + INTEGER, INTENT(IN) :: niter + + ! Parameters to set accuracy of iteration + REAL, PARAMETER :: eps=5.e-5 + + ! Local varibles + INTEGER :: jit + REAL :: s,scl,borat,sti,ft + REAL :: hso4,hf,hsi,hpo4,ab,aw,ah2o,ah2,erel + + + + ! Calculate concentrations for borate, sulfate, and fluoride; see Dickson, A.G., + ! Sabine, C.L. and Christian, J.R. (Eds.) 2007. Guide to best practices + ! for ocean CO2 measurements. PICES Special Publication 3, chapter 5 p. 10 + s = MAX(25.,saln) + scl = s * salchl + borat = bor1 * scl * bor2 ! Uppstrom (1974) + sti = 0.14 * scl / 96.062 ! Morris & Riley (1966) + ft = 0.000067 * scl / 18.9984 ! Riley (1965) + + + iflag: DO jit = 1,niter + hso4 = sti / ( 1. + Ks1 / ( ah1 / ( 1. + sti / Ks1 ) ) ) + hf = 1. / ( 1. + Kf / ah1 ) + hsi = 1./ ( 1. + ah1 / Ksi ) + hpo4 = ( K1p * K2p * ( ah1 + 2. * K3p ) - ah1**3 ) / & + ( ah1**3 + K1p * ah1**2 + K1p * K2p * ah1 + K1p * K2p * K3p ) + ab = borat / ( 1. + ah1 / Kb ) + aw = Kw / ah1 - ah1 / ( 1. + sti / Ks1 ) + ac = ta + hso4 - sit * hsi - ab - aw + ft * hf - pt * hpo4 + ah2o = SQRT( ( tc - ac )**2 + 4. * ( ac * K2 / K1 ) * ( 2. * tc - ac ) ) + ah2 = 0.5 * K1 / ac *( ( tc - ac ) + ah2o ) + erel = ( ah2 - ah1 ) / ah2 + if (abs( erel ).ge.eps) then + ah1 = ah2 + else + exit iflag + endif + ENDDO iflag + + END SUBROUTINE CARCHM_SOLVE + + + SUBROUTINE CARCHM_SOLVE_DICSAT(saln,pco2,ta,sit,pt, & + Kh,K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p, & + tc_sat,niter) + + !********************************************************************** + ! + !**** *CARCHM_SOLVE_DICsat* - . + ! + ! J. Tjiputra, *BCCR, Bergen* 25.01.17 + ! + ! Modified + ! -------- + ! + ! Purpose + ! ------- + ! Solve DICsat from TALK and pCO2. + ! + ! Method + ! ------- + ! + ! + !**** Parameter list: + ! --------------- + ! *REAL* *saln* - salinity [psu]. + ! *REAL* *pco2* - partial pressure of CO2 [ppm]. + ! *REAL* *ta* - total alkalinity [eq/kg]. + ! *REAL* *sit* - silicate concentration [mol/kg]. + ! *REAL* *pt* - phosphate concentration [mol/kg]. + ! *REAL* *Kh* - equilibrium constant K0 = [H2CO3]/pCO2. + ! *REAL* *K1* - equilibrium constant K1 = [H][HCO3]/[H2CO3]. + ! *REAL* *K2* - equilibrium constant K2 = [H][CO3]/[HCO3]. + ! *REAL* *Kb* - equilibrium constant Kb = [H][BO2]/[HBO2]. + ! *REAL* *Kw* - equilibrium constant Kw = [H][OH]. + ! *REAL* *Ks1* - equilibrium constant Ks1 = [H][SO4]/[HSO4]. + ! *REAL* *Kf* - equilibrium constant Kf = [H][F]/[HF]. + ! *REAL* *Ksi* - equilibrium constant Ksi = [H][SiO(OH)3]/[Si(OH)4]. + ! *REAL* *K1p* - equilibrium constant K1p = [H][H2PO4]/[H3PO4]. + ! *REAL* *K2p* - equilibrium constant K2p = [H][HPO4]/[H2PO4]. + ! *REAL* *K3p* - equilibrium constant K3p = [H][PO4]/[HPO4]. + ! *REAL* *tc_sat* - saturated total DIC concentration [mol/kg]. + ! *INTEGER* *niter* - maximum number of iteration + ! + ! Externals + ! --------- + ! none. + ! + !********************************************************************** + + use mo_chemcon, only: bor1,bor2,salchl + + REAL, INTENT(IN) :: saln,pco2,ta,sit,pt + REAL, INTENT(IN) :: Kh,K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p + REAL, INTENT(OUT) :: tc_sat + INTEGER, INTENT(IN) :: niter + + ! Parameters to set accuracy of iteration + REAL, PARAMETER :: eps=5.e-5 + + ! Local varibles + INTEGER :: jit + REAL :: s,scl,borat,sti,ft + REAL :: hso4,hf,hsi,hpo4,ab,aw,ah2o,ah2,erel + REAL :: dic_h2co3,dic_hco3,dic_co3,ah1,ac + + ! Calculate concentrations for borate, sulfate, and fluoride; see Dickson, A.G., + ! Sabine, C.L. and Christian, J.R. (Eds.) 2007. Guide to best practices + ! for ocean CO2 measurements. PICES Special Publication 3, chapter 5 p. 10 + s = MAX(25.,saln) + scl = s * salchl + borat = bor1 * scl * bor2 ! Uppstrom (1974) + sti = 0.14 * scl / 96.062 ! Morris & Riley (1966) + ft = 0.000067 * scl / 18.9984 ! Riley (1965) + ah1=1.e-8 + dic_h2co3 = Kh * pco2 * 1e-6 + + iflag: DO jit = 1,niter + hso4 = sti / ( 1. + Ks1 / ( ah1 / ( 1. + sti / Ks1 ) ) ) + hf = 1. / ( 1. + Kf / ah1 ) + hsi = 1./ ( 1. + ah1 / Ksi ) + hpo4 = ( K1p * K2p * ( ah1 + 2. * K3p ) - ah1**3 ) / & + ( ah1**3 + K1p * ah1**2 + K1p * K2p * ah1 + K1p * K2p * K3p ) + ab = borat / ( 1. + ah1 / Kb ) + aw = Kw / ah1 - ah1 / ( 1. + sti / Ks1 ) + ac = ta + hso4 - sit * hsi - ab - aw + ft * hf - pt * hpo4 + ah2o = SQRT((K1*dic_h2co3)**2 + 4.*ac*2.*K1*k2*dic_h2co3) + ah2 = (K1*dic_h2co3 + ah2o)/(2.*ac) + erel = ( ah2 - ah1 ) / ah2 + if (abs( erel ).ge.eps) then + ah1 = ah2 + else + exit iflag + endif + ENDDO iflag + + dic_hco3 = Kh * K1 * pco2 * 1e-6 / ah1 + dic_co3 = Kh * K1 * K2 * pco2 * 1e-6 / ah1**2 + tc_sat = dic_h2co3 + dic_hco3 + dic_co3 + + END SUBROUTINE carchm_solve_DICsat + + +END MODULE MO_CARCHM From 67bcd603ea6b92596d26df7485ad1b68a4d7b7f0 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 6 Nov 2023 16:22:35 +0100 Subject: [PATCH 3/5] removed files that were already moved into charchm.F90 --- hamocc/carchm_kequi.F90 | 174 --------------------------------- hamocc/carchm_solve.F90 | 114 --------------------- hamocc/carchm_solve_DICsat.F90 | 119 ---------------------- 3 files changed, 407 deletions(-) delete mode 100644 hamocc/carchm_kequi.F90 delete mode 100644 hamocc/carchm_solve.F90 delete mode 100644 hamocc/carchm_solve_DICsat.F90 diff --git a/hamocc/carchm_kequi.F90 b/hamocc/carchm_kequi.F90 deleted file mode 100644 index d7e565eb..00000000 --- a/hamocc/carchm_kequi.F90 +++ /dev/null @@ -1,174 +0,0 @@ -! Copyright (C) 2020 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. -! -! 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. -! -! 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 CARCHM_KEQUI(temp,saln,prb,Kh,Khd,K1,K2,Kb,Kw,Ks1,Kf,Ksi, & - K1p,K2p,K3p,Kspc,Kspa) - !******************************************************************************* - ! - !**** *CARCHM_SOLVE* - . - ! - ! J. Schwinger, *BCCR, Bergen* 09.02.16 - ! - ! Modified - ! -------- - ! - ! Purpose - ! ------- - ! Calculate equilibrium constant for the carbonate system - ! - ! Method - ! ------- - ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 - ! - added output Khd (CO2 solubility w.r.t. dry air) and - ! Kspa - ! - ! - !**** Parameter list: - ! --------------- - ! - ! *REAL* *temp* - potential temperature [degr C]. - ! *REAL* *saln* - salinity [psu]. - ! *REAL* *prb* - pressure [bar]. - ! *REAL* *Kh* - equilibrium constant Kh = [CO2]/pCO2, moist air. - ! *REAL* *Khd* - equilibrium constant Kh = [CO2]/pCO2, dry air. - ! *REAL* *K1* - equilibrium constant K1 = [H][HCO3]/[H2CO3]. - ! *REAL* *K2* - equilibrium constant K2 = [H][CO3]/[HCO3]. - ! *REAL* *Kb* - equilibrium constant Kb = [H][BO2]/[HBO2]. - ! *REAL* *Kw* - equilibrium constant Kw = [H][OH]. - ! *REAL* *Ks1* - equilibrium constant Ks1 = [H][SO4]/[HSO4]. - ! *REAL* *Kf* - equilibrium constant Kf = [H][F]/[HF]. - ! *REAL* *Ksi* - equilibrium constant Ksi = [H][SiO(OH)3]/[Si(OH)4]. - ! *REAL* *K1p* - equilibrium constant K1p = [H][H2PO4]/[H3PO4]. - ! *REAL* *K2p* - equilibrium constant K2p = [H][HPO4]/[H2PO4]. - ! *REAL* *K3p* - equilibrium constant K3p = [H][PO4]/[HPO4]. - ! *REAL* *Kspc* - equilibrium constant Kspc= [Ca2+]T [CO3]T. - ! *REAL* *Kspa* - equilibrium constant Kspa= [Ca2+]T [CO3]T. - ! - ! Externals - ! --------- - ! none. - ! - !******************************************************************************* - - use mo_chemcon, only: tzero,rgas,bor1,bor2,salchl,ac1,ac2,ac3,ac4,bc1,bc2,bc3,ad1,ad2,ad3,bd1,bd2,bd3,a0,a1,a2,b0,b1,b2 - - IMPLICIT NONE - REAL, INTENT(IN) :: temp,saln,prb - REAL, INTENT(OUT) :: Kh,Khd,K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p,Kspc,Kspa - - ! Local varibles - INTEGER :: js - REAL :: tk,tk100,invtk,dlogtk - REAL :: s,is,is2,sqrtis,s15,s2,sqrts,scl - REAL :: nKhwe74,deltav,deltak,zprb,zprb2 - REAL :: lnkpok0(11) - - s = MAX(25.,saln) - tk = temp + tzero - tk100 = tk/100.0 - invtk = 1.0 / tk - dlogtk = log(tk) - is = 19.924 * s / ( 1000. - 1.005 * s ) - is2 = is * is - sqrtis = SQRT(is) - s15 = s**1.5 - s2 = s * s - sqrts = SQRT(s) - scl = s * salchl - - ! Kh = [CO2]/ p CO2 - ! Weiss (1974), refitted for moist air Weiss and Price (1980) [mol/kg/atm] - nKhwe74 = ac1+ac2/tk100+ac3*log(tk100)+ac4*tk100**2+s*(bc1+bc2*tk100+bc3*tk100**2) - Kh = exp( nKhwe74 ) - ! Khd = [CO2]/ p CO2 - ! Weiss (1974) for dry air [mol/kg/atm] - nKhwe74 = ad1+ad2/tk100+ad3*log(tk100)+s*(bd1+bd2*tk100+bd3*tk100**2) - Khd = exp( nKhwe74 ) - ! K1 = [H][HCO3]/[H2CO3] ; K2 = [H][CO3]/[HCO3] - ! Millero p.664 (1995) using Mehrbach et al. data on seawater scale - K1 = 10**( -1.0 * ( 3670.7 * invtk - 62.008 + 9.7944 * dlogtk - 0.0118 * s + 0.000116 * s2 ) ) - K2 = 10**( -1.0 * ( 1394.7 * invtk + 4.777 - 0.0184 * s + 0.000118 * s2 ) ) - ! Kb = [H][BO2]/[HBO2] ! - ! Millero p.669 (1995) using DATA from Dickson (1990) - Kb = exp( ( -8966.90 - 2890.53 * sqrts - 77.942 * s + 1.728 * s15 - 0.0996 * s2 ) * invtk + & - ( 148.0248 + 137.1942 * sqrts + 1.62142 * s ) + & - ( -24.4344 - 25.085 * sqrts - 0.2474 * s ) * dlogtk + 0.053105 * sqrts * tk ) - ! K1p = [H][H2PO4]/[H3PO4] ; K2p = [H][HPO4]/[H2PO4] ; K3p = [H][PO4]/[HPO4] - ! DOE(1994) eq 7.2.20 with footnote using data from Millero (1974) - K1p = exp( -4576.752 * invtk + 115.525 - 18.453 * dlogtk + ( -106.736 * invtk + 0.69171 ) * & - sqrts + ( -0.65643 * invtk - 0.01844 ) * s ) - K2p = exp( -8814.715 * invtk + 172.0883 - 27.927 * dlogtk + ( -160.340 * invtk + 1.3566 ) * & - sqrts + ( 0.37335 * invtk - 0.05778 ) *s ); - K3p = exp( -3070.75 * invtk - 18.141 + ( 17.27039 * invtk + 2.81197 ) * sqrts + ( -44.99486 * & - invtk - 0.09984 ) * s ); - ! Ksi = [H][SiO(OH)3]/[Si(OH)4] - ! Millero p.671 (1995) using data from Yao and Millero (1995) - Ksi = exp( -8904.2 * invtk + 117.385 - 19.334 * dlogtk + ( -458.79 * invtk + 3.5913 ) * sqrtis & - + ( 188.74 * invtk - 1.5998) * is + ( -12.1652 * invtk + 0.07871) * is2 + & - log(1.0-0.001005*s)) - ! Kw = [H][OH] - ! Millero p.670 (1995) using composite data - Kw = exp( -13847.26 * invtk + 148.9652 - 23.6521 * dlogtk + ( 118.67 * invtk - 5.977 + 1.0495 * & - dlogtk ) * sqrts - 0.01615 * s) - ! Ks = [H][SO4]/[HSO4] - ! Dickson (1990, J. chem. Thermodynamics 22, 113) - Ks1 = exp( -4276.1 * invtk + 141.328 - 23.093 * dlogtk + ( -13856. * invtk + 324.57 - 47.986 * & - dlogtk ) * sqrtis + ( 35474. * invtk - 771.54 + 114.723 * dlogtk ) * is - 2698. * & - invtk * is**1.5 + 1776. * invtk * is2 + log(1.0 - 0.001005 * s ) ) - ! Kf = [H][F]/[HF] - ! Dickson and Riley (1979) -- change pH scale to total - Kf = exp( 1590.2 * invtk - 12.641 + 1.525 * sqrtis + log( 1.0 - 0.001005 * s ) + log( 1.0 + ( & - 0.1400 / 96.062 ) * scl / Ks1 ) ) - ! Kspc (calcite) - ! apparent solubility product of calcite : Kspc = [Ca2+]T [CO32-]T - ! where $[]_T$ refers to the equilibrium total (free + complexed) ion concentration. - ! Mucci 1983 mol/kg-soln - Kspc = 10**( -171.9065 - 0.077993 * tk + 2839.319 / tk + 71.595 * log10( tk ) + ( - 0.77712 + & - 0.0028426 * tk + 178.34 / tk ) * sqrts - 0.07711 * s + 0.0041249 * s15 ); - ! Kspa (aragonite) - ! apparent solubility product of aragonite : Kspa = [Ca2+]T [CO32-]T - ! where $[]_T$ refers to the equilibrium total (free + complexed) ion concentration. - ! Mucci 1983 mol/kg-soln - Kspa = 10**( -171.945 - 0.077993 * tk + 2903.293 / tk + 71.595 * log10( tk ) + ( -0.068393 + & - 0.0017276 * tk + 88.135 / tk ) * sqrts - 0.10018 * s + 0.0059415 * s15 ); - - - !---------------------- Pressure effect on Ks (Millero, 95) -------------------- - ! index: K1 1, K2 2, Kb 3, Kw 4, Ks 5, Kf 6, Kspc 7, Kspa 8, K1p 9, K2p 10, K3p 11 - DO js = 1,11 - deltav = a0(js) + a1(js) * temp + a2(js) * temp * temp - deltak = b0(js) + b1(js) * temp + b2(js) * temp * temp - zprb = prb / ( rgas * tk ) - zprb2 = prb * zprb - lnkpok0(js) = - ( deltav * zprb + 0.5 * deltak * zprb2 ) - ENDDO - - K1 = K1 * exp( lnkpok0(1) ) - K2 = K2 * exp( lnkpok0(2) ) - Kb = Kb * exp( lnkpok0(3) ) - Kw = Kw * exp( lnkpok0(4) ) - Ks1 = Ks1 * exp( lnkpok0(5) ) - Kf = Kf * exp( lnkpok0(6) ) - Kspc = Kspc * exp( lnkpok0(7) ) - Kspa = Kspa * exp( lnkpok0(8) ) - K1p = K1p * exp( lnkpok0(9) ) - K2p = K2p * exp( lnkpok0(10) ) - K3p = K3p * exp( lnkpok0(11) ) - - -END SUBROUTINE CARCHM_KEQUI diff --git a/hamocc/carchm_solve.F90 b/hamocc/carchm_solve.F90 deleted file mode 100644 index 0395f2ed..00000000 --- a/hamocc/carchm_solve.F90 +++ /dev/null @@ -1,114 +0,0 @@ -! Copyright (C) 2020 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. -! -! 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. -! -! 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 CARCHM_SOLVE(saln,tc,ta,sit,pt, & - K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p, & - ah1,ac,niter) - !********************************************************************** - ! - !**** *CARCHM_SOLVE* - . - ! - ! J. Schwinger, *BCCR, Bergen* 09.02.16 - ! - ! Modified - ! -------- - ! - ! Purpose - ! ------- - ! Solve carbon chemistry. - ! - ! Method - ! ------- - ! - ! - !**** Parameter list: - ! --------------- - ! *REAL* *saln* - salinity [psu]. - ! *REAL* *tc* - total DIC concentraion [mol/kg]. - ! *REAL* *ta* - total alkalinity [eq/kg]. - ! *REAL* *sit* - silicate concentration [mol/kg]. - ! *REAL* *pt* - phosphate concentration [mol/kg]. - ! *REAL* *K1* - equilibrium constant K1 = [H][HCO3]/[H2CO3]. - ! *REAL* *K2* - equilibrium constant K2 = [H][CO3]/[HCO3]. - ! *REAL* *Kb* - equilibrium constant Kb = [H][BO2]/[HBO2]. - ! *REAL* *Kw* - equilibrium constant Kw = [H][OH]. - ! *REAL* *Ks1* - equilibrium constant Ks1 = [H][SO4]/[HSO4]. - ! *REAL* *Kf* - equilibrium constant Kf = [H][F]/[HF]. - ! *REAL* *Ksi* - equilibrium constant Ksi = [H][SiO(OH)3]/[Si(OH)4]. - ! *REAL* *K1p* - equilibrium constant K1p = [H][H2PO4]/[H3PO4]. - ! *REAL* *K2p* - equilibrium constant K2p = [H][HPO4]/[H2PO4]. - ! *REAL* *K3p* - equilibrium constant K3p = [H][PO4]/[HPO4]. - ! *REAL* *ah1* - hydrogen ion concentration. - ! *REAL* *ac* - carbonate alkalinity. - ! *INTEGER* *niter* - maximum number of iteration - ! - ! Externals - ! --------- - ! none. - ! - !********************************************************************** - - use mo_chemcon, only: bor1,bor2,salchl - - IMPLICIT NONE - REAL, INTENT(IN) :: saln,tc,ta,sit,pt - REAL, INTENT(IN) :: K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p - REAL, INTENT(INOUT) :: ah1 - REAL, INTENT(OUT) :: ac - INTEGER, INTENT(IN) :: niter - - ! Parameters to set accuracy of iteration - REAL, PARAMETER :: eps=5.e-5 - - ! Local varibles - INTEGER :: jit - REAL :: s,scl,borat,sti,ft - REAL :: hso4,hf,hsi,hpo4,ab,aw,ah2o,ah2,erel - - - - ! Calculate concentrations for borate, sulfate, and fluoride; see Dickson, A.G., - ! Sabine, C.L. and Christian, J.R. (Eds.) 2007. Guide to best practices - ! for ocean CO2 measurements. PICES Special Publication 3, chapter 5 p. 10 - s = MAX(25.,saln) - scl = s * salchl - borat = bor1 * scl * bor2 ! Uppstrom (1974) - sti = 0.14 * scl / 96.062 ! Morris & Riley (1966) - ft = 0.000067 * scl / 18.9984 ! Riley (1965) - - - iflag: DO jit = 1,niter - hso4 = sti / ( 1. + Ks1 / ( ah1 / ( 1. + sti / Ks1 ) ) ) - hf = 1. / ( 1. + Kf / ah1 ) - hsi = 1./ ( 1. + ah1 / Ksi ) - hpo4 = ( K1p * K2p * ( ah1 + 2. * K3p ) - ah1**3 ) / & - ( ah1**3 + K1p * ah1**2 + K1p * K2p * ah1 + K1p * K2p * K3p ) - ab = borat / ( 1. + ah1 / Kb ) - aw = Kw / ah1 - ah1 / ( 1. + sti / Ks1 ) - ac = ta + hso4 - sit * hsi - ab - aw + ft * hf - pt * hpo4 - ah2o = SQRT( ( tc - ac )**2 + 4. * ( ac * K2 / K1 ) * ( 2. * tc - ac ) ) - ah2 = 0.5 * K1 / ac *( ( tc - ac ) + ah2o ) - erel = ( ah2 - ah1 ) / ah2 - if (abs( erel ).ge.eps) then - ah1 = ah2 - else - exit iflag - endif - ENDDO iflag - -END SUBROUTINE CARCHM_SOLVE diff --git a/hamocc/carchm_solve_DICsat.F90 b/hamocc/carchm_solve_DICsat.F90 deleted file mode 100644 index 223fe11f..00000000 --- a/hamocc/carchm_solve_DICsat.F90 +++ /dev/null @@ -1,119 +0,0 @@ -! Copyright (C) 2020 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. -! -! 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. -! -! 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 carchm_solve_DICsat(saln,pco2,ta,sit,pt, & - Kh,K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p, & - tc_sat,niter) - !********************************************************************** - ! - !**** *CARCHM_SOLVE_DICsat* - . - ! - ! J. Tjiputra, *BCCR, Bergen* 25.01.17 - ! - ! Modified - ! -------- - ! - ! Purpose - ! ------- - ! Solve DICsat from TALK and pCO2. - ! - ! Method - ! ------- - ! - ! - !**** Parameter list: - ! --------------- - ! *REAL* *saln* - salinity [psu]. - ! *REAL* *pco2* - partial pressure of CO2 [ppm]. - ! *REAL* *ta* - total alkalinity [eq/kg]. - ! *REAL* *sit* - silicate concentration [mol/kg]. - ! *REAL* *pt* - phosphate concentration [mol/kg]. - ! *REAL* *Kh* - equilibrium constant K0 = [H2CO3]/pCO2. - ! *REAL* *K1* - equilibrium constant K1 = [H][HCO3]/[H2CO3]. - ! *REAL* *K2* - equilibrium constant K2 = [H][CO3]/[HCO3]. - ! *REAL* *Kb* - equilibrium constant Kb = [H][BO2]/[HBO2]. - ! *REAL* *Kw* - equilibrium constant Kw = [H][OH]. - ! *REAL* *Ks1* - equilibrium constant Ks1 = [H][SO4]/[HSO4]. - ! *REAL* *Kf* - equilibrium constant Kf = [H][F]/[HF]. - ! *REAL* *Ksi* - equilibrium constant Ksi = [H][SiO(OH)3]/[Si(OH)4]. - ! *REAL* *K1p* - equilibrium constant K1p = [H][H2PO4]/[H3PO4]. - ! *REAL* *K2p* - equilibrium constant K2p = [H][HPO4]/[H2PO4]. - ! *REAL* *K3p* - equilibrium constant K3p = [H][PO4]/[HPO4]. - ! *REAL* *tc_sat* - saturated total DIC concentration [mol/kg]. - ! *INTEGER* *niter* - maximum number of iteration - ! - ! Externals - ! --------- - ! none. - ! - !********************************************************************** - - use mo_chemcon, only: bor1,bor2,salchl - - IMPLICIT NONE - REAL, INTENT(IN) :: saln,pco2,ta,sit,pt - REAL, INTENT(IN) :: Kh,K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p - REAL, INTENT(OUT) :: tc_sat - INTEGER, INTENT(IN) :: niter - - ! Parameters to set accuracy of iteration - REAL, PARAMETER :: eps=5.e-5 - - ! Local varibles - INTEGER :: jit - REAL :: s,scl,borat,sti,ft - REAL :: hso4,hf,hsi,hpo4,ab,aw,ah2o,ah2,erel - REAL :: dic_h2co3,dic_hco3,dic_co3,ah1,ac - - - - ! Calculate concentrations for borate, sulfate, and fluoride; see Dickson, A.G., - ! Sabine, C.L. and Christian, J.R. (Eds.) 2007. Guide to best practices - ! for ocean CO2 measurements. PICES Special Publication 3, chapter 5 p. 10 - s = MAX(25.,saln) - scl = s * salchl - borat = bor1 * scl * bor2 ! Uppstrom (1974) - sti = 0.14 * scl / 96.062 ! Morris & Riley (1966) - ft = 0.000067 * scl / 18.9984 ! Riley (1965) - ah1=1.e-8 - dic_h2co3 = Kh * pco2 * 1e-6 - - iflag: DO jit = 1,niter - hso4 = sti / ( 1. + Ks1 / ( ah1 / ( 1. + sti / Ks1 ) ) ) - hf = 1. / ( 1. + Kf / ah1 ) - hsi = 1./ ( 1. + ah1 / Ksi ) - hpo4 = ( K1p * K2p * ( ah1 + 2. * K3p ) - ah1**3 ) / & - ( ah1**3 + K1p * ah1**2 + K1p * K2p * ah1 + K1p * K2p * K3p ) - ab = borat / ( 1. + ah1 / Kb ) - aw = Kw / ah1 - ah1 / ( 1. + sti / Ks1 ) - ac = ta + hso4 - sit * hsi - ab - aw + ft * hf - pt * hpo4 - ah2o = SQRT((K1*dic_h2co3)**2 + 4.*ac*2.*K1*k2*dic_h2co3) - ah2 = (K1*dic_h2co3 + ah2o)/(2.*ac) - erel = ( ah2 - ah1 ) / ah2 - if (abs( erel ).ge.eps) then - ah1 = ah2 - else - exit iflag - endif - ENDDO iflag - - dic_hco3 = Kh * K1 * pco2 * 1e-6 / ah1 - dic_co3 = Kh * K1 * K2 * pco2 * 1e-6 / ah1**2 - tc_sat = dic_h2co3 + dic_hco3 + dic_co3 - -END SUBROUTINE carchm_solve_DICsat From 52880b837d456bf939a39e42d4d9671124f6ad67 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 6 Nov 2023 21:12:51 +0100 Subject: [PATCH 4/5] first pass at refactorization --- hamocc/accfields.F90 | 464 ---- hamocc/aufr_bgc.F90 | 596 ----- hamocc/aufw_bgc.F90 | 951 -------- hamocc/cyano.F90 | 128 -- hamocc/dipowa.F90 | 201 -- hamocc/get_cfc.F90 | 188 -- hamocc/hamocc4bcm.F90 | 422 ---- hamocc/hamocc_init.F90 | 241 --- hamocc/hamocc_step.F90 | 87 - hamocc/inventory_bgc.F90 | 1904 ---------------- hamocc/meson.build | 51 +- hamocc/mo_accfields.F90 | 475 ++++ hamocc/mo_aufr_bgc.F90 | 616 ++++++ hamocc/mo_aufw_bgc.F90 | 960 +++++++++ hamocc/{carchm.F90 => mo_carchm.F90} | 6 +- hamocc/mo_clim_swa.F90 | 7 +- hamocc/mo_cyano.F90 | 136 ++ hamocc/mo_dipowa.F90 | 212 ++ hamocc/mo_get_cfc.F90 | 199 ++ hamocc/mo_hamocc4bcm.F90 | 433 ++++ hamocc/mo_hamocc_init.F90 | 254 +++ hamocc/mo_hamocc_step.F90 | 101 + hamocc/mo_ini_fields.F90 | 60 +- hamocc/mo_inventory_bgc.F90 | 1910 +++++++++++++++++ hamocc/mo_ncout_hamocc.F90 | 1413 ++++++++++++ hamocc/mo_netcdf_def_vardb.F90 | 246 +++ hamocc/mo_ocprod.F90 | 1452 +++++++++++++ hamocc/mo_powach.F90 | 551 +++++ hamocc/mo_powadi.F90 | 145 ++ hamocc/mo_preftrc.F90 | 80 + hamocc/mo_profile_gd.F90 | 189 ++ hamocc/mo_read_fedep.F90 | 21 +- hamocc/mo_read_ndep.F90 | 50 +- hamocc/mo_read_netcdf_var.F90 | 174 ++ hamocc/mo_read_oafx.F90 | 50 +- hamocc/mo_read_pi_ph.F90 | 38 +- hamocc/mo_read_sedpor.F90 | 19 +- ...t_hamoccwt.F90 => mo_restart_hamoccwt.F90} | 38 +- hamocc/mo_sedshi.F90 | 320 +++ hamocc/mo_trc_limitc.F90 | 143 ++ hamocc/mo_write_netcdf_var.F90 | 212 ++ hamocc/ncout_hamocc.F90 | 1402 ------------ hamocc/netcdf_def_vardb.F90 | 241 --- hamocc/ocprod.F90 | 1439 ------------- hamocc/powach.F90 | 550 ----- hamocc/powadi.F90 | 136 -- hamocc/preftrc.F90 | 69 - hamocc/profile_gd.F90 | 188 -- hamocc/read_netcdf_var.F90 | 155 -- hamocc/sedshi.F90 | 304 --- hamocc/trc_limitc.F90 | 130 -- hamocc/write_netcdf_var.F90 | 189 -- trc/{initrc.F => initrc.F90} | 32 +- trc/restart_trcrd.F90 | 1 + trc/restart_trcwt.F90 | 1 + trc/{updtrc.F => updtrc.F90} | 35 +- 56 files changed, 10444 insertions(+), 10171 deletions(-) delete mode 100644 hamocc/accfields.F90 delete mode 100644 hamocc/aufr_bgc.F90 delete mode 100644 hamocc/aufw_bgc.F90 delete mode 100644 hamocc/cyano.F90 delete mode 100644 hamocc/dipowa.F90 delete mode 100644 hamocc/get_cfc.F90 delete mode 100644 hamocc/hamocc4bcm.F90 delete mode 100644 hamocc/hamocc_init.F90 delete mode 100644 hamocc/hamocc_step.F90 delete mode 100644 hamocc/inventory_bgc.F90 create mode 100644 hamocc/mo_accfields.F90 create mode 100644 hamocc/mo_aufr_bgc.F90 create mode 100644 hamocc/mo_aufw_bgc.F90 rename hamocc/{carchm.F90 => mo_carchm.F90} (99%) create mode 100644 hamocc/mo_cyano.F90 create mode 100644 hamocc/mo_dipowa.F90 create mode 100644 hamocc/mo_get_cfc.F90 create mode 100644 hamocc/mo_hamocc4bcm.F90 create mode 100644 hamocc/mo_hamocc_init.F90 create mode 100644 hamocc/mo_hamocc_step.F90 create mode 100644 hamocc/mo_inventory_bgc.F90 create mode 100644 hamocc/mo_ncout_hamocc.F90 create mode 100644 hamocc/mo_netcdf_def_vardb.F90 create mode 100644 hamocc/mo_ocprod.F90 create mode 100644 hamocc/mo_powach.F90 create mode 100644 hamocc/mo_powadi.F90 create mode 100644 hamocc/mo_preftrc.F90 create mode 100644 hamocc/mo_profile_gd.F90 create mode 100644 hamocc/mo_read_netcdf_var.F90 rename hamocc/{restart_hamoccwt.F90 => mo_restart_hamoccwt.F90} (54%) create mode 100644 hamocc/mo_sedshi.F90 create mode 100644 hamocc/mo_trc_limitc.F90 create mode 100644 hamocc/mo_write_netcdf_var.F90 delete mode 100644 hamocc/ncout_hamocc.F90 delete mode 100644 hamocc/netcdf_def_vardb.F90 delete mode 100644 hamocc/ocprod.F90 delete mode 100644 hamocc/powach.F90 delete mode 100644 hamocc/powadi.F90 delete mode 100644 hamocc/preftrc.F90 delete mode 100644 hamocc/profile_gd.F90 delete mode 100644 hamocc/read_netcdf_var.F90 delete mode 100644 hamocc/sedshi.F90 delete mode 100644 hamocc/trc_limitc.F90 delete mode 100644 hamocc/write_netcdf_var.F90 rename trc/{initrc.F => initrc.F90} (70%) rename trc/{updtrc.F => updtrc.F90} (66%) diff --git a/hamocc/accfields.F90 b/hamocc/accfields.F90 deleted file mode 100644 index 5a842d96..00000000 --- a/hamocc/accfields.F90 +++ /dev/null @@ -1,464 +0,0 @@ -! Copyright (C) 2020 J. Schwinger, A. Moree -! -! 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. -! -! 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. -! -! 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 ACCFIELDS(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask) -!******************************************************************************* -! -!**** *ACCFIELDS* - . -! -! J.Schwinger, *UNI-RESEARCH* 2018-03-22 -! -! Modified -! -------- -! -! Purpose -! ------- -! Accumulate fields for time-avaraged output and write output -! -! -! -!**** Parameter list: -! --------------- -! -! *INTEGER* *kpie* - 1st dimension of model grid. -! *INTEGER* *kpje* - 2nd dimension of model grid. -! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. -! *REAL* *pdlxp* - size of scalar grid cell (1st dimension) [m]. -! *REAL* *pdlyp* - size of scalar grid cell (2nd dimension) [m]. -! *REAL* *pddpo* - size of scalar grid cell (3rd dimension) [m]. -! *REAL* *omask* - land/ocean mask -! -!******************************************************************************* - 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, & - 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, & - int_chbr3_prod,int_chbr3_uv,asize3d,eps3d,wnumb,wmass - use mo_param_bgc, only: 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 - - implicit none - - 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 - - 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 - endif - - - ! 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 - - ! Atmosphere-ocean fluxes - bgct2d(i,j,jco2flux) = bgct2d(i,j,jco2flux) + atmflx(i,j,iatmco2)/2.0 - bgct2d(i,j,jo2flux) = bgct2d(i,j,jo2flux) + atmflx(i,j,iatmo2)/2.0 - bgct2d(i,j,jn2flux) = bgct2d(i,j,jn2flux) + atmflx(i,j,iatmn2)/2.0 - bgct2d(i,j,jn2oflux) = bgct2d(i,j,jn2oflux) + atmflx(i,j,iatmn2o)/2.0 - ! Particle fluxes between water-column and sediment - 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 - 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 - endif - ! 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 - bgct2d(i,j,jirdin) = bgct2d(i,j,jirdin) + rivinflx(i,j,irdin)/2.0 - bgct2d(i,j,jirdip) = bgct2d(i,j,jirdip) + rivinflx(i,j,irdip)/2.0 - bgct2d(i,j,jirsi) = bgct2d(i,j,jirsi) + rivinflx(i,j,irsi)/2.0 - bgct2d(i,j,jiralk) = bgct2d(i,j,jiralk) + rivinflx(i,j,iralk)/2.0 - bgct2d(i,j,jiriron) = bgct2d(i,j,jiriron) + rivinflx(i,j,iriron)/2.0 - bgct2d(i,j,jirdoc) = bgct2d(i,j,jirdoc) + rivinflx(i,j,irdoc)/2.0 - bgct2d(i,j,jirdet) = bgct2d(i,j,jirdet) + rivinflx(i,j,irdet)/2.0 - - endif - enddo - enddo - - ! Accumulate atmosphere fields and fluxes - call accsrf(jatmco2,atm(1,1,iatmco2),omask,0) - if (use_BOXATM) then - call accsrf(jatmo2 ,atm(1,1,iatmo2),omask,0) - call accsrf(jatmn2 ,atm(1,1,iatmn2),omask,0) - endif - 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) - 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) - 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 - call accsrf(jpco2,pco2d,omask,0) - call accsrf(jpco2m,pco2m,omask,0) - call accsrf(jkwco2khm,kwco2sol,omask,0) - call accsrf(jkwco2,kwco2d,omask,0) - call accsrf(jco2kh,co2sold,omask,0) - call accsrf(jco2khm,co2solm,omask,0) - call accsrf(jsrfphosph,ocetra(1,1,1,iphosph),omask,0) - call accsrf(jsrfoxygen,ocetra(1,1,1,ioxygen),omask,0) - call accsrf(jsrfiron,ocetra(1,1,1,iiron),omask,0) - call accsrf(jsrfano3,ocetra(1,1,1,iano3),omask,0) - call accsrf(jsrfalkali,ocetra(1,1,1,ialkali),omask,0) - call accsrf(jsrfsilica,ocetra(1,1,1,isilica),omask,0) - call accsrf(jsrfdic,ocetra(1,1,1,isco212),omask,0) - call accsrf(jsrfphyto,ocetra(1,1,1,iphy),omask,0) - call accsrf(jsrfph,hi(1,1,1),omask,0) - call accsrf(jdms,ocetra(1,1,1,idms),omask,0) - call accsrf(jexport,expoor,omask,0) - call accsrf(jexpoca,expoca,omask,0) - call accsrf(jexposi,exposi,omask,0) - call accsrf(jdmsprod,intdmsprod,omask,0) - call accsrf(jdms_uv,intdms_uv,omask,0) - call accsrf(jdms_bac,intdms_bac,omask,0) - call accsrf(jintphosy,intphosy,omask,0) - call accsrf(jintdnit,intdnit,omask,0) - call accsrf(jintnfix,intnfix,omask,0) - 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 - call accsrf(jndepfx,ndepflx,omask,0) - call accsrf(joalkfx,oalkflx,omask,0) - - ! Accumulate the diagnostic mass sinking field - IF( domassfluxes ) THEN - call accsrf(jcarflx0100,carflx0100,omask,0) - call accsrf(jbsiflx0100,bsiflx0100,omask,0) - call accsrf(jcalflx0100,calflx0100,omask,0) - call accsrf(jcarflx0500,carflx0500,omask,0) - call accsrf(jbsiflx0500,bsiflx0500,omask,0) - call accsrf(jcalflx0500,calflx0500,omask,0) - call accsrf(jcarflx1000,carflx1000,omask,0) - call accsrf(jbsiflx1000,bsiflx1000,omask,0) - call accsrf(jcalflx1000,calflx1000,omask,0) - call accsrf(jcarflx2000,carflx2000,omask,0) - call accsrf(jbsiflx2000,bsiflx2000,omask,0) - call accsrf(jcalflx2000,calflx2000,omask,0) - call accsrf(jcarflx4000,carflx4000,omask,0) - call accsrf(jbsiflx4000,bsiflx4000,omask,0) - call accsrf(jcalflx4000,calflx4000,omask,0) - call accsrf(jcarflx_bot,carflx_bot,omask,0) - call accsrf(jbsiflx_bot,bsiflx_bot,omask,0) - call accsrf(jcalflx_bot,calflx_bot,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 - 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) - call acclyr(jphosph,ocetra(1,1,1,iphosph),pddpo,1) - call acclyr(joxygen,ocetra(1,1,1,ioxygen),pddpo,1) - call acclyr(jiron,ocetra(1,1,1,iiron),pddpo,1) - call acclyr(jano3,ocetra(1,1,1,iano3),pddpo,1) - call acclyr(jalkali,ocetra(1,1,1,ialkali),pddpo,1) - call acclyr(jsilica,ocetra(1,1,1,isilica),pddpo,1) - call acclyr(jdic,ocetra(1,1,1,isco212),pddpo,1) - call acclyr(jdoc,ocetra(1,1,1,idoc),pddpo,1) - call acclyr(jpoc,ocetra(1,1,1,idet),pddpo,1) - call acclyr(jcalc,ocetra(1,1,1,icalc),pddpo,1) - call acclyr(jopal,ocetra(1,1,1,iopal),pddpo,1) - call acclyr(jn2o,ocetra(1,1,1,ian2o),pddpo,1) - call acclyr(jco3,co3,pddpo,1) - call acclyr(jph,hi,pddpo,1) - call acclyr(jomegaa,OmegaA,pddpo,1) - call acclyr(jomegac,OmegaC,pddpo,1) - call acclyr(jphosy,phosy3d,pddpo,1) - call acclyr(jo2sat,satoxy,pddpo,1) - call acclyr(jprefo2,ocetra(1,1,1,iprefo2),pddpo,1) - call acclyr(jprefpo4,ocetra(1,1,1,iprefpo4),pddpo,1) - 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) - 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 - IF (SUM(jlvlphyto+jlvlgrazer+jlvlphosph+jlvloxygen+jlvliron+ & - & jlvlano3+jlvlalkali+jlvlsilica+jlvldic+jlvldoc+jlvlpoc+jlvlcalc+& - & jlvlopal+jlvln2o+jlvlco3+jlvlph+jlvlomegaa+jlvlomegac+jlvlphosy+& - & jlvlo2sat+jlvlprefo2+jlvlprefpo4+jlvlprefalk+jlvlprefdic+ & - & jlvldicsat+jlvlnatdic+jlvlnatalkali+jlvlnatcalc+jlvlnatco3+ & - & jlvlnatomegaa+jlvlnatomegac+jlvldic13+jlvldic14+jlvld13c+ & - & jlvld14c+jlvlbigd14c+jlvlpoc13+jlvldoc13+jlvlcalc13+jlvlphyto13+& - & jlvlgrazer13+jlvlnos+jlvlwphy+jlvlwnos+jlvleps+jlvlasize+ & - & jlvlcfc11+jlvlcfc12+jlvlsf6+jlvlbromo).NE.0) THEN - DO k=1,kpke - call bgczlv(pddpo,k,ind1,ind2,wghts) - call acclvl(jlvlphyto,ocetra(1,1,1,iphy),k,ind1,ind2,wghts) - call acclvl(jlvlgrazer,ocetra(1,1,1,izoo),k,ind1,ind2,wghts) - call acclvl(jlvlphosph,ocetra(1,1,1,iphosph),k,ind1,ind2,wghts) - call acclvl(jlvloxygen,ocetra(1,1,1,ioxygen),k,ind1,ind2,wghts) - call acclvl(jlvliron,ocetra(1,1,1,iiron),k,ind1,ind2,wghts) - call acclvl(jlvlano3,ocetra(1,1,1,iano3),k,ind1,ind2,wghts) - call acclvl(jlvlalkali,ocetra(1,1,1,ialkali),k,ind1,ind2,wghts) - call acclvl(jlvlsilica,ocetra(1,1,1,isilica),k,ind1,ind2,wghts) - call acclvl(jlvldic,ocetra(1,1,1,isco212),k,ind1,ind2,wghts) - call acclvl(jlvldoc,ocetra(1,1,1,idoc),k,ind1,ind2,wghts) - call acclvl(jlvlpoc,ocetra(1,1,1,idet),k,ind1,ind2,wghts) - call acclvl(jlvlcalc,ocetra(1,1,1,icalc),k,ind1,ind2,wghts) - call acclvl(jlvlopal,ocetra(1,1,1,iopal),k,ind1,ind2,wghts) - call acclvl(jlvln2o,ocetra(1,1,1,ian2o),k,ind1,ind2,wghts) - call acclvl(jlvlco3,co3,k,ind1,ind2,wghts) - call acclvl(jlvlph,hi,k,ind1,ind2,wghts) - call acclvl(jlvlomegaa,OmegaA,k,ind1,ind2,wghts) - call acclvl(jlvlomegac,OmegaC,k,ind1,ind2,wghts) - call acclvl(jlvlphosy,phosy3d,k,ind1,ind2,wghts) - call acclvl(jlvlo2sat,satoxy,k,ind1,ind2,wghts) - call acclvl(jlvlprefo2,ocetra(1,1,1,iprefo2),k,ind1,ind2,wghts) - call acclvl(jlvlprefpo4,ocetra(1,1,1,iprefpo4),k,ind1,ind2,wghts) - 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) - 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 - - - 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)) - endif - - ! Write output if requested - DO l=1,nbgc - nacc_bgc(l)=nacc_bgc(l)+1 - if (bgcwrt(l)) then - if (GLB_INVENTORY(l).ne.0) then - CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,l) - endif - call ncwrt_bgc(l) - nacc_bgc(l)=0 - endif - ENDDO - - atmflx=0. ! nullifying atm flux here to have zero fluxes for stepwise inventory fluxes - ndepflx=0. - oalkflx=0. - rivinflx=0. - - RETURN - END SUBROUTINE ACCFIELDS diff --git a/hamocc/aufr_bgc.F90 b/hamocc/aufr_bgc.F90 deleted file mode 100644 index 0dd24c9d..00000000 --- a/hamocc/aufr_bgc.F90 +++ /dev/null @@ -1,596 +0,0 @@ -! Copyright (C) 2002 Ernst Maier-Reimer, S. Legutke, P. Wetzel -! Copyright (C) 2020 K. Assmann, J. Tjiputra, J. Schwinger, A. Moree -! M. Bentsen, P.-G. Chiu -! -! 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. -! -! 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. -! -! 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 AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & - kplyear,kplmon,kplday,omask,rstfnm) - !****************************************************************************** - ! - !**** *AUFR_BGC* - reads marine bgc restart data. - ! - ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 - ! - ! Modified - ! -------- - ! S.Legutke, *MPI-MaD, HH* 10.04.01 - ! - extra SBR for reading bgc data from the restart file. - ! S.Legutke, *MPI-MaD, HH* 15.08.01 - ! - netCDF version (with cond.comp. PNETCDF) - ! - no use of chemc values from netCDF restart - ! - ! Patrick Wetzel, *MPI-Met, HH* 16.04.02 - ! - read chemcm(i,j,7,12) from netCDF restart - ! - ! J.Schwinger, *GFI, Bergen* 2013-10-21 - ! - removed reading of chemcm and ak* fields - ! - code cleanup, remoded preprocessor option "PNETCDF" - ! and "NOMPI" - ! - ! J.Schwinger, *GFI, Bergen* 2014-05-21 - ! - adapted code for writing of two time level tracer - ! and sediment fields - ! - ! A.Moree, *GFI, Bergen* 2018-04-12 - ! - new version of carbon isotope code - ! - ! J.Tjiputra, *Uni Research, Bergen* 2018-04-12 - ! - added preformed and saturated DIC tracers - ! - ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 - ! - added cappability to restart c-isotopes from scratch (from - ! 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 - ! not found in the restart file. - ! - removed satn2o which is not needed to restart the model - ! - added sediment bypass preprocessor option - ! - ! J.Schwinger, *Uni Research, Bergen* 2018-08-23 - ! - added reading of atmosphere field for BOXATM - ! - ! M. Bentsen, *NORCE, Bergen* 2020-05-03 - ! - changed ocean model from MICOM to BLOM - ! - ! Purpose - ! ------- - ! Read restart data to continue an interrupted integration. - ! - ! Method - ! ------- - ! 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 - ! difference of the offsets of restart files. - ! - ! - !** Interface to ocean model (parameter list): - ! ----------------------------------------- - ! - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. - ! *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 - ! ocean model [mol/kg] - ! *INTEGER* *kplyear* - year in ocean restart date - ! *INTEGER* *kplmon* - month in ocean restart date - ! *INTEGER* *kplday* - day in ocean restart date - ! *REAL* *omask* - land/ocean mask - ! *CHAR* *rstfnm* - restart file name-informations - ! - ! - !************************************************************************** - - use netcdf, only: nf90_global,nf90_noerr,nf90_nowrite,nf90_close,nf90_open,nf90_get_att,nf90_inq_varid - use mod_xc, only: nbdy,mnproc,iqr,jqr,xcbcst,xchalt - use mod_dia, only: iotype - use mo_carbch, only: co2star,co3,hi,satoxy,ocetra,atm,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, & - 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 - use mo_vgrid, only: kbo - use mo_sedmnt, only: sedhpl - use mo_intfcblom, only: sedlay2,powtra2,burial2,atm2 - use mo_param_bgc, only: bifr13,bifr14,c14fac,re1312,re14to,prei13,prei14 - - implicit none - - 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, 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 - REAL :: rco213,rco214,alpha14,beta13,beta14,d13C_atm,d14cat ! cisonew - INTEGER :: ncid,ncstat,ncvarid - -#ifdef PNETCDF -# include -# include - integer*4 ,save :: info=MPI_INFO_NULL - integer :: mpicomm,mpierr,mpireq,mpistat - common/xcmpii/ mpicomm,mpierr,mpireq(4), & - & mpistat(mpi_status_size,4*max(iqr,jqr)) - save /xcmpii/ -#endif - character(len=3) :: stripestr - 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 - ! - testio=0 - IF(mnproc==1 .AND. IOTYPE==0) THEN - - ncstat = NF90_OPEN(rstfnm,NF90_NOWRITE, ncid) - IF ( ncstat .NE. NF90_NOERR ) THEN - CALL xchalt('(AUFR: Problem with netCDF1)') - stop '(AUFR: Problem with netCDF1)' - ENDIF - ! - ! 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)' - ENDIF - restyear = idate(1) - restmonth = idate(2) - restday = idate(3) - restdtoce = idate(4) - ldtbgc = idate(5) - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Date of bgc restart file : ' - WRITE(io_stdo_bgc,*) ' year = ',restyear - WRITE(io_stdo_bgc,*) ' month = ',restmonth - WRITE(io_stdo_bgc,*) ' day = ',restday - WRITE(io_stdo_bgc,*) ' dtoce = ',restdtoce - WRITE(io_stdo_bgc,*) ' dtbgc = ',ldtbgc - WRITE(io_stdo_bgc,*) ' ' - ELSE IF(IOTYPE==1) THEN -#ifdef PNETCDF - testio=1 - write(stripestr,('(i3)')) 16 - write(stripestr2,('(i9)')) 1024*1024 - call mpi_info_create(info,ierr) - call mpi_info_set(info,'romio_ds_read','disable',ierr) - call mpi_info_set(info,'romio_ds_write','disable',ierr) - call mpi_info_set(info,"striping_factor",stripestr,ierr) - call mpi_info_set(info,"striping_unit",stripestr2,ierr) - - ncstat = NFMPI_OPEN(mpicomm,rstfnm,NF_NOWRITE,INFO, ncid) - IF ( ncstat .NE. NF_NOERR ) THEN - CALL xchalt('(AUFR: Problem with netCDF1)') - stop '(AUFR: Problem with netCDF1)' - ENDIF - - ! - ! 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)' - ENDIF - restyear = idate(1) - restmonth = idate(2) - restday = idate(3) - restdtoce = idate(4) - ldtbgc = idate(5) - IF(mnproc==1) THEN - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Date of bgc restart file : ' - WRITE(io_stdo_bgc,*) ' year = ',restyear - WRITE(io_stdo_bgc,*) ' month = ',restmonth - WRITE(io_stdo_bgc,*) ' day = ',restday - WRITE(io_stdo_bgc,*) ' dtoce = ',restdtoce - WRITE(io_stdo_bgc,*) ' dtbgc = ',ldtbgc - WRITE(io_stdo_bgc,*) ' ' - ENDIF -#endif - if(testio .eq. 0) then - CALL xchalt('(AUFR: Problem with namelist iotype)') - stop '(AUFR: Problem with namelist iotype)' - endif - - ENDIF ! mnproc==1 .AND. IOTYPE==0 - - ! - ! Compare with date read from ocean restart file - ! - IF (mnproc.eq.1) THEN - - IF ( kplyear .NE. restyear ) WRITE(io_stdo_bgc,*) & - 'WARNING: restart years in oce/bgc are not the same : ', kplyear,'/',restyear,' !!!' - - IF ( kplmon .NE. restmonth ) WRITE(io_stdo_bgc,*) & - 'WARNING: restart months in oce/bgc are not the same : ',kplmon,'/',restmonth,' !!!' - - IF ( kplday .NE. restday ) WRITE(io_stdo_bgc,*) & - 'WARNING: restart days in oce/bgc are not the same : ', kplday,'/',restday,' !!!' - - ENDIF - - ! 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,'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 - 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,'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 - endif - - ! 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,'sco213',ncvarid) - if(ncstat.ne.nf_noerr) lread_iso=.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 - 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,'bromo',ncvarid) - if(ncstat.ne.nf_noerr) lread_bro=.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 (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 - 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 - ! - ! 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) - CALL read_netcdf_var(ncid,'oxygen',locetra(1,1,1,ioxygen),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'gasnit',locetra(1,1,1,igasnit),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'ano3',locetra(1,1,1,iano3),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'silica',locetra(1,1,1,isilica),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'doc',locetra(1,1,1,idoc),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'phyto',locetra(1,1,1,iphy),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'grazer',locetra(1,1,1,izoo),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'poc',locetra(1,1,1,idet),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'calciu',locetra(1,1,1,icalc),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'opal',locetra(1,1,1,iopal),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'n2o',locetra(1,1,1,ian2o),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'dms',locetra(1,1,1,idms),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'fdust',locetra(1,1,1,ifdust),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'iron',locetra(1,1,1,iiron),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'prefo2',locetra(1,1,1,iprefo2),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'prefpo4',locetra(1,1,1,iprefpo4),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'prefalk',locetra(1,1,1,iprefalk),2*kpke,0,iotype) - 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) - - if (use_cisonew .and. 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 - 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) - endif - if (use_CFC .and. 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 - 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 - endif - if (use_BROMO .and. lread_bro) then - CALL read_netcdf_var(ncid,'bromo',locetra(1,1,1,ibromo),2*kpke,0,iotype) - endif - ! - ! 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. - ! - 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 .and. 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 - ! - ! 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 - endif - - IF(mnproc==1 .AND. IOTYPE==0) THEN - ncstat = NF90_CLOSE(ncid) - ELSE IF(IOTYPE==1) THEN -#ifdef PNETCDF - ncstat = NFMPI_CLOSE(ncid) -#endif - ENDIF - - if (use_cisonew .and. .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 - DO k=1,2*ks - DO j=1,kpje - DO i=1,kpie - IF(omask(i,j) .GT. 0.5) THEN - rco213=locetra(i,j,kbo(i,j),isco213)/(locetra(i,j,kbo(i,j),isco212)+safediv) - rco214=locetra(i,j,kbo(i,j),isco214)/(locetra(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=locetra(i,j,kbo(i,j),isco213)/(locetra(i,j,kbo(i,j),isco212)+safediv) - rco214=locetra(i,j,kbo(i,j),isco214)/(locetra(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 ! .NOT. use_sedbypass - endif ! use_cisonew .and. .NOT. lread_iso - - ! 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 SUBROUTINE AUFR_BGC diff --git a/hamocc/aufw_bgc.F90 b/hamocc/aufw_bgc.F90 deleted file mode 100644 index 20b8c340..00000000 --- a/hamocc/aufw_bgc.F90 +++ /dev/null @@ -1,951 +0,0 @@ -! Copyright (C) 2001 Ernst Maier-Reimer, S. Legutke -! Copyright (C) 2020 K. Assmann, J. Tjiputra, J. Schwinger, A. Moree -! M. Bentsen, P.-G. Chiu -! -! 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. -! -! 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. -! -! 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, & - kplyear,kplmon,kplday,kpldtoce,omask,rstfnm) - !****************************************************************************** - ! - !**** *AUFW_BGC* - write marine bgc restart data. - ! - ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 - ! - ! Modified - ! -------- - ! S.Legutke, *MPI-MaD, HH* 10.04.01 - ! - extra SBR for writing bgc data to the restart file. - ! S.Legutke, *MPI-MaD, HH* 15.08.01 - ! - netCDF version (cond.comp. PNETCDF) - ! - chemcm is multiplied with layer-dependent constant in order - ! to be displayable by ncview. It is not read in AUFR_BGC! - ! - ! J.Schwinger, *GFI, Bergen* 2013-10-21 - ! - tracer field is passed from ocean model for writing now - ! - removed writing of chemcm and ak* fields - ! - code cleanup, removed preprocessor option "PNETCDF" - ! - ! J.Schwinger, *GFI, Bergen* 2014-05-21 - ! - adapted code for writing of two time level tracer and - ! sediment fields - ! - ! A.Moree, *GFI, Bergen* 2018-04-12 - ! - new version of carbon isotope code - ! - ! J.Tjiputra, *Uni Research, Bergen* 2018-04-12 - ! - added preformed and saturated DIC tracers - ! - ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 - ! - removed satn2o which is not needed to restart the model - ! - added sediment bypass preprocessor option - ! - ! J.Schwinger, *Uni Research, Bergen* 2018-08-23 - ! - added writing of atmosphere field for BOXATM - ! - ! M. Bentsen, *NORCE, Bergen* 2020-05-03 - ! - changed ocean model from MICOM to BLOM - ! - ! Purpose - ! ------- - ! Write restart data for continuation of interrupted integration. - ! - ! Method - ! ------- - ! 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)). - ! It can differ from that of the ocean (idate(4)) by the difference - ! of the offsets of restart files. - ! - ! - !** Interface to ocean model (parameter list): - ! ----------------------------------------- - ! - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. - ! *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 - ! ocean model [mol/kg] - ! *REAL* *sedlay2* - initial/restart sediment (two time levels) field - ! *REAL* *powtra2* - initial/restart pore water tracer (two time levels) field - ! *REAL* *burial2* - initial/restart sediment burial (two time levels) field - ! *INTEGER* *kplyear* - year in ocean restart date - ! *INTEGER* *kplmon* - month in ocean restart date - ! *INTEGER* *kplday* - day in ocean restart date - ! *INTEGER* *kpldtoce* - step in ocean restart date - ! *REAL* *omask* - land/ocean mask - ! *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 mod_xc, only: nbdy,itdm,jtdm,mnproc,iqr,jqr,xchalt - use mod_dia, only: iotype - use mo_carbch, only: co2star,co3,hi,satoxy,nathi - use mo_control_bgc, only: io_stdo_bgc,ldtbgc,rmasks,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 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 - REAL, intent(in) :: trc(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy,2*kpke,ntr) - REAL, intent(in) :: omask(kpie,kpje) - INTEGER, intent(in) :: kplyear,kplmon,kplday,kpldtoce - character(len=*), intent(in) :: rstfnm - - ! Local variables - INTEGER :: i,j - REAL :: locetra(kpie,kpje,2*kpke,nocetra) - INTEGER :: errstat - - ! Variables for netcdf - INTEGER :: ncid,ncvarid,ncstat,ncoldmod,ncdimst(4) - INTEGER :: nclatid,nclonid,nclevid,nclev2id,ncksid,ncks2id,nctlvl2id - INTEGER :: idate(5),ierr,testio - REAL :: rmissing - character(len=3) :: stripestr - character(len=9) :: stripestr2 - -#ifdef PNETCDF -# include -# include - integer(kind=MPI_OFFSET_KIND) :: clen - integer*4 ,save :: info=MPI_INFO_NULL - integer :: mpicomm,mpierr,mpireq,mpistat - common/xcmpii/ mpicomm,mpierr,mpireq(4), & - & mpistat(mpi_status_size,4*max(iqr,jqr)) - 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 - !-------------------------------------------------------------------- - ! - testio=0 - ! - ! Initialize local array for writing (locetra) - ! - locetra(:,:,:,:) = trc(1:kpie,1:kpje,:,itrbgc:itrbgc+ntrbgc-1) - - idate(1) = kplyear - idate(2) = kplmon - idate(3) = kplday - 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) - ENDIF - - rmissing = rmasko - ! - ! 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) - IF ( ncstat .NE. NF90_NOERR ) THEN - call xchalt('(AUFW: Problem with netCDF1)') - stop '(AUFW: Problem with netCDF1)' - ENDIF - ELSE IF (IOTYPE==1) THEN -#ifdef PNETCDF - testio=1 - IF(mnproc==1) write(io_stdo_bgc,*) 'BGC RESTART ',rstfnm - write(stripestr,('(i3)')) 16 - write(stripestr2,('(i9)')) 1024*1024 - call mpi_info_create(info,ierr) - call mpi_info_set(info,'romio_ds_read','disable',ierr) - call mpi_info_set(info,'romio_ds_write','disable',ierr) - call mpi_info_set(info,"striping_factor",stripestr,ierr) - call mpi_info_set(info,"striping_unit",stripestr2,ierr) - ncstat = NFMPI_CREATE(mpicomm,rstfnm, & - & IOR(nf_clobber,nf_64bit_offset),info,ncid) - IF ( ncstat .NE. NF_NOERR ) THEN - call xchalt('(AUFW: Problem with PnetCDF1)') - stop '(AUFW: Problem with PnetCDF1)' - ENDIF -#endif - if(testio .eq. 0) then - CALL xchalt('(AUFW: Problem with namelist iotype)') - stop '(AUFW: Problem with namelist iotype)' - endif - - ENDIF - ! - ! 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)' - ENDIF - - ncstat = NF90_DEF_DIM(ncid, 'lat', jtdm, nclatid) - IF ( ncstat .NE. NF90_NOERR ) THEN - call xchalt('(AUFW: Problem with netCDF3)') - stop '(AUFW: Problem with netCDF3)' - ENDIF - - ncstat = NF90_DEF_DIM(ncid, 'depth', kpke, nclevid) - IF ( ncstat .NE. NF90_NOERR ) THEN - call xchalt('(AUFW: Problem with netCDF4)') - stop '(AUFW: Problem with netCDF4)' - ENDIF - - ncstat = NF90_DEF_DIM(ncid, 'depth2', 2*kpke, nclev2id) - IF ( ncstat .NE. NF90_NOERR ) THEN - call xchalt('(AUFW: Problem with netCDF5)') - stop '(AUFW: Problem with netCDF5)' - ENDIF - - ncstat = NF90_DEF_DIM(ncid, 'nks', ks, ncksid) - IF ( ncstat .NE. NF90_NOERR ) THEN - call xchalt('(AUFW: Problem with netCDF6)') - stop '(AUFW: Problem with netCDF6)' - ENDIF - - ncstat = NF90_DEF_DIM(ncid, 'nks2', 2*ks, ncks2id) - IF ( ncstat .NE. NF90_NOERR ) THEN - call xchalt('(AUFW: Problem with netCDF7)') - stop '(AUFW: Problem with netCDF7)' - ENDIF - - ncstat = NF90_DEF_DIM(ncid, 'tlvl2', 2, nctlvl2id) - IF ( ncstat .NE. NF90_NOERR ) THEN - call xchalt('(AUFW: Problem with netCDF8)') - stop '(AUFW: Problem with netCDF8)' - ENDIF - - ELSE IF (IOTYPE==1) THEN -#ifdef PNETCDF - clen=itdm - ncstat = NFMPI_DEF_DIM(ncid, 'lon', clen, nclonid) - IF ( ncstat .NE. NF_NOERR ) THEN - call xchalt('(AUFW: Problem with PnetCDF2)') - stop '(AUFW: Problem with PnetCDF2)' - ENDIF - - clen=jtdm - ncstat = NFMPI_DEF_DIM(ncid, 'lat', clen, nclatid) - IF ( ncstat .NE. NF_NOERR ) THEN - call xchalt('(AUFW: Problem with PnetCDF3)') - stop '(AUFW: Problem with PnetCDF3)' - ENDIF - - clen=kpke - ncstat = NFMPI_DEF_DIM(ncid, 'depth', clen, nclevid) - IF ( ncstat .NE. NF_NOERR ) THEN - call xchalt('(AUFW: Problem with PnetCDF4)') - stop '(AUFW: Problem with PnetCDF4)' - ENDIF - - clen=2*kpke - ncstat = NFMPI_DEF_DIM(ncid, 'depth2', clen, nclev2id) - IF ( ncstat .NE. NF_NOERR ) THEN - call xchalt('(AUFW: Problem with PnetCDF5)') - stop '(AUFW: Problem with PnetCDF5)' - ENDIF - - clen=ks - ncstat = NFMPI_DEF_DIM(ncid, 'nks', clen, ncksid) - IF ( ncstat .NE. NF_NOERR ) THEN - call xchalt('(AUFW: Problem with PnetCDF6)') - stop '(AUFW: Problem with PnetCDF6)' - ENDIF - - clen=2*ks - ncstat = NFMPI_DEF_DIM(ncid, 'nks2', clen, ncks2id) - IF ( ncstat .NE. NF_NOERR ) THEN - call xchalt('(AUFW: Problem with PnetCDF7)') - stop '(AUFW: Problem with PnetCDF7)' - ENDIF - - clen=2 - ncstat = NFMPI_DEF_DIM(ncid, 'tlvl2', clen, nctlvl2id) - IF ( ncstat .NE. NF_NOERR ) THEN - call xchalt('(AUFW: Problem with PnetCDF8)') - stop '(AUFW: Problem with PnetCDF8)' - ENDIF -#endif - ENDIF !mnproc==1 .AND. IOTYPE==0 - - ! - ! Define global attributes - ! ---------------------------------------------------------------------- - ! - IF (mnproc==1 .AND. IOTYPE==0) THEN - - ncstat = NF90_PUT_ATT(ncid, NF90_GLOBAL,'title' & - &, 'Restart data for marine bgc modules') - IF ( ncstat .NE. NF90_NOERR ) THEN - call xchalt('(AUFW: Problem with netCDF9)') - stop '(AUFW: Problem with netCDF9)' - ENDIF - - ncstat = NF90_PUT_ATT(ncid, NF90_GLOBAL,'history' & - &, 'Restart data for marine bgc modules') - IF ( ncstat .NE. NF90_NOERR ) THEN - call xchalt('(AUFW: Problem with netCDF10)') - stop '(AUFW: Problem with netCDF10)' - ENDIF - - ncstat = NF90_PUT_ATT(ncid, NF90_GLOBAL,'conventions' & - &,'COARDS') - IF ( ncstat .NE. NF90_NOERR ) THEN - call xchalt('(AUFW: Problem with netCDF11)') - stop '(AUFW: Problem with netCDF11)' - ENDIF - - ncstat = NF90_PUT_ATT(ncid, NF90_GLOBAL,'source' & - &, 'Marine bgc model output HOPC68/grob') - IF ( ncstat .NE. NF90_NOERR ) THEN - call xchalt('(AUFW: Problem with netCDF12)') - stop '(AUFW: Problem with netCDF12)' - ENDIF - - ncstat = NF90_PUT_ATT(ncid, NF90_GLOBAL, 'date', idate) - IF ( ncstat .NE. NF90_NOERR ) THEN - call xchalt('(AUFW: Problem with netCDF13)') - stop '(AUFW: Problem with netCDF13)' - ENDIF - - ELSE IF (IOTYPE==1) THEN -#ifdef PNETCDF - clen=len('Restart data for marine bgc modules') - ncstat = NFMPI_PUT_ATT_TEXT(ncid, NF_GLOBAL,'title' & - &, clen,'Restart data for marine bgc modules') - IF ( ncstat .NE. NF_NOERR ) THEN - call xchalt('(AUFW: Problem with PnetCDF9)') - stop '(AUFW: Problem with PnetCDF9)' - ENDIF - - clen=len('Restart data for marine bgc modules') - ncstat = NFMPI_PUT_ATT_TEXT(ncid, NF_GLOBAL,'history' & - &, clen,'Restart data for marine bgc modules') - IF ( ncstat .NE. NF_NOERR ) THEN - call xchalt('(AUFW: Problem with PnetCDF10)') - stop '(AUFW: Problem with PnetCDF10)' - ENDIF - - clen=6 - ncstat = NFMPI_PUT_ATT_TEXT(ncid, NF_GLOBAL,'conventions' & - &,clen, 'COARDS') - IF ( ncstat .NE. NF_NOERR ) THEN - call xchalt('(AUFW: Problem with PnetCDF11)') - stop '(AUFW: Problem with PnetCDF11)' - ENDIF - - clen=len('Marine bgc model output HOPC68/grob') - ncstat = NFMPI_PUT_ATT_TEXT(ncid, NF_GLOBAL,'source' & - &,clen, 'Marine bgc model output HOPC68/grob') - IF ( ncstat .NE. NF_NOERR ) THEN - call xchalt('(AUFW: Problem with PnetCDF12)') - stop '(AUFW: Problem with PnetCDF12)' - ENDIF - - clen=5 - ncstat = NFMPI_PUT_ATT_INT(ncid, NF_GLOBAL, 'date', & - & nf_int, clen, idate) - IF ( ncstat .NE. NF_NOERR ) THEN - call xchalt('(AUFW: Problem with netCDF13)') - stop '(AUFW: Problem with netCDF13)' - - ENDIF -#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,'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,'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,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,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,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,'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,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,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,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,'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,6,'dicsat',3,ncdimst,ncvarid, & - & 6,'mol/kg',13,'Saturated dic', & - rmissing,31,io_stdo_bgc) - - 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) - - CALL NETCDF_DEF_VARDB(ncid,6,'sco214',3,ncdimst,ncvarid, & - & 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) - - CALL NETCDF_DEF_VARDB(ncid,5,'doc14',3,ncdimst,ncvarid, & - & 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) - - CALL NETCDF_DEF_VARDB(ncid,5,'poc14',3,ncdimst,ncvarid, & - & 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) - - 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) - - CALL NETCDF_DEF_VARDB(ncid,8,'grazer14',3,ncdimst,ncvarid, & - & 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) - - CALL NETCDF_DEF_VARDB(ncid,8,'calciu14',3,ncdimst,ncvarid, & - & 7,'molC/kg',19,'Calcium carbonate14', & - & rmissing,43,io_stdo_bgc) - endif - 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) - - CALL NETCDF_DEF_VARDB(ncid,5,'adust',3,ncdimst,ncvarid, & - & 4,'g/kg',15,'Aggregated dust', & - & rmissing,45,io_stdo_bgc) - endif - if (use_CFC) then - CALL NETCDF_DEF_VARDB(ncid,5,'cfc11',3,ncdimst,ncvarid, & - & 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) - - CALL NETCDF_DEF_VARDB(ncid,3,'sf6',3,ncdimst,ncvarid, & - & 6,'mol/kg',4,'SF-6', & - & rmissing,49,io_stdo_bgc) - endif - 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) - - CALL NETCDF_DEF_VARDB(ncid,9,'natalkali',3,ncdimst,ncvarid, & - & 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 - 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 - - 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,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) - - 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 - ! - ! Define variables : sediment - ! ---------------------------------------------------------------------- - ! - if (.not. use_sedbypass) then - - IF((mnproc==1 .AND. IOTYPE==0) .OR. IOTYPE==1) THEN - 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) - - CALL NETCDF_DEF_VARDB(ncid,6,'sssc12',3,ncdimst,ncvarid, & - & 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) - - CALL NETCDF_DEF_VARDB(ncid,6,'ssster',3,ncdimst,ncvarid, & - & 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) - - CALL NETCDF_DEF_VARDB(ncid,6,'powaal',3,ncdimst,ncvarid, & - & 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) - - CALL NETCDF_DEF_VARDB(ncid,6,'powaox',3,ncdimst,ncvarid, & - & 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) - - 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) - - 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) - - 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,'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,'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 - - IF((mnproc==1 .AND. IOTYPE==0) .OR. IOTYPE==1) THEN - 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 - ! ---------------------------------------------------------------------- - ! - 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,7,'bur_o12',3,ncdimst,ncvarid, & - & 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) - - 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) - - 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) - - 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) - endif - - endif ! not sedbypass - ! - ! Define variables: atmosphere - ! ---------------------------------------------------------------------- - ! - if (use_BOXATM) then - - 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) - - CALL NETCDF_DEF_VARDB(ncid,5,'atmo2',3,ncdimst,ncvarid, & - & 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) - - 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) - endif - 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) - endif - endif ! 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)' - ENDIF - ! - ! Set fill mode - ! ---------------------------------------------------------------------- - ! - ncstat = NF90_SET_FILL(ncid,NF90_NOFILL, ncoldmod) - IF ( ncstat .NE. NF90_NOERR ) THEN - call xchalt('(AUFW: Problem with netCDF97)') - stop '(AUFW: Problem with netCDF97)' - ENDIF - - 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) - 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) - endif - 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 - 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 - 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 - 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) - if (use_natDIC) then - CALL write_netcdf_var(ncid,'nathi',nathi(1,1,1),kpke,0) - endif - ! - ! 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) - CALL write_netcdf_var(ncid,'ssster',sedlay2(1,1,1,issster),2*ks,0) - CALL write_netcdf_var(ncid,'bur_o12',burial2(1,1,1,issso12),2,0) - CALL write_netcdf_var(ncid,'bur_c12',burial2(1,1,1,isssc12),2,0) - CALL write_netcdf_var(ncid,'bur_sil',burial2(1,1,1,issssil),2,0) - CALL write_netcdf_var(ncid,'bur_clay',burial2(1,1,1,issster),2,0) - CALL write_netcdf_var(ncid,'sedhpl',sedhpl(1,1,1),ks,0) - CALL write_netcdf_var(ncid,'powaic',powtra2(1,1,1,ipowaic),2*ks,0) - CALL write_netcdf_var(ncid,'powaal',powtra2(1,1,1,ipowaal),2*ks,0) - CALL write_netcdf_var(ncid,'powaph',powtra2(1,1,1,ipowaph),2*ks,0) - CALL write_netcdf_var(ncid,'powaox',powtra2(1,1,1,ipowaox),2*ks,0) - 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) - 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) - endif - endif - ! - ! 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) - 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) - endif - if (use_natDIC) then - 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 -#ifdef PNETCDF - 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 - WRITE(io_stdo_bgc,*) 'End of AUFW_BGC' - WRITE(io_stdo_bgc,*) '***************' - ENDIF - - RETURN -END SUBROUTINE AUFW_BGC diff --git a/hamocc/cyano.F90 b/hamocc/cyano.F90 deleted file mode 100644 index fc98f98e..00000000 --- a/hamocc/cyano.F90 +++ /dev/null @@ -1,128 +0,0 @@ -! Copyright (C) 2001 Ernst Maier-Reimer, S. Legutke -! Copyright (C) 2020 J. Schwinger, I. Kriest -! -! 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. -! -! 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. -! -! 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 CYANO(kpie,kpje,kpke,kbnd,pddpo,omask,ptho) - !********************************************************************** - ! - !**** *CYANO* - . - ! - ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 - ! - ! Modified - ! -------- - ! S.Legutke, *MPI-MaD, HH* 10.04.01 - ! - included : surface reduction of gaseous nitrogen - ! - ! I.Kriest, *GEOMAR, Kiel* 2016-08-11 - ! - included T-dependence of cyanobacteria growth - ! - modified oxygen stoichiometry for N2-Fixation - ! - ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 - ! - moved accumulation of all output fields to seperate subroutine, - ! related code-restructuring - ! - added reduction of alkalinity through N-fixation - ! - ! Purpose - ! ------- - ! Nitrogen-fixation by cyano bacteria, followed by remineralisation - ! and nitrification - ! - ! Method: - ! ------ - ! - ! - !** Interface to ocean model (parameter list): - ! ----------------------------------------- - ! - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. - ! *INTEGER* *kbnd* - nb of halo grid points - ! *REAL* *ptho* - potential temperature. - ! - ! Externals - ! --------- - ! . - !********************************************************************** - - use mo_vgrid, only: kmle - use mo_carbch, only: ocetra - use mo_param_bgc, only: bluefix,rnit,tf0,tf1,tf2,tff - use mo_param1_bgc, only: ialkali,iano3,igasnit,iphosph,ioxygen,inatalkali - use mo_biomod, only: intnfix - use mo_control_bgc, only: use_natDIC - - implicit none - - INTEGER, intent(in) :: kpie,kpje,kpke,kbnd - REAL, intent(in) :: pddpo(kpie,kpje,kpke) - REAL, intent(in) :: omask(kpie,kpje) - REAL, intent(in) :: ptho(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) - - ! Local variables - INTEGER :: i,j,k - REAL :: oldocetra,dano3 - REAL :: ttemp,nfixtfac - - intnfix(:,:)=0.0 - - ! - ! N-fixation by cyano bacteria (followed by remineralisation and nitrification), - ! it is assumed here that this process is limited to the mixed layer - ! - DO j=1,kpje - DO i=1,kpie - IF(omask(i,j).gt.0.5) THEN - DO k=1,kmle(i,j) - IF(ocetra(i,j,k,iano3).LT.(rnit*ocetra(i,j,k,iphosph))) THEN - - oldocetra = ocetra(i,j,k,iano3) - ttemp = min(40.,max(-3.,ptho(i,j,k))) - - ! Temperature dependence of nitrogen fixation, Kriest and Oschlies 2015. - nfixtfac = MAX(0.0,tf2*ttemp*ttemp + tf1*ttemp + tf0)/tff - - ocetra(i,j,k,iano3)=ocetra(i,j,k,iano3)*(1-bluefix*nfixtfac) & - & + bluefix*nfixtfac*rnit*ocetra(i,j,k,iphosph) - - dano3=ocetra(i,j,k,iano3)-oldocetra - - ocetra(i,j,k,igasnit)=ocetra(i,j,k,igasnit)-dano3*(1./2.) - - ! Note: to fix one mole N2 requires: N2+H2O+y*O2 = 2* HNO3 <-> y=2.5 mole O2. - ! I.e., to release one mole HNO3 = H+ + NO3- requires 1.25 mole O2 - ocetra(i,j,k,ioxygen)=ocetra(i,j,k,ioxygen)-dano3*1.25 - - ! 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 - if (use_natDIC) then - ocetra(i,j,k,inatalkali)=ocetra(i,j,k,inatalkali)-dano3 - endif - - intnfix(i,j) = intnfix(i,j) + & - & (ocetra(i,j,k,iano3)-oldocetra)*pddpo(i,j,k) - - ENDIF - ENDDO - ENDIF - ENDDO - ENDDO - -END SUBROUTINE CYANO diff --git a/hamocc/dipowa.F90 b/hamocc/dipowa.F90 deleted file mode 100644 index 2a0230fb..00000000 --- a/hamocc/dipowa.F90 +++ /dev/null @@ -1,201 +0,0 @@ -! Copyright (C) 2001 Ernst Maier-Reimer, S. Legutke -! Copyright (C) 2020 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. -! -! 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. -! -! 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 dipowa(kpie,kpje,kpke,omask,lspin) - !********************************************************************** - ! - !**** *DIPOWA* - 'diffusion of pore water' - ! vertical diffusion of sediment pore water tracers - ! - ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 - ! - ! Modified - ! -------- - ! S.Legutke, *MPI-MaD, HH* 10.04.01 - ! - all npowtra-1 properties are diffused in 1 go. - ! js: not mass conserving check c13/powtra/ocetra - ! - ! Purpose - ! ------- - ! calculate vertical diffusion of sediment pore water properties - ! and diffusive flux through the ocean/sediment interface. - ! integration. - ! - ! Method - ! ------- - ! implicit formulation; - ! constant diffusion coefficient : 1.e-9 set in ini_sedmnt in mo_sedmnt - ! diffusion coefficient : zcoefsu/zcoeflo for upper/lower - ! sediment layer boundary. - ! - !** Interface. - ! ---------- - ! - ! *CALL* *DIPOWA* - ! - ! Externals - ! --------- - ! none. - ! - !********************************************************************** - - use mo_carbch, only: ocetra, sedfluxo - use mo_sedmnt, only: powtra,porwat,porwah,seddw,zcoefsu,zcoeflo - use mo_param1_bgc, only: ks,npowtra,map_por2octra - use mo_vgrid, only: kbo,bolay - ! cisonew - use mo_param1_bgc, only: ipowc13,ipowc14,isco213,isco214 - ! natDIC - use mo_param1_bgc, only: ialkali,inatalkali,inatsco212,isco212 - use mo_control_bgc, only: use_natDIC - - implicit none - - integer, intent(in) :: kpie, kpje, kpke - real, intent(in) :: omask(kpie,kpje) - logical, intent(in) :: lspin - - ! Local variables - integer :: i,j,k,l,iv - integer :: iv_oc ! index of ocetra in powtra loop - - real :: sedb1(kpie,0:ks,npowtra) ! ???? - real :: tredsy(kpie,0:kpke,3) ! redsy for 'reduced system'? - real :: aprior ! start value of oceanic tracer in bottom layer - - - !$OMP PARALLEL DO & - !$OMP&PRIVATE(i,k,iv,l,tredsy,sedb1,aprior,iv_oc) - j_loop: do j=1,kpje - - k = 0 - do i = 1,kpie - tredsy(i,k,1) = zcoefsu(i,j,k) - tredsy(i,k,3) = zcoeflo(i,j,k) - tredsy(i,k,2) = bolay(i,j) - tredsy(i,k,1) - tredsy(i,k,3) - ! dz(kbo) - diff upper - diff lower - enddo - - k = 0 - do iv = 1,npowtra ! loop over pore water tracers - iv_oc = map_por2octra(iv) - do i = 1,kpie - sedb1(i,k,iv) = 0. - if (omask(i,j) > 0.5) then - sedb1(i,k,iv) = ocetra(i,j,kbo(i,j),iv_oc) * bolay(i,j) - ! tracer_concentration(kbo) * dz(kbo) - endif - enddo - enddo - - do k = 1,ks - do i = 1,kpie - tredsy(i,k,1) = zcoefsu(i,j,k) - tredsy(i,k,3) = zcoeflo(i,j,k) - tredsy(i,k,2) = seddw(k)*porwat(i,j,k) -tredsy(i,k,1) -tredsy(i,k,3) - enddo - enddo - - do iv = 1,npowtra - do k = 1,ks - do i = 1,kpie - ! tracer_concentration(k[1:ks]) * porewater fraction(k) * dz(k) - sedb1(i,k,iv) = powtra(i,j,k,iv) * porwat(i,j,k) * seddw(k) - enddo - enddo - enddo - - do k = 1,ks - do i = 1,kpie - if (omask(i,j) > 0.5) then - ! this overwrites tredsy(k=0) for k=1 - tredsy(i,k-1,1) = tredsy(i,k,1) / tredsy(i,k-1,2) - ! diff upper / conc (k-1) - tredsy(i,k,2) = tredsy(i,k,2) & - & - tredsy(i,k-1,3) * tredsy(i,k,1) / tredsy(i,k-1,2) - ! concentration - diff lower * diff upper / conc(k-1) - endif - enddo - enddo - - ! diffusion from above - do iv = 1,npowtra - do k = 1,ks - do i = 1,kpie - sedb1(i,k,iv) = sedb1(i,k,iv) - tredsy(i,k-1,1) * sedb1(i,k-1,iv) - enddo - enddo - enddo - - ! sediment bottom layer - k = ks - do iv = 1,npowtra - do i = 1,kpie - if (omask(i,j) > 0.5) then - powtra(i,j,k,iv) = sedb1(i,k,iv) / tredsy(i,k,2) - endif - enddo - enddo - - ! sediment column - do iv = 1,npowtra - do k = 1,ks-1 - l = ks-k - do i = 1,kpie - if (omask(i,j) > 0.5) then - powtra(i,j,l,iv) = ( sedb1(i,l,iv) & - & - tredsy(i,l,3) * powtra(i,j,l+1,iv) ) / tredsy(i,l,2) - endif - enddo - enddo - enddo - - if(.not. lspin) THEN - ! sediment ocean interface - do iv = 1, npowtra - iv_oc = map_por2octra(iv) - do i = 1,kpie - l = 0 - if (omask(i,j) > 0.5) then - aprior = ocetra(i,j,kbo(i,j),iv_oc) - ocetra(i,j,kbo(i,j),iv_oc) = & - & ( sedb1(i,l,iv) - tredsy(i,l,3) * powtra(i,j,l+1,iv) ) & - & / tredsy(i,l,2) - - ! diffusive fluxes (positive downward) - sedfluxo(i,j,iv) = sedfluxo(i,j,iv) & - & -(ocetra(i,j,kbo(i,j),iv_oc) - aprior)* bolay(i,j) - 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 - endif - endif - enddo - enddo - - endif ! .not. lspin - - enddo j_loop - -end subroutine dipowa diff --git a/hamocc/get_cfc.F90 b/hamocc/get_cfc.F90 deleted file mode 100644 index 8ed95cb0..00000000 --- a/hamocc/get_cfc.F90 +++ /dev/null @@ -1,188 +0,0 @@ -! Copyright (C) 2020 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. -! -! 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. -! -! 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 get_cfc(kplyear,atm_cfc11_nh,atm_cfc12_nh,atm_sf6_nh, & - & atm_cfc11_sh,atm_cfc12_sh,atm_sf6_sh) - ! - !********************************************************************** - ! - !**** *GET_CFC* - . - ! - ! Jerry Tjiputra *BCCR* 05.12.2012 - ! - use mo_control_bgc, only: io_stdo_bgc - use mod_xc, only: mnproc - - implicit none - - INTEGER :: i,kplyear,start_yr - INTEGER :: yr_dat(105) - REAL :: atm_cfc11_nh,atm_cfc12_nh,atm_sf6_nh, & - & atm_cfc11_sh,atm_cfc12_sh,atm_sf6_sh - REAL :: cfc_11_nh(105),cfc_12_nh(105),sf_6_nh(105), & - & cfc_11_sh(105),cfc_12_sh(105),sf_6_sh(105) - - INTEGER, SAVE :: kplyear_old = 0 - - ! ****************************************************************** - ! Data from EMil Jeansson (Bullister, 2008; Walker et al. 2000; Maiss and Brenninkmeijer (1998) - ! First (last) data represents year 1910.5 (2014.5), Units are all in [ppt] - DATA cfc_11_nh & - & / 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.1, 0.1, 0.1, 0.2, 0.4, 0.7, & - & 1.01, 1.51, 2.21, 3.02, 4.12, 5.33, 6.83, 8.14, 9.45,11.06, & - & 13.27,16.18,19.60,23.72,28.44,33.67,39.40,46.03,53.77,62.41, & - & 72.06, 82.71, 94.87, 108.34, 121.41, & - & 133.97, 145.93, 156.58, 168.34, 176.68, & - & 184.32, 191.46, 199.30, 208.04, 217.99, & - & 229.35, 241.61, 252.86, 259.30, 265.83, & - & 268.24, 268.14, 269.55, 269.65, 268.34, & - & 266.93, 265.73, 264.52, 263.12, 261.71, & - & 260.00, 258.19, 256.18, 253.97, 251.96, & - & 249.55, 247.54, 245.63, 243.61, 241.33, & - & 239.41, 236.60, 235.08, 233.55/ - - DATA cfc_11_sh & - & / 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.1, 0.1, 0.1, 0.2, 0.4, & - & 0.7, 1.01, 1.51, 2.21, 3.02, 4.02, 5.23, 6.53, 7.84, 9.15, & - & 10.85,13.07,15.78,19.20,23.12,27.64,32.66,38.29,44.82,52.26, & - & 60.70, 69.95, 80.40, 92.16, 104.72, & - & 117.09, 129.35, 140.80, 148.74, 159.30, & - & 167.84, 176.08, 184.52, 192.46, 202.01, & - & 211.36, 222.21, 233.27, 242.11, 251.06, & - & 256.68, 260.80, 262.51, 263.72, 263.22, & - & 262.91, 262.01, 261.01, 259.90, 258.29, & - & 256.98, 255.08, 253.27, 251.36, 249.15, & - & 247.34, 245.03, 243.12, 241.07, 239.19, & - & 236.92, 234.60, 233.29, 231.97/ - - DATA cfc_12_nh & - & / 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.1, 0.1, 0.2, 0.3, 0.4, & - & 0.5, 0.7, 0.9, 1.2, 1.7, 2.3, 3.4, 4.8, 6.1, 7.6, & - & 9.2, 11.0, 12.8, 15.0, 17.4, 20.2, 23.4, 26.8, 30.5, 35.0, & - & 40.0, 45.8, 52.5, 60.4, 69.3, 79.2, 90.3,102.8,116.8,132.00, & - & 148.40, 166.10, 185.80, 207.10, 228.20, & - & 248.10, 266.90, 284.30, 306.10, 323.20, & - & 339.60, 353.40, 369.00, 385.70, 403.40, & - & 424.30, 444.00, 465.40, 483.60, 497.70, & - & 506.00, 516.30, 523.20, 528.50, 533.40, & - & 537.30, 540.10, 542.90, 544.40, 545.90, & - & 546.50, 546.70, 546.70, 545.70, 544.90, & - & 543.10, 541.10, 538.60, 536.11, 533.30, & - & 530.67, 527.16, 525.26, 523.36/ - - DATA cfc_12_sh & - & / 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.1, 0.1, 0.2, 0.3, & - & 0.4, 0.5, 0.7, 0.9, 1.2, 1.7, 2.4, 3.4, 4.7, 6.0, & - & 7.4, 9.0, 10.7, 12.6, 14.7, 17.1, 19.9, 23.0, 26.3, 30.1, & - & 34.4, 39.4, 45.1, 51.8, 59.5, 68.2, 77.9, 88.8,101.1,114.7, & - & 129.6,145.7,163.3,182.5,202.9,223.2,242.7,261.2,273.5,292.3, & - & 308.8,325.5,342.6,359.4,378.2,396.5,416.3,435.8,454.4,472.7, & - & 487.3,498.3,507.0,514.8,521.0,526.5,530.8,534.3,537.2,539.0, & - & 540.6, 541.3, 541.6, 541.5, 540.7, & - & 539.8, 538.1, 536.2, 533.53, 530.94, & - & 528.47, 525.88, 523.48, 521.08/ - - DATA sf_6_nh & - & / 0.00, & - & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & - & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & - & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & - & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & - & 0.000, 0.000, 0.042, 0.043, 0.043, & - & 0.044, 0.046, 0.048, 0.051, 0.055, & - & 0.061, 0.068, 0.078, 0.091, 0.109, & - & 0.131, 0.155, 0.181, 0.207, 0.235, & - & 0.266, 0.301, 0.341, 0.386, 0.438, & - & 0.501, 0.579, 0.665, 0.766, 0.887, & - & 1.011, 1.141, 1.273, 1.409, 1.562, & - & 1.722, 1.892, 2.063, 2.237, 2.427, & - & 2.640, 2.868, 3.104, 3.350, 3.600, & - & 3.861, 4.080, 4.262, 4.485, 4.690, & - & 4.909, 5.135, 5.360, 5.580, 5.795, & - & 6.034, 6.324, 6.613, 6.876, 7.191, & - & 7.439, 7.715, 8.066, 8.417/ - - DATA sf_6_sh & - & / 0.00, & - & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & - & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & - & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & - & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & - & 0.000, 0.000, 0.039, 0.039, 0.040, & - & 0.041, 0.042, 0.044, 0.047, 0.051, & - & 0.056, 0.062, 0.071, 0.084, 0.100, & - & 0.120, 0.142, 0.166, 0.190, 0.215, & - & 0.243, 0.276, 0.312, 0.354, 0.401, & - & 0.459, 0.531, 0.610, 0.703, 0.813, & - & 0.927, 1.046, 1.167, 1.292, 1.432, & - & 1.579, 1.735, 1.892, 2.051, 2.225, & - & 2.420, 2.629, 2.846, 3.071, 3.300, & - & 3.560, 3.824, 4.026, 4.262, 4.471, & - & 4.657, 4.887, 5.081, 5.305, 5.513, & - & 5.749, 6.028, 6.286, 6.576, 6.856, & - & 7.159, 7.424, 7.754, 8.084/ - - start_yr=1910 - do i=1,105 - yr_dat(i)=start_yr+i-1 - enddo - - ! ****************************************************************** - !if (kplyear.lt.start_yr) then - atm_cfc11_nh=0.0 - atm_cfc11_sh=0.0 - atm_cfc12_nh=0.0 - atm_cfc12_sh=0.0 - atm_sf6_nh=0.0 - atm_sf6_sh=0.0 - - do i=1,105 - if (kplyear.eq.yr_dat(i)) then - atm_cfc11_nh=cfc_11_nh(i) - atm_cfc11_sh=cfc_11_sh(i) - atm_cfc12_nh=cfc_12_nh(i) - atm_cfc12_sh=cfc_12_sh(i) - atm_sf6_nh=sf_6_nh(i) - atm_sf6_sh=sf_6_sh(i) - endif - enddo - - IF (mnproc.EQ.1 .AND. kplyear.GT.kplyear_old) THEN - write(io_stdo_bgc,*) 'ATM NH CFC11, CFC12, SF6=', & - & kplyear,atm_cfc11_nh,atm_cfc12_nh,atm_sf6_nh - write(io_stdo_bgc,*) 'ATM SH CFC11, CFC12, SF6=', & - & kplyear,atm_cfc11_sh,atm_cfc12_sh,atm_sf6_sh - kplyear_old = kplyear - ENDIF - - RETURN -END SUBROUTINE get_cfc diff --git a/hamocc/hamocc4bcm.F90 b/hamocc/hamocc4bcm.F90 deleted file mode 100644 index d2b7e04d..00000000 --- a/hamocc/hamocc4bcm.F90 +++ /dev/null @@ -1,422 +0,0 @@ -! Copyright (C) 2001 Ernst Maier-Reimer -! 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. -! -! 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. -! -! 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 HAMOCC4BCM(kpie,kpje,kpke,kbnd,kplyear,kplmon,kplday,kldtday,& - pdlxp,pdlyp,pddpo,prho,pglat,omask, & - dust,rivin,ndep,oafx,pi_ph, & - pfswr,psicomo,ppao,pfu10,ptho,psao, & - patmco2,pflxco2,pflxdms,patmbromo,pflxbromo) - !****************************************************************************** - ! - ! HAMOCC4BGC - main routine of iHAMOCC. - ! - ! Modified - ! -------- - ! J.Schwinger *GFI, Bergen* 2013-10-21 - ! - added GNEWS2 option for riverine input of carbon and nutrients - ! - code cleanup - ! - ! J.Schwinger *GFI, Bergen* 2014-05-21 - ! - moved copying of tracer field to ocetra to micom2hamocc - ! and hamocc2micom - ! - ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 - ! - moved accumulation of all output fields to seperate subroutine, - ! related code-restructuring - ! - added sediment bypass preprocessor option - ! - ! J.Schwinger, *NORCE Climate, Bergen* 2020-05-28 - ! - restructuring of iHAMOCC code, cleanup parameter list - ! - boundary conditions (dust, riverinput, N-deposition) are now passed as - ! an argument - ! - ! Parameter list: - ! --------------- - ! - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. - ! *INTEGER* *kbnd* - nb of halo grid points. - ! *INTEGER* *kplyear* - current year. - ! *INTEGER* *kplmon* - current month. - ! *INTEGER* *kplday* - current day. - ! *INTEGER* *kldtday* - number of time step in current day. - ! *REAL* *pdlxp* - size of grid cell (longitudinal) [m]. - ! *REAL* *pdlyp* - size of grid cell (latitudinal) [m]. - ! *REAL* *pddpo* - size of grid cell (depth) [m]. - ! *REAL* *prho* - density [kg/m^3]. - ! *REAL* *pglat* - latitude of grid cells [deg north]. - ! *REAL* *omask* - land/ocean mask. - ! *REAL* *dust* - dust deposition flux [kg/m2/month]. - ! *REAL* *rivin* - riverine input [kmol m-2 yr-1]. - ! *REAL* *ndep* - nitrogen deposition [kmol m-2 yr-1]. - ! *REAL* *oaflx* - alkalinity flux from alkalinization [kmol m-2 yr-1] - ! *REAL* *pfswr* - solar radiation [W/m**2]. - ! *REAL* *psicomo* - sea ice concentration - ! *REAL* *ppao* - sea level pressure [Pascal]. - ! *REAL* *pfu10* - absolute wind speed at 10m height [m/s] - ! *REAL* *ptho* - potential temperature [deg C]. - ! *REAL* *psao* - salinity [psu.]. - ! *REAL* *patmco2* - atmospheric CO2 concentration [ppm] used in - ! fully coupled mode (prognostic/diagnostic CO2). - ! *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. - ! - !****************************************************************************** - use mod_xc, only: mnproc - 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_BROMO, use_CFC, use_PBGC_CK_TIMESTEP,& - use_BOXATM, use_sedbypass,ocn_co2_type - 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 - use mo_boxatm, only: update_boxatm - - implicit none - - INTEGER, intent(in) :: kpie,kpje,kpke,kbnd - INTEGER, intent(in) :: kplyear,kplmon,kplday,kldtday - REAL, intent(in) :: pdlxp (kpie,kpje) - REAL, intent(in) :: pdlyp (kpie,kpje) - REAL, intent(in) :: pddpo (kpie,kpje,kpke) - REAL, intent(in) :: prho (kpie,kpje,kpke) - REAL, intent(in) :: pglat (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - REAL, intent(in) :: omask (kpie,kpje) - REAL, intent(in) :: dust (kpie,kpje) - REAL, intent(in) :: rivin (kpie,kpje,nriv) - REAL, intent(in) :: ndep (kpie,kpje) - REAL, intent(in) :: oafx (kpie,kpje) - REAL, intent(in) :: pi_ph (kpie,kpje) - REAL, intent(in) :: pfswr (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - REAL, intent(in) :: psicomo(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - REAL, intent(in) :: ppao (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - REAL, intent(in) :: pfu10 (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - REAL, intent(in) :: ptho (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) - 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(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 - LOGICAL :: lspin - - IF (mnproc.eq.1) THEN - write(io_stdo_bgc,*) 'iHAMOCC',KLDTDAY,LDTRUNBGC,NDTDAYBGC - ENDIF - - - !-------------------------------------------------------------------- - ! Increment bgc time step counter of run (initialized in HAMOCC_INIT). - ! - ldtrunbgc = ldtrunbgc + 1 - - - !-------------------------------------------------------------------- - ! Increment bgc time step counter of experiment. - ! - ldtbgc = ldtbgc + 1 - - - !-------------------------------------------------------------------- - ! Calculate variables related to the vertical grid - ! - call set_vgrid(kpie,kpje,kpke,pddpo) - - - !-------------------------------------------------------------------- - ! Pass net solar radiation - ! - !$OMP PARALLEL DO PRIVATE(i) - DO j=1,kpje - DO i=1,kpie - strahl(i,j)=pfswr(i,j) - ENDDO - ENDDO - !$OMP END PARALLEL DO - - - !-------------------------------------------------------------------- - ! Pass atmospheric co2 if coupled to an active atmosphere model - ! - if (trim(ocn_co2_type) == 'diagnostic' .or. trim(ocn_co2_type) == 'prognostic') 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' - endif - - 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' - endif - - !-------------------------------------------------------------------- - ! Read atmospheric cfc concentrations - ! - 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) - 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) - endif - - - !--------------------------------------------------------------------- - ! Biogeochemistry - ! - ! Apply dust (iron) deposition - ! This routine should be moved to the other routines that handle - ! external inputs below for consistency. For now we keep it here - ! to maintain bit-for-bit reproducibility with the CMIP6 version of - ! the model - CALL apply_fedep(kpie,kpje,kpke,pddpo,omask,dust) - - CALL OCPROD(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) - - 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) - endif - - - do l=1,nocetra - do K=1,kpke - !$OMP PARALLEL DO PRIVATE(i) - do J=1,kpje - do I=1,kpie - if (OMASK(I,J) .gt. 0.5 ) then - OCETRA(I,J,K,L)=MAX(0.,OCETRA(I,J,K,L)) - endif - enddo - enddo - !$OMP END PARALLEL DO - enddo - enddo - - 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) - endif - - - CALL CYANO(kpie,kpje,kpke,kbnd,pddpo,omask,ptho) - - 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) - endif - - CALL CARCHM(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,prho,pglat,omask, & - psicomo,ppao,pfu10,ptho,psao) - - 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) - endif - - - ! Apply n-deposition - CALL apply_ndep(kpie,kpje,kpke,pddpo,omask,ndep) - - 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) - endif - - ! Apply riverine input of carbon and nutrients - call apply_rivin(kpie,kpje,kpke,pddpo,omask,rivin) - - 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) - endif - - ! Apply alkalinity flux due to ocean alkalinization - call apply_oafx(kpie,kpje,kpke,pddpo,omask,oafx) - - 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) - endif - - ! Update atmospheric pCO2 [ppm] - if (use_BOXATM) then - CALL update_boxatm(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask) - 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) - endif - - ! update preformed tracers - CALL PREFTRC(kpie,kpje,omask) - - - !-------------------------------------------------------------------- - ! Sediment module - - if (.not. use_sedbypass) then - - ! 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( itsedspin_yr_e) then - call xchalt('(invalid sediment spinup start/end year)') - stop '(invalid sediment spinup start/end year)' - endif - if(sedspin_ncyc < 2) then - call xchalt('(invalid nb. of sediment spinup subcycles)') - stop '(invalid nb. of sediment spinup subcycles)' - endif - endif - ENDIF - - ! init the index-mapping between pore water and ocean tracers - CALL init_por2octra_mapping() - ! - ! --- Memory allocation - ! - CALL ALLOC_MEM_INTFCBLOM(idm,jdm,kdm) - CALL ALLOC_MEM_BGCMEAN(idm,jdm,kdm) - CALL ALLOC_MEM_VGRID(idm,jdm,kdm) - CALL ALLOC_MEM_BIOMOD(idm,jdm,kdm) - CALL ALLOC_MEM_SEDMNT(idm,jdm) - CALL ALLOC_MEM_CARBCH(idm,jdm,kdm) - ! - ! --- initialise trc array (two time levels) - ! - do nt=itrbgc,itrbgc+ntrbgc-1 - do k=1,2*kk - do j=1,jj - do i=1,ii - trc(i,j,k,nt)=0.0 - enddo - enddo - enddo - enddo - ! - ! --- initialise HAMOCC land/ocean mask - ! - do j=1,jj - do l=1,isp(j) - do i=max(1,ifp(j,l)),min(ii,ilp(j,l)) - omask(i,j)=1. - enddo - enddo - enddo - ! - ! --- BLOM to HAMOCC interface - ! - call blom2hamocc(2,1,kk,0) - ! - ! --- Calculate variables related to the vertical grid - ! - call set_vgrid(idm,jdm,kdm,bgc_dp) - ! - ! --- Initialize parameters - ! - CALL ini_parambgc(idm,jdm) - - ! --- Initialize atmospheric fields with (updated) parameter values - call ini_fields_atm(idm,jdm) - - ! --- Initialize sediment and ocean tracers - CALL ini_fields_ocean(read_rest,idm,jdm,kdm,nbdy,bgc_dp,bgc_rho,omask,plon,plat) - - ! --- Initialize sediment layering - ! First, read the porosity and potentially apply it in ini_sedimnt - CALL read_sedpor(idm,jdm,ks,omask,sed_por) - CALL ini_sedmnt(idm,jdm,kdm,omask,sed_por) - ! - ! --- Initialise reading of input data (dust, n-deposition, river, etc.) - ! - CALL ini_read_fedep(idm,jdm,omask) - - CALL ini_read_ndep(idm,jdm) - - CALL ini_read_rivin(idm,jdm,omask) - - CALL ini_read_oafx(idm,jdm,bgc_dx,bgc_dy,plat,omask) - - if (use_BROMO) then - CALL ini_swa_clim(idm,jdm,omask) - endif - - call ini_pi_ph(idm,jdm,omask) - ! - ! --- Read restart fields from restart file if requested, otherwise - ! (at first start-up) copy ocetra and sediment arrays (which are - ! initialised in BELEG_VARS) to both timelevels of their respective - ! two-time-level counterpart - ! - IF(read_rest.eq.1) THEN - CALL AUFR_BGC(idm,jdm,kdm,ntr,ntrbgc,itrbgc,trc, & - & date%year,date%month,date%day,omask,rstfnm_hamocc) - ELSE - trc(1:idm,1:jdm,1:kdm, itrbgc:itrbgc+ntrbgc-1) = & - & ocetra(:,:,:,:) - trc(1:idm,1:jdm,kdm+1:2*kdm,itrbgc:itrbgc+ntrbgc-1) = & - & ocetra(:,:,:,:) - if (.not. use_sedbypass) then - sedlay2(:,:,1:ks,:) = sedlay(:,:,:,:) - sedlay2(:,:,ks+1:2*ks,:) = sedlay(:,:,:,:) - powtra2(:,:,1:ks,:) = powtra(:,:,:,:) - powtra2(:,:,ks+1:2*ks,:) = powtra(:,:,:,:) - burial2(:,:,1,:) = burial(:,:,:) - burial2(:,:,2,:) = burial(:,:,:) - endif - if (use_BOXATM) then - atm2(:,:,1,:) = atm(:,:,:) - atm2(:,:,2,:) = atm(:,:,:) - endif - ENDIF - - if (mnproc.eq.1) then - write(io_stdo_bgc,*) - WRITE(io_stdo_bgc,*)'********************************************' - write(io_stdo_bgc,*) 'iHAMOCC: finished initialisation' - write(io_stdo_bgc,*) - endif - - !****************************************************************************** -end subroutine hamocc_init diff --git a/hamocc/hamocc_step.F90 b/hamocc/hamocc_step.F90 deleted file mode 100644 index 465371a1..00000000 --- a/hamocc/hamocc_step.F90 +++ /dev/null @@ -1,87 +0,0 @@ -! Copyright (C) 2020 K. Assmann, J. Tjiputra, J. Schwinger, M. Bentsen -! -! 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. -! -! 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. -! -! 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 hamocc_step(m,n,mm,nn,k1m,k1n) - ! - ! --- ------------------------------------------------------------------ - ! --- perform one HAMOCC step - ! --- ------------------------------------------------------------------ - ! - use mod_xc, only: idm,jdm,kdm,nbdy - use mod_time, only: date,nday_of_year,nstep,nstep_in_day - use mod_grid, only: plat - use mod_state, only: temp,saln - use mod_forcing, only: swa,slp,abswnd,atmco2,flxco2,flxdms, & - & atmbrf,flxbrf - use mod_seaice, only: ficem - use mo_bgcmean, only: nbgc,bgcwrt, diagfq_bgc,diagmon_bgc, & - & diagann_bgc - use mo_intfcblom, only: bgc_dx,bgc_dy,bgc_dp,bgc_rho,omask, & - & blom2hamocc,hamocc2blom - use mo_read_rivin, only: rivflx - use mo_read_fedep, only: get_fedep - use mo_read_ndep, only: get_ndep - use mo_read_oafx, only: get_oafx - use mo_read_pi_ph, only: get_pi_ph,pi_ph - use mo_control_bgc, only: with_dmsph - - implicit none - - integer, intent(in) :: m,n,mm,nn,k1m,k1n - - integer :: l,ldtday - real :: ndep(idm,jdm) - real :: dust(idm,jdm) - real :: oafx(idm,jdm) - - call trc_limitc(nn) - - call blom2hamocc(m,n,mm,nn) - - ldtday = mod(nstep,nstep_in_day) - - do l=1,nbgc - bgcwrt(l)=.false. - if (((diagann_bgc(l).and.nday_of_year.eq.1.or.diagmon_bgc(l) & - & .and.date%day.eq.1).and.mod(nstep,nstep_in_day).eq.0).or. & - & .not.(diagann_bgc(l).or.diagmon_bgc(l)).and. & - & mod(nstep+.5,diagfq_bgc(l)).lt.1.) & - & bgcwrt(l)=.true. - enddo - - call get_fedep(idm,jdm,date%month,dust) - call get_ndep(idm,jdm,date%year,date%month,omask,ndep) - call get_oafx(idm,jdm,date%year,date%month,omask,oafx) - if(with_dmsph) call get_pi_ph(idm,jdm,date%month) - - call hamocc4bcm(idm,jdm,kdm,nbdy, & - & date%year,date%month,date%day,ldtday, & - & bgc_dx,bgc_dy,bgc_dp,bgc_rho,plat,omask, & - & dust,rivflx,ndep,oafx,pi_ph, & - & swa,ficem,slp,abswnd, & - & temp(1-nbdy,1-nbdy,1+nn),saln(1-nbdy,1-nbdy,1+nn), & - & atmco2,flxco2,flxdms,atmbrf,flxbrf) - - ! - ! --- accumulate fields and write output - ! - call accfields(idm,jdm,kdm,bgc_dx,bgc_dy,bgc_dp,omask) - - call hamocc2blom(m,n,mm,nn) - -end subroutine hamocc_step diff --git a/hamocc/inventory_bgc.F90 b/hamocc/inventory_bgc.F90 deleted file mode 100644 index 4c1b188a..00000000 --- a/hamocc/inventory_bgc.F90 +++ /dev/null @@ -1,1904 +0,0 @@ -! Copyright (C) 2002 P. Wetzel -! Copyright (C) 2022 K. Assmann, J. Tjiputra, J. Schwinger, T. Torsvik -! -! 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. -! -! 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. -! -! 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 INVENTORY_BGC(kpie,kpje,kpke,dlxp,dlyp,ddpo,omask,iogrp) - !******************************************************************* - ! - !**** *INVENTORY_BGC* - calculate the BGC inventory. - ! - ! P.Wetzel, *MPI-Met, HH* 29.07.02 - ! - ! Modified - ! -------- - ! T. Torsvik *UiB* 22.02.22 - ! Include option for writing inventory to netCDF file. - ! - ! Purpose - ! ------- - ! - calculate the BGC inventory. - ! - ! Method - ! ------- - ! - - ! - !** Interface. - ! ---------- - ! - ! *CALL* *INVENTORY_BGC* - ! - ! - !** Interface to ocean model (parameter list): - ! ----------------------------------------- - ! - ! - ! Externals - ! --------- - ! none. - ! - !********************************************************************** - use mod_xc, only: mnproc,ips,nbdy,xcsum - use mo_carbch, only: atm,atmflx,co3,hi,ndepflx,rivinflx,ocetra,sedfluxo - use mo_sedmnt, only: prcaca,prorca,silpro - use mo_biomod, only: expoor,expoca,exposi - use mo_param_bgc, only: rcar,rnit - use mo_control_bgc, only: do_ndep,do_rivinpt,io_stdo_bgc - use mo_bgcmean, only: bgct2d,jco2flux,jirdin,jn2flux,jn2oflux,jndep,jo2flux,jprcaca,jprorca,jsilpro,nbgcmax,glb_inventory - use mo_param1_bgc, only: ialkali,ian2o,iano3,iatmco2,iatmn2,iatmn2o,iatmo2,icalc,idet,idoc,igasnit,iopal,ioxygen,iphosph, & - & iphy,ipowaic,ipowaox,ipowaph,ipowasi,ipown2,ipowno3,isco212,isilica,isssc12,issso12,issssil,izoo, & - & irdin,irdip,irsi,iralk,irdoc,irdet,nocetra,npowtra,nsedtra,nriv - use mo_vgrid, only: dp_min - - ! NOT sedbypass - use mo_param1_bgc, only: ks - use mo_sedmnt, only: porwat,seddw,sedlay,burial,sedhpl,powtra,porsol - use mo_control_bgc, only: use_PBGC_CK_TIMESTEP,use_BOXATM,use_sedbypass,use_cisonew,use_AGG,use_CFC,use_natDIC,use_BROMO - - implicit none - - integer, intent(in) :: kpie,kpje,kpke - integer, intent(in) :: iogrp - real, intent(in) :: dlxp(kpie,kpje) - real, intent(in) :: dlyp(kpie,kpje) - real, intent(in) :: ddpo(kpie,kpje,kpke) - real, intent(in) :: omask(kpie,kpje) - - ! Local variables - integer :: i,j,k,l - - real :: ztmp1(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy) - real :: ztmp2(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy) - real :: vol - - ! ppm2con: atmospheric weight: ~10000kg/m^2, avrg. ~29 g/mol - ! --> 350 kmol/m^2 --> 1ppm ~ 0.35e-3 kmol/m^2 - real, parameter :: ppm2con = 0.35e-3 - - !=== Variables for global sums - real :: ztotvol ! Total ocean volume - real :: ztotarea ! Total sea surface area - !--- aqueous sediment tracer - real :: zsedtotvol ! Total pore water volume - real :: zpowtratot(npowtra) ! Sum : Pore water tracers - real :: zpowtratoc(npowtra) ! Mean concentration of pore water tracers - !--- non aqueous sediment tracer - real :: zsedhplto ! Total sediment accumulated hydrogen ions - real :: zsedlayto(nsedtra) ! Sum : Sediment layer tracers - real :: zburial(nsedtra) ! Sum : Sediment burial tracers - !--- oceanic tracers - real :: zocetratot(nocetra) ! Sum : Ocean tracers - real :: zocetratoc(nocetra) ! Mean concentration of ocean racers - !--- additional ocean tracer - real :: zhito ! Total hydrogen ion tracer - real :: zco3to ! Total dissolved carbonate (CO3) tracer - !--- alkalinity of the first layer - real :: zvoltop ! Total volume of top ocean layer - real :: zalkali ! Total alkalinity of top ocean layer - !--- river fluxes - real :: srivflux(nriv) ! sum of riverfluxes - !--- atmosphere flux and atmospheric CO2 - real :: sndepflux ! sum of N dep fluxes - real :: zatmco2,zatmo2,zatmn2 - real :: co2flux,so2flux,sn2flux,sn2oflux - real :: zprorca,zprcaca,zsilpro - !--- total tracer budgets - real :: totalcarbon,totalphos,totalsil,totalnitr,totaloxy - !--- sediment fluxes - real :: sum_zprorca - real :: sum_zprcaca - real :: sum_zsilpro - real :: sum_sedfluxo(npowtra) - !--- export production - real :: sum_expoor - real :: sum_expoca - real :: sum_exposi - - !=== aqueous sediment tracer - !---------------------------------------------------------------------- - if (use_sedbypass) then - - zsedtotvol = 0.0 - zpowtratot(:)=0.0 - zpowtratoc(:)=0.0 - zsedlayto(:)=0.0 - zburial(:)=0.0 - zsedhplto=0.0 - - else - - ztmp1(:,:)=0.0 - DO k=1,ks - DO j=1,kpje - DO i=1,kpie - ztmp1(i,j) = ztmp1(i,j) + omask(i,j)*seddw(k) & - & *dlxp(i,j)*dlyp(i,j)*porwat(i,j,k) - ENDDO - ENDDO - ENDDO - - CALL xcsum(zsedtotvol,ztmp1,ips) - - DO l=1,npowtra - ztmp1(:,:)=0.0 - DO k=1,ks - DO j=1,kpje - DO i=1,kpie - vol = seddw(k)*dlxp(i,j)*dlyp(i,j)*porwat(i,j,k) - ztmp1(i,j)= ztmp1(i,j) + omask(i,j)*powtra(i,j,k,l)*vol - ENDDO - ENDDO - ENDDO - - CALL xcsum(zpowtratot(l),ztmp1,ips) - zpowtratoc(l) = zpowtratot(l)/zsedtotvol - ENDDO - - !=== non aqueous sediment tracer - !---------------------------------------------------------------------- - zburial = sum2d_array(burial, nsedtra) - - DO l=1,nsedtra - ztmp1(:,:)=0.0 - DO k=1,ks - DO j=1,kpje - DO i=1,kpie - vol = porsol(i,j,k)*seddw(k)*dlxp(i,j)*dlyp(i,j) - ztmp1(i,j) = ztmp1(i,j) + omask(i,j)*sedlay(i,j,k,l)*vol - ENDDO - ENDDO - ENDDO - - CALL xcsum(zsedlayto(l),ztmp1,ips) - ENDDO - - ztmp1(:,:)=0.0 - DO k=1,ks - DO j=1,kpje - DO i=1,kpie - vol = porsol(i,j,k)*seddw(k)*dlxp(i,j)*dlyp(i,j) - ztmp1(i,j) = ztmp1(i,j) + omask(i,j)*sedhpl(i,j,k)*vol - ENDDO - ENDDO - ENDDO - - CALL xcsum(zsedhplto,ztmp1,ips) - - endif ! not sedbypass - - !=== oceanic tracers - !---------------------------------------------------------------------- - ztotvol = 0. - zocetratot = 0. - zocetratoc = 0. - - ztmp1(:,:)=0.0 - DO k=1,kpke - DO j=1,kpje - DO i=1,kpie - IF(ddpo(i,j,k).gt.dp_min) THEN - ztmp1(i,j) = ztmp1(i,j) & - & + omask(i,j)*dlxp(i,j)*dlyp(i,j)*ddpo(i,j,k) - ENDIF - ENDDO - ENDDO - ENDDO - - CALL xcsum(ztotvol,ztmp1,ips) - - DO l=1,nocetra - ztmp1(:,:)=0.0 - DO k=1,kpke - DO j=1,kpje - DO i=1,kpie - IF(ddpo(i,j,k).gt.dp_min) THEN - vol = dlxp(i,j)*dlyp(i,j)*ddpo(i,j,k) - ztmp1(i,j) = ztmp1(i,j) + omask(i,j)*ocetra(i,j,k,l)*vol - ! if (ocetra(i,j,k,l).lt.0.0) then - ! WRITE(io_stdo_bgc,*) 'ocetra -ve', l,ocetra(i,j,k,l) - ! endif - ENDIF - ENDDO - ENDDO - ENDDO - - CALL xcsum(zocetratot(l),ztmp1,ips) - zocetratoc(l) = zocetratot(l)/ztotvol - ENDDO - - !=== additional ocean tracer - !---------------------------------------------------------------------- - zhito = 0. - zco3to = 0. - - ztmp1(:,:)=0.0 - ztmp2(:,:)=0.0 - DO k=1,kpke - DO j=1,kpje - DO i=1,kpie - IF(ddpo(i,j,k).gt.dp_min) THEN - vol = dlxp(i,j)*dlyp(i,j)*ddpo(i,j,k) - ztmp1(i,j) = ztmp1(i,j) + omask(i,j)*hi(i,j,k) *vol - ztmp2(i,j) = ztmp2(i,j) + omask(i,j)*co3(i,j,k)*vol - ENDIF - ENDDO - ENDDO - ENDDO - - CALL xcsum(zhito ,ztmp1,ips) - CALL xcsum(zco3to,ztmp2,ips) - - !=== alkalinity of the first layer - !-------------------------------------------------------------------- - zvoltop = 0. - zalkali = 0. - - k=1 - ztmp1(:,:)=0.0 - ztmp2(:,:)=0.0 - DO j=1,kpje - DO i=1,kpie - ztmp1(i,j) = omask(i,j)*dlxp(i,j)*dlyp(i,j)*ddpo(i,j,k) - ztmp2(i,j) = ocetra(i,j,k,ialkali)*ztmp1(i,j) - ENDDO - ENDDO - - CALL xcsum(zvoltop,ztmp1,ips) - CALL xcsum(zalkali,ztmp2,ips) - - !=== atmosphere flux and atmospheric CO2 - !-------------------------------------------------------------------- - ztotarea =0. - co2flux =0. - so2flux =0. - sn2flux =0. - sn2oflux =0. - sndepflux=0. - srivflux =0. - zatmco2 =0. - zatmo2 =0. - zatmn2 =0. - - ztmp1(:,:)=0.0 - DO j=1,kpje - DO i=1,kpie - ztmp1(i,j) = dlxp(i,j)*dlyp(i,j) - ENDDO - ENDDO - CALL xcsum(ztotarea,ztmp1,ips) - - if (use_PBGC_CK_TIMESTEP) then - ! only consider instantaneous fluxes in debugging mode - co2flux = sum2d(atmflx(:,:,iatmco2)) - so2flux = sum2d(atmflx(:,:,iatmo2)) - sn2flux = sum2d(atmflx(:,:,iatmn2)) - sn2oflux = sum2d(atmflx(:,:,iatmn2o)) - - ! nitrogen deposition - if(do_ndep) then - sndepflux = sum2d(ndepflx) - endif - - ! river fluxes - if(do_rivinpt) then - srivflux = sum2d_array(rivinflx, nriv) - endif - else - ! consider accumulated fluxes in the regular mode - co2flux = sum2d(bgct2d(:,:,jco2flux)) - so2flux = sum2d(bgct2d(:,:,jo2flux)) - sn2flux = sum2d(bgct2d(:,:,jn2flux)) - sn2oflux = sum2d(bgct2d(:,:,jn2oflux)) - - ! nitrogen deposition fluxes - if(do_ndep) then - sndepflux = sum2d(bgct2d(:,:,jndep)) - endif - - ! River fluxes - if(do_rivinpt) then - srivflux = sum2d_array(bgct2d(:,:,jirdin:jirdin+nriv-1), nriv) - endif - endif - - if (use_BOXATM) then - zatmco2 = sum2d(atm(:,:,iatmco2)) - zatmo2 = sum2d(atm(:,:,iatmo2)) - zatmn2 = sum2d(atm(:,:,iatmn2)) - endif - - !--- Complete sum of inventory in between bgc.f90 - zprorca = sum2d(prorca) - zprcaca = sum2d(prcaca) - zsilpro = sum2d(silpro) - - !=== Sum of inventory - !---------------------------------------------------------------------- - ! Units in P have a C:P Ratio of 122:1 - - ! totalcarbon= & - ! & (zocetratot(idet)+zocetratot(idoc)+zocetratot(iphy) & - ! & +zocetratot(izoo))*rcar+zocetratot(isco212)+zocetratot(icalc) - - - totalcarbon= & - (zocetratot(idet)+zocetratot(idoc)+zocetratot(iphy) & - + zocetratot(izoo))*rcar+zocetratot(isco212)+zocetratot(icalc) & - + zpowtratot(ipowaic)+zsedlayto(isssc12)+zsedlayto(issso12)*rcar & - + zburial(isssc12)+zburial(issso12)*rcar & - + zprorca*rcar+zprcaca - - if (use_BOXATM) then - totalcarbon = totalcarbon + zatmco2*ppm2con - else - totalcarbon = totalcarbon + co2flux - endif - - totalnitr= & - (zocetratot(idet)+zocetratot(idoc)+zocetratot(iphy) & - + zocetratot(izoo))*rnit+zocetratot(iano3)+zocetratot(igasnit)*2 & - + zpowtratot(ipowno3)+zpowtratot(ipown2)*2 & - + zsedlayto(issso12)*rnit+zburial(issso12)*rnit & - + zocetratot(ian2o)*2 & - - sndepflux & - + zprorca*rnit - - if (use_BOXATM) then - totalnitr = totalnitr + zatmn2*ppm2con*2 - else - totalnitr = totalnitr + sn2flux*2+sn2oflux*2 - endif - - totalphos= & - zocetratot(idet)+zocetratot(idoc)+zocetratot(iphy) & - + zocetratot(izoo)+zocetratot(iphosph) & - + zpowtratot(ipowaph)+zsedlayto(issso12) & - + zburial(issso12) & - + zprorca - - totalsil= & - zocetratot(isilica)+zocetratot(iopal) & - + zpowtratot(ipowasi)+zsedlayto(issssil)+zburial(issssil) & - + zsilpro - - totaloxy= & - (zocetratot(idet)+zocetratot(idoc)+zocetratot(iphy) & - + zocetratot(izoo))*(-24.)+zocetratot(ioxygen) & - + zocetratot(iphosph)*2 +zocetratot(isco212)+zocetratot(icalc) & - + zocetratot(iano3)*1.5+zocetratot(ian2o)*0.5 & - + zsedlayto(issso12)*(-24.) + zsedlayto(isssc12) & - !+ zburial(issso12)*(-24.) + zburial(isssc12) & - + zpowtratot(ipowno3)*1.5+zpowtratot(ipowaic) & - + zpowtratot(ipowaox)+zpowtratot(ipowaph)*2 & - - sndepflux*1.5 & - + zprorca*(-24.)+zprcaca - - if (use_BOXATM) then - totaloxy = totaloxy + zatmo2*ppm2con+zatmco2*ppm2con - else - totaloxy = totaloxy + so2flux+sn2oflux*0.5+co2flux - endif - - IF (do_rivinpt) THEN - totalcarbon = totalcarbon & - - (srivflux(irdoc)+srivflux(irdet))*rcar -(srivflux(iralk)+srivflux(irdin)+srivflux(irdip)) ! =sco212 - totalnitr = totalnitr & - - (srivflux(irdoc)+srivflux(irdet))*rnit - srivflux(irdin) - totalphos = totalphos & - -(srivflux(irdoc)+srivflux(irdet)+srivflux(irdip)) - totalsil = totalsil & - - srivflux(irsi) - totaloxy = totaloxy & - - (srivflux(irdoc)+srivflux(irdet))*(-24.) & - - srivflux(irdin)*1.5 - srivflux(irdip)*2. & - - (srivflux(iralk)+srivflux(irdin)+srivflux(irdip)) ! =sco212 - ENDIF - - !=== Compute sediment fluxes - !---------------------------------------------------------------------- - sum_zprorca = sum2d(bgct2d(:,:,jprorca)) - sum_zprcaca = sum2d(bgct2d(:,:,jprcaca)) - sum_zsilpro = sum2d(bgct2d(:,:,jsilpro)) - - sum_sedfluxo = sum2d_array(sedfluxo, npowtra) - - sum_expoor = sum2d(expoor) - sum_expoca = sum2d(expoca) - sum_exposi = sum2d(exposi) - - !=== Write output to netCDF file or stdout - !---------------------------------------------------------------------- - if (mnproc == 1) then - if (iogrp == 0) then ! debug mode - call write_stdout - else if (GLB_INVENTORY(iogrp) == 2) then ! netcdf output - call write_netcdf(iogrp) - else ! default - call write_stdout - endif - endif - - return - -contains - - - function sum2d(var2d) result(total) - !********************************************************************** - !**** Sum 2D scalar fields - !********************************************************************** - implicit none - real, dimension(kpie,kpje), intent(in) :: var2d - real :: total - - ! Local variables - integer :: i,j - !--- input to xcsum require halo indices - real, dimension(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy) :: ztmp - - ztmp(:,:)=0.0 - do j=1,kpje - do i=1,kpie - ztmp(i,j) = var2d(i,j)*dlxp(i,j)*dlyp(i,j)*omask(i,j) - enddo - enddo - call xcsum(total,ztmp,ips) - end function sum2d - - - function sum2d_array(var3d, narr) result(total) - !********************************************************************** - !**** Sum 2D array fields - !********************************************************************** - implicit none - integer, intent(in) :: narr - real, dimension(kpie,kpje,narr), intent(in) :: var3d - real, dimension(narr) :: total - - ! Local variables - integer :: i,j,k - !--- input to xcsum require halo indices - real, dimension(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy) :: ztmp - - ztmp(:,:)=0.0 - do k=1,narr - do j=1,kpje - do i=1,kpie - ztmp(i,j) = var3d(i,j,k)*dlxp(i,j)*dlyp(i,j)*omask(i,j) - enddo - enddo - call xcsum(total(k),ztmp,ips) - enddo - end function sum2d_array - - - subroutine write_stdout - !********************************************************************** - !**** Write inventory to log file. - !********************************************************************** - implicit none - - integer :: l - - if (.not. use_sedbypass) then - !=== aqueous sediment tracer - !------------------------------------------------------------------ - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*)'Global inventory of aqueous sediment tracer' - WRITE(io_stdo_bgc,*)'-------------------------------------------' - WRITE(io_stdo_bgc,*) ' total[kmol] concentration[mol/L]' - DO l=1,npowtra - WRITE(io_stdo_bgc,*)'No. ',l,' ',zpowtratot(l), & - & ' ',zpowtratoc(l),' ',zsedtotvol - ENDDO - WRITE(io_stdo_bgc,*) ' ' - - !=== non aqueous sediment tracer - !------------------------------------------------------------------ - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) & - & 'Global inventory of solid sediment constituents' - WRITE(io_stdo_bgc,*) & - & '----------------------------------------------------' - WRITE(io_stdo_bgc,*) ' [kmol]' - - DO l=1,nsedtra - WRITE(io_stdo_bgc,*) 'Sediment No. ',l,' ', zsedlayto(l) - WRITE(io_stdo_bgc,*) 'Burial No. ',l,' ', zburial(l) - ENDDO - WRITE(io_stdo_bgc,*) 'hpl ', zsedhplto - WRITE(io_stdo_bgc,*) ' ' - endif - - !=== oceanic tracers - !------------------------------------------------------------------ - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Global inventory of advected ocean tracers' - WRITE(io_stdo_bgc,*) '------------------------------------------' - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) ' total[kmol] concentration[kmol/m^3]' - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'ztotvol',ztotvol - DO l=1,nocetra - WRITE(io_stdo_bgc,*) 'No. ',l, zocetratot(l), zocetratoc(l) - ENDDO - - !=== additional ocean tracer - !------------------------------------------------------------------ - ! WRITE(io_stdo_bgc,*) ' ' - ! WRITE(io_stdo_bgc,*) 'Glob. inventory of additional ocean tracer' - ! WRITE(io_stdo_bgc,*) '------------------------------------------' - ! WRITE(io_stdo_bgc,*) ' total[kmol] concentration[kmol/m^3]' - ! WRITE(io_stdo_bgc,*) ' ' - ! WRITE(io_stdo_bgc,*) ' hi', zhito, zhito/ztotvol - ! WRITE(io_stdo_bgc,*) ' co3', zco3to, zco3to/ztotvol - ! WRITE(io_stdo_bgc,*) ' ' - - !=== alkalinity of the first layer - !------------------------------------------------------------------ - ! WRITE(io_stdo_bgc,*) ' ' - ! WRITE(io_stdo_bgc,*) 'Global inventory of first layer alkalinity' - ! WRITE(io_stdo_bgc,*) '------------------------------------------' - ! WRITE(io_stdo_bgc,*) ' ' - ! WRITE(io_stdo_bgc,*) ' total[kmol] concentration[kmol/m^3]' - ! WRITE(io_stdo_bgc,*) ' ' - ! WRITE(io_stdo_bgc,*) zalkali, zalkali/zvoltop - - !=== atmosphere flux and atmospheric CO2 - !------------------------------------------------------------------ - ! WRITE(io_stdo_bgc,*) ' ' - ! WRITE(io_stdo_bgc,*) 'Global fluxes into atmosphere' - ! WRITE(io_stdo_bgc,*) '-----------------------------' - ! WRITE(io_stdo_bgc,*) ' [kmol]' - ! WRITE(io_stdo_bgc,*) ' ' - ! WRITE(io_stdo_bgc,*) 'CO2Flux :',co2flux - ! WRITE(io_stdo_bgc,*) 'O2 Flux :',so2flux - ! WRITE(io_stdo_bgc,*) 'N2 Flux :',sn2flux - ! WRITE(io_stdo_bgc,*) 'N2O Flux :',sn2oflux - ! WRITE(io_stdo_bgc,*) ' ' - if (use_BOXATM) then - ! WRITE(io_stdo_bgc,*) 'global atm. CO2[ppm] / kmol: ', & - ! & zatmco2/ztotarea,zatmco2*ppm2con - ! WRITE(io_stdo_bgc,*) 'global atm. O2[ppm] / kmol : ', & - ! & zatmo2/ztotarea,zatmo2*ppm2con - ! WRITE(io_stdo_bgc,*) 'global atm. N2[ppm] / kmol : ', & - ! & zatmn2/ztotarea,zatmn2*ppm2con - endif - ! WRITE(io_stdo_bgc,*) ' ' - ! WRITE(io_stdo_bgc,*) 'Should be zero at the end: ' - ! WRITE(io_stdo_bgc,*) 'prorca, prcaca, silpro ', & - ! & zprorca, zprcaca, zsilpro - ! WRITE(io_stdo_bgc,*) ' ' - - IF(do_ndep) WRITE(io_stdo_bgc,*) 'NdepFlux :',sndepflux - - ! riverine fluxes - !------------------------------------------------------------------ - IF(do_rivinpt)THEN - WRITE(io_stdo_bgc,*) 'Riverine fluxes:' - DO l=1,nriv - WRITE(io_stdo_bgc,*) 'No. ',l,srivflux(l) - ENDDO - ENDIF - - !=== Sum of inventory - !------------------------------------------------------------------ - ! Units in P have a C:P Ratio of 122:1 - WRITE(io_stdo_bgc,*) 'Global total[kmol] of carbon : ', totalcarbon - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Global total[kmol] of phosph. : ', totalphos - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Global total[kmol] of silicate : ', totalsil - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Global total[kmol] of nitrogen. : ', totalnitr - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Global total[kmol] of oxygen. : ', totaloxy - - !=== Write sediment fluxes - !------------------------------------------------------------------ - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Global fluxes into and out of the sediment' - WRITE(io_stdo_bgc,*) '------------------------------------------' - WRITE(io_stdo_bgc,*) ' [kmol]' - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Detritus, Calcium Carbonate, Silicate ', & - & sum_zprorca, sum_zprcaca, sum_zsilpro - WRITE(io_stdo_bgc,*) ' ' - DO l=1,npowtra - WRITE(io_stdo_bgc,*) 'No. ',l,' ',sum_sedfluxo(l) - ENDDO - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Global total export production' - WRITE(io_stdo_bgc,*) '------------------------------' - WRITE(io_stdo_bgc,*) ' [kmol]' - WRITE(io_stdo_bgc,*) 'carbon : ',sum_expoor - WRITE(io_stdo_bgc,*) 'carbonate: ',sum_expoca - WRITE(io_stdo_bgc,*) 'silicate : ',sum_exposi - WRITE(io_stdo_bgc,*) ' ' - - end subroutine write_stdout - - - subroutine write_netcdf(iogrp) - !********************************************************************** - !**** Write inventory to netCDF file. - !********************************************************************** - use netcdf, only: nf90_clobber, nf90_close, nf90_create, nf90_def_dim, & - & nf90_def_var, nf90_double, nf90_enddef, nf90_global, & - & nf90_inq_dimid, nf90_inq_varid, nf90_open, & - & nf90_put_att, nf90_put_var, nf90_unlimited, nf90_write - use mod_types, only: r8 - use mod_config, only: expcnf, runid, inst_suffix - use mod_time, only: date0, time0, date, time, nstep, nday_of_year, & - & nstep_in_day - use mo_bgcmean, only: filefq_bgc, fileann_bgc, filemon_bgc,glb_fnametag - use mo_param1_bgc, only: idicsat,idms,ifdust,iiron,iprefalk,iprefdic,iprefo2, & - & iprefpo4 - ! AGG - use mo_param1_bgc, only: iadust,inos - ! BROMO - use mo_param1_bgc, only: ibromo - ! CFC - use mo_param1_bgc, only: icfc11,icfc12,isf6 - ! cisonew - use mo_param1_bgc, only: icalc13,icalc14,idet13,idet14,idoc13,idoc14, & - & iphy13,iphy14,isco213,isco214,izoo13,izoo14 - ! natDIC - use mo_param1_bgc, only: inatalkali,inatcalc,inatsco212 - use mo_control_bgc, only: use_PBGC_CK_TIMESTEP,use_BOXATM,use_sedbypass,use_cisonew,use_AGG,use_CFC,use_natDIC,use_BROMO - - implicit none - - integer, intent(in) :: iogrp - - !=== Save filename and counter variables - !--- netCDF output file names - character(len=256), dimension(nbgcmax), save :: fname_inv - integer, dimension(nbgcmax), save :: ncrec = 0 - logical, dimension(nbgcmax), save :: append2file_inv - data append2file_inv /nbgcmax*.false./ - - !=== Local variables - character(len=:), allocatable :: prefix, sep1, sep2 - character(len=20) :: tstamp - character(len=30) :: timeunits - integer :: l - real(r8) :: datenum - - !=== Variables for netcdf - integer :: ncid, ncvarid, ncstat - integer :: wrstart(1) - !--- time: dimension and variable id - integer :: time_dimid - integer :: time_varid - - ! NOT sedbypass - !--- aqueous sediment tracers - integer :: npowtra_dimid ! id: aqueous sediments - integer :: zpowtra_dimids(2) ! aqueous sediment dimensions - integer :: zpowtra_wrstart(2) ! record start point - integer :: zpowtra_count(2) ! record count - integer :: zsedtotvol_varid ! id: Total sediment volume - integer :: zpowtratot_varid ! id: Total aqueous sediment tracer [kmol] - integer :: zpowtratoc_varid ! id: Sediment tracer concentration [kmol/L] - !--- non-aqueous sediment tracers - integer :: nsedtra_dimid ! id: solid sediments - integer :: zsedtra_dimids(2) ! solid sediments dimensions - integer :: zsedtra_wrstart(2) ! record start point - integer :: zsedtra_count(2) ! record count - integer :: zsedlayto_varid ! id: sediment layer tracers - integer :: zburial_varid ! id: sediment burial tracers - integer :: zsedhplto_varid ! id: accumulated hydrogen ions - - !--- oceanic tracers - !--- Write total sum zt__varid, and mean concentration zc__varid - integer :: ztotvol_varid ! Total ocean volume - integer :: zt_sco212_varid, zc_sco212_varid ! Dissolved CO2 - integer :: zt_alkali_varid, zc_alkali_varid ! Alkalinity - integer :: zt_phosph_varid, zc_phosph_varid ! Dissolved phosphate - integer :: zt_oxygen_varid, zc_oxygen_varid ! Dissolved oxygen - integer :: zt_gasnit_varid, zc_gasnit_varid ! Gaseous nitrogen (N2) - integer :: zt_ano3_varid, zc_ano3_varid ! Dissolved nitrate - integer :: zt_silica_varid, zc_silica_varid ! Silicid acid (Si(OH)4) - integer :: zt_doc_varid, zc_doc_varid ! Dissolved organic carbon - integer :: zt_poc_varid, zc_poc_varid ! Particulate organic carbon - integer :: zt_phyto_varid, zc_phyto_varid ! Phytoplankton concentration - integer :: zt_grazer_varid, zc_grazer_varid ! Zooplankton concentration - integer :: zt_calciu_varid, zc_calciu_varid ! Calcium carbonate - integer :: zt_opal_varid, zc_opal_varid ! Biogenic silica - integer :: zt_n2o_varid, zc_n2o_varid ! Laughing gas (N2O) - integer :: zt_dms_varid, zc_dms_varid ! DiMethylSulfide - integer :: zt_fdust_varid, zc_fdust_varid ! Non-aggregated dust - integer :: zt_iron_varid, zc_iron_varid ! Dissolved iron - integer :: zt_prefo2_varid, zc_prefo2_varid ! Preformed oxygen - integer :: zt_prefpo4_varid, zc_prefpo4_varid ! Preformed phosphate - 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 - - ! 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 - integer :: zt_doc14_varid, zc_doc14_varid ! Dissolved organic carbon-C14 - integer :: zt_poc13_varid, zc_poc13_varid ! Particulate organic carbon-C13 - integer :: zt_poc14_varid, zc_poc14_varid ! Particulate organic carbon-C14 - integer :: zt_phyto13_varid, zc_phyto13_varid ! Phytoplankton concentration-C13 - integer :: zt_phyto14_varid, zc_phyto14_varid ! Phytoplankton concentration-C14 - integer :: zt_grazer13_varid, zc_grazer13_varid ! Zooplankton concentration-C13 - 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 - - ! AGG - integer :: zt_snos_varid, zc_snos_varid ! Marine snow aggregates per g sea water - integer :: zt_adust_varid, zc_adust_varid ! Aggregated dust - - ! 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 - - ! 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 - - ! BROMO - integer :: zt_bromo_varid, zc_bromo_varid ! Bromoform - - !--- sum of inventory - integer :: totcarb_varid, totphos_varid, totsili_varid, totnitr_varid - integer :: totoxyg_varid - !--- sediment fluxes - integer :: sum_zprorca_varid, sum_zprcaca_varid, sum_zsilpro_varid - integer :: sum_sedfluxo_varid - integer :: sum_expoor_varid, sum_expoca_varid, sum_exposi_varid - - - !=== Create new or open existing netCDF file - if (.not.append2file_inv(iogrp)) then - !--- file name : fname_inv(iogrp) - if (expcnf.eq.'cesm') then - prefix=trim(runid)//'.blom'//trim(inst_suffix) - sep1='.' - sep2='-' - else - prefix=trim(runid) - sep1='_' - sep2='.' - endif - write(tstamp,'(i4.4,a1,i2.2,a1,i2.2)') & - & date%year,sep2,date%month,sep2,date%day - fname_inv(iogrp) = prefix//sep1//trim(glb_fnametag(iogrp))//sep1// & - & 'i'//sep1//trim(tstamp)//'.nc' - - !--- create a new netCDF file - write(io_stdo_bgc,*) 'Create BGC inventory file : ',trim(fname_inv(iogrp)) - call nccheck( NF90_CREATE(trim(fname_inv(iogrp)), NF90_CLOBBER, ncid) ) - - !--- set time information - timeunits=' ' - write(timeunits,'(a11,i4.4,a1,i2.2,a1,i2.2,a6)') & - & 'days since ',date0%year,'-',date0%month,'-',date0%day,' 00:00' - - !--- Define global attributes - call nccheck( NF90_PUT_ATT(ncid, NF90_GLOBAL, 'title', & - & 'Global inventory for marine bgc') ) - call nccheck( NF90_PUT_ATT(ncid, NF90_GLOBAL, 'history', & - & 'Global inventory for marine bgc') ) - call nccheck( NF90_PUT_ATT(ncid, NF90_GLOBAL, 'date', timeunits) ) - - !--- Define dimensions - 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) ) - endif - 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. - if (.not. use_sedbypass) then - zpowtra_dimids = (/ npowtra_dimid, time_dimid /) - zsedtra_dimids = (/ nsedtra_dimid, time_dimid /) - endif - - !--- 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') ) - - 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') ) - endif - - !--- Define variables : oceanic tracers - call nccheck( NF90_DEF_VAR(ncid, 'ztotvol', NF90_DOUBLE, time_dimid, & - & ztotvol_varid) ) - call nccheck( NF90_PUT_ATT(ncid, ztotvol_varid, 'long_name', & - & 'Total ocean volume') ) - call nccheck( NF90_PUT_ATT(ncid, ztotvol_varid, 'units', 'm^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_sco212', NF90_DOUBLE, & - & time_dimid, zt_sco212_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_sco212_varid, 'long_name', & - & 'Total dissolved CO2 tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_sco212_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_sco212', NF90_DOUBLE, & - & time_dimid, zc_sco212_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_sco212_varid, 'long_name', & - & 'Mean dissolved CO2 concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_sco212_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_alkali', NF90_DOUBLE, & - & time_dimid, zt_alkali_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_alkali_varid, 'long_name', & - & 'Total alkalinity tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_alkali_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_alkali', NF90_DOUBLE, & - & time_dimid, zc_alkali_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_alkali_varid, 'long_name', & - & 'Mean alkalinity concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_alkali_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_phosph', NF90_DOUBLE, & - & time_dimid, zt_phosph_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_phosph_varid, 'long_name', & - & 'Total dissolved phosphate tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_phosph_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_phosph', NF90_DOUBLE, & - & time_dimid, zc_phosph_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_phosph_varid, 'long_name', & - & 'Mean dissolved phosphate concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_phosph_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_oxygen', NF90_DOUBLE, & - & time_dimid, zt_oxygen_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_oxygen_varid, 'long_name', & - & 'Total dissolved oxygen tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_oxygen_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_oxygen', NF90_DOUBLE, & - & time_dimid, zc_oxygen_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_oxygen_varid, 'long_name', & - & 'Mean dissolved oxygen concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_oxygen_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_gasnit', NF90_DOUBLE, & - & time_dimid, zt_gasnit_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_gasnit_varid, 'long_name', & - & 'Total gaseous nitrogen (N2) tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_gasnit_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_gasnit', NF90_DOUBLE, & - & time_dimid, zc_gasnit_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_gasnit_varid, 'long_name', & - & 'Mean gaseous nitrogen (N2) concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_gasnit_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_ano3', NF90_DOUBLE, & - & time_dimid, zt_ano3_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_ano3_varid, 'long_name', & - & 'Total dissolved nitrate tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_ano3_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_ano3', NF90_DOUBLE, & - & time_dimid, zc_ano3_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_ano3_varid, 'long_name', & - & 'Mean dissolved nitrate concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_ano3_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_silica', NF90_DOUBLE, & - & time_dimid, zt_silica_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_silica_varid, 'long_name', & - & 'Total silicid acid (Si(OH)4) tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_silica_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_silica', NF90_DOUBLE, & - & time_dimid, zc_silica_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_silica_varid, 'long_name', & - & 'Mean silicid acid (Si(OH)4) concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_silica_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_doc', NF90_DOUBLE, & - & time_dimid, zt_doc_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_doc_varid, 'long_name', & - & 'Total dissolved organic carbon tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_doc_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_doc', NF90_DOUBLE, & - & time_dimid, zc_doc_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_doc_varid, 'long_name', & - & 'Mean dissolved organic carbon concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_doc_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_poc', NF90_DOUBLE, & - & time_dimid, zt_poc_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_poc_varid, 'long_name', & - & 'Total particulate organic carbon tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_poc_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_poc', NF90_DOUBLE, & - & time_dimid, zc_poc_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_poc_varid, 'long_name', & - & 'Mean particulate organic carbon concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_poc_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_phyto', NF90_DOUBLE, & - & time_dimid, zt_phyto_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_phyto_varid, 'long_name', & - & 'Total phytoplankton tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_phyto_varid, 'units', 'kmolP') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_phyto', NF90_DOUBLE, & - & time_dimid, zc_phyto_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_phyto_varid, 'long_name', & - & 'Mean phytoplankton concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_phyto_varid, 'units', 'kmolP/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_grazer', NF90_DOUBLE, & - & time_dimid, zt_grazer_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_grazer_varid, 'long_name', & - & 'Total zooplankton tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_grazer_varid, 'units', 'kmolP') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_grazer', NF90_DOUBLE, & - & time_dimid, zc_grazer_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_grazer_varid, 'long_name', & - & 'Mean zooplankton concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_grazer_varid, 'units', 'kmolP/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_calciu', NF90_DOUBLE, & - & time_dimid, zt_calciu_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_calciu_varid, 'long_name', & - & 'Total calcium carbonate tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_calciu_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_calciu', NF90_DOUBLE, & - & time_dimid, zc_calciu_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_calciu_varid, 'long_name', & - & 'Mean calcium carbonate concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_calciu_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_opal', NF90_DOUBLE, & - & time_dimid, zt_opal_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_opal_varid, 'long_name', & - & 'Total biogenic silica tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_opal_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_opal', NF90_DOUBLE, & - & time_dimid, zc_opal_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_opal_varid, 'long_name', & - & 'Mean biogenic silica concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_opal_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_n2o', NF90_DOUBLE, & - & time_dimid, zt_n2o_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_n2o_varid, 'long_name', & - & 'Total laughing gas (N2O) tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_n2o_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_n2o', NF90_DOUBLE, & - & time_dimid, zc_n2o_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_n2o_varid, 'long_name', & - & 'Mean laughing gas (N2O) concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_n2o_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_dms', NF90_DOUBLE, & - & time_dimid, zt_dms_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_dms_varid, 'long_name', & - & 'Total DiMethylSulfide tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_dms_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_dms', NF90_DOUBLE, & - & time_dimid, zc_dms_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_dms_varid, 'long_name', & - & 'Mean DiMethylSulfide concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_dms_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_fdust', NF90_DOUBLE, & - & time_dimid, zt_fdust_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_fdust_varid, 'long_name', & - & 'Total non-aggregated dust tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_fdust_varid, 'units', 'Mg') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_fdust', NF90_DOUBLE, & - & time_dimid, zc_fdust_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_fdust_varid, 'long_name', & - & 'Mean non-aggregate dust concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_fdust_varid, 'units', 'Mg/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_iron', NF90_DOUBLE, & - & time_dimid, zt_iron_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_iron_varid, 'long_name', & - & 'Total dissolved iron tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_iron_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_iron', NF90_DOUBLE, & - & time_dimid, zc_iron_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_iron_varid, 'long_name', & - & 'Mean dissolved iron concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_iron_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_prefo2', NF90_DOUBLE, & - & time_dimid, zt_prefo2_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_prefo2_varid, 'long_name', & - & 'Total preformed oxygen tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_prefo2_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_prefo2', NF90_DOUBLE, & - & time_dimid, zc_prefo2_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_prefo2_varid, 'long_name', & - & 'Mean preformed oxygen concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_prefo2_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_prefpo4', NF90_DOUBLE, & - & time_dimid, zt_prefpo4_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_prefpo4_varid, 'long_name', & - & 'Total preformed phosphate tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_prefpo4_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_prefpo4', NF90_DOUBLE, & - & time_dimid, zc_prefpo4_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_prefpo4_varid, 'long_name', & - & 'Mean preformed phosphate concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_prefpo4_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_prefalk', NF90_DOUBLE, & - & time_dimid, zt_prefalk_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_prefalk_varid, 'long_name', & - & 'Total preformed alkalinity tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_prefalk_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_prefalk', NF90_DOUBLE, & - & time_dimid, zc_prefalk_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_prefalk_varid, 'long_name', & - & 'Mean preformed alkalinity concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_prefalk_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_prefdic', NF90_DOUBLE, & - & time_dimid, zt_prefdic_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_prefdic_varid, 'long_name', & - & 'Total preformed DIC tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_prefdic_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_prefdic', NF90_DOUBLE, & - & time_dimid, zc_prefdic_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_prefdic_varid, 'long_name', & - & 'Mean preformed DIC concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_prefdic_varid, 'units', 'kmol/m^3') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zt_dicsat', NF90_DOUBLE, & - & time_dimid, zt_dicsat_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zt_dicsat_varid, 'long_name', & - & 'Total saturated DIC tracer') ) - call nccheck( NF90_PUT_ATT(ncid, zt_dicsat_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'zc_dicsat', NF90_DOUBLE, & - & time_dimid, zc_dicsat_varid) ) - call nccheck( NF90_PUT_ATT(ncid, zc_dicsat_varid, 'long_name', & - & 'Mean saturated DIC concentration') ) - call nccheck( NF90_PUT_ATT(ncid, zc_dicsat_varid, 'units', 'kmol/m^3') ) - - 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') ) - endif - - 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? - endif - - 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') ) - endif - - 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') ) - endif - - 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') ) - endif - - !--- Define variables : sum of inventory - call nccheck( NF90_DEF_VAR(ncid, 'totcarb', NF90_DOUBLE, time_dimid, & - & totcarb_varid) ) - call nccheck( NF90_PUT_ATT(ncid, totcarb_varid, 'long_name', & - & 'Global total of carbon') ) - call nccheck( NF90_PUT_ATT(ncid, totcarb_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'totphos', NF90_DOUBLE, time_dimid, & - & totphos_varid) ) - call nccheck( NF90_PUT_ATT(ncid, totphos_varid, 'long_name', & - & 'Global total of phosphorous') ) - call nccheck( NF90_PUT_ATT(ncid, totphos_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'totsili', NF90_DOUBLE, time_dimid, & - & totsili_varid) ) - call nccheck( NF90_PUT_ATT(ncid, totsili_varid, 'long_name', & - & 'Global total of silicate') ) - call nccheck( NF90_PUT_ATT(ncid, totsili_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'totnitr', NF90_DOUBLE, time_dimid, & - & totnitr_varid) ) - call nccheck( NF90_PUT_ATT(ncid, totnitr_varid, 'long_name', & - & 'Global total of nitrogen') ) - call nccheck( NF90_PUT_ATT(ncid, totnitr_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'totoxyg', NF90_DOUBLE, time_dimid, & - & totoxyg_varid) ) - call nccheck( NF90_PUT_ATT(ncid, totoxyg_varid, 'long_name', & - & 'Global total of oxygen') ) - call nccheck( NF90_PUT_ATT(ncid, totoxyg_varid, 'units', 'kmol') ) - - !--- Define variables : sediment fluxes - call nccheck( NF90_DEF_VAR(ncid, 'sum_zprorca', NF90_DOUBLE, & - & time_dimid, sum_zprorca_varid) ) - call nccheck( NF90_PUT_ATT(ncid, sum_zprorca_varid, 'long_name', & - & 'Global flux of detritus into sediments') ) - call nccheck( NF90_PUT_ATT(ncid, sum_zprorca_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'sum_zprcaca', NF90_DOUBLE, & - & time_dimid, sum_zprcaca_varid) ) - call nccheck( NF90_PUT_ATT(ncid, sum_zprcaca_varid, 'long_name', & - & 'Global flux of calcium carbonate into sediments') ) - call nccheck( NF90_PUT_ATT(ncid, sum_zprcaca_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'sum_zsilpro', NF90_DOUBLE, & - & time_dimid, sum_zsilpro_varid) ) - call nccheck( NF90_PUT_ATT(ncid, sum_zsilpro_varid, 'long_name', & - & 'Global flux of silicate into sediments') ) - call nccheck( NF90_PUT_ATT(ncid, sum_zsilpro_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'sum_expoor', NF90_DOUBLE, & - & time_dimid, sum_expoor_varid) ) - call nccheck( NF90_PUT_ATT(ncid, sum_expoor_varid, 'long_name', & - & 'Global total export production of carbon') ) - call nccheck( NF90_PUT_ATT(ncid, sum_expoor_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'sum_expoca', NF90_DOUBLE, & - & time_dimid, sum_expoca_varid) ) - call nccheck( NF90_PUT_ATT(ncid, sum_expoca_varid, 'long_name', & - & 'Global total export production of carbonate') ) - call nccheck( NF90_PUT_ATT(ncid, sum_expoca_varid, 'units', 'kmol') ) - - call nccheck( NF90_DEF_VAR(ncid, 'sum_exposi', NF90_DOUBLE, & - & time_dimid, sum_exposi_varid) ) - call nccheck( NF90_PUT_ATT(ncid, sum_exposi_varid, 'long_name', & - & 'Global total export production of silicate') ) - call nccheck( NF90_PUT_ATT(ncid, sum_exposi_varid, 'units', 'kmol') ) - - !--- End define mode. - call nccheck( NF90_ENDDEF(ncid) ) - - else - !=== Open existing netCDF file - write(io_stdo_bgc,*) 'Write BGC inventory to file : ', & - & trim(fname_inv(iogrp)) - call nccheck( NF90_OPEN(trim(fname_inv(iogrp)), NF90_WRITE, ncid) ) - !--- Inquire dimid - call nccheck( NF90_INQ_DIMID(ncid, "time", time_dimid) ) - if (.not. use_sedbypass) then - call nccheck( NF90_INQ_DIMID(ncid, 'npowtra', npowtra_dimid) ) - call nccheck( NF90_INQ_DIMID(ncid, 'nsedtra', nsedtra_dimid) ) - endif - !--- Inquire varid : time - call nccheck( NF90_INQ_VARID(ncid, "time", time_varid) ) - - 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) ) - endif - - !--- Inquire varid : ocean tracers - call nccheck( NF90_INQ_VARID(ncid, "ztotvol", ztotvol_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_sco212", zt_sco212_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_sco212", zc_sco212_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_alkali", zt_alkali_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_alkali", zc_alkali_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_phosph", zt_phosph_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_phosph", zc_phosph_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_oxygen", zt_oxygen_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_oxygen", zc_oxygen_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_gasnit", zt_gasnit_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_gasnit", zc_gasnit_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_ano3", zt_ano3_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_ano3", zc_ano3_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_silica", zt_silica_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_silica", zc_silica_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_doc", zt_doc_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_doc", zc_doc_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_poc", zt_poc_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_poc", zc_poc_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_phyto", zt_phyto_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_phyto", zc_phyto_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_grazer", zt_grazer_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_grazer", zc_grazer_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_calciu", zt_calciu_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_calciu", zc_calciu_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_opal", zt_opal_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_opal", zc_opal_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_n2o", zt_n2o_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_n2o", zc_n2o_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_dms", zt_dms_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_dms", zc_dms_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_fdust", zt_fdust_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_fdust", zc_fdust_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_iron", zt_iron_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_iron", zc_iron_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_prefo2", zt_prefo2_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_prefo2", zc_prefo2_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_prefpo4", zt_prefpo4_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_prefpo4", zc_prefpo4_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_prefalk", zt_prefalk_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zc_prefalk", zc_prefalk_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "zt_prefdic", zt_prefdic_varid) ) - 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) ) - 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) ) - endif - 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) ) - endif - 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) ) - endif - 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) ) - endif - 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) ) - endif - !--- Inquire varid : sum of inventory - call nccheck( NF90_INQ_VARID(ncid, "totcarb", totcarb_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "totphos", totphos_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "totsili", totsili_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "totnitr", totnitr_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "totoxyg", totoxyg_varid) ) - !--- Inquire varid : sediment fluxes - call nccheck( NF90_INQ_VARID(ncid, "sum_zprorca", sum_zprorca_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "sum_zprcaca", sum_zprcaca_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "sum_zsilpro", sum_zsilpro_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "sum_expoor", sum_expoor_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "sum_expoca", sum_expoca_varid) ) - call nccheck( NF90_INQ_VARID(ncid, "sum_exposi", sum_exposi_varid) ) - endif - - !=== Increment record by 1, reset start and count arrays - ncrec(iogrp) = ncrec(iogrp) + 1 - wrstart = (/ ncrec(iogrp) /) - if (.not. use_sedbypass) then - zpowtra_wrstart = (/ 1, ncrec(iogrp) /) - zpowtra_count = (/ npowtra, 1 /) - zsedtra_wrstart = (/ 1, ncrec(iogrp) /) - zsedtra_count = (/ nsedtra, 1 /) - endif - - !=== Write output data to netCDF file - !--- Write data : time - datenum = time - time0 - call nccheck( NF90_PUT_VAR(ncid, time_varid, datenum, start = wrstart) ) - 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) ) - endif - !--- Write data : ocean tracers - call nccheck( NF90_PUT_VAR(ncid, ztotvol_varid, ztotvol, start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_sco212_varid, & - & zocetratot(isco212), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_sco212_varid, & - & zocetratoc(isco212), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_alkali_varid, & - & zocetratot(ialkali), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_alkali_varid, & - & zocetratoc(ialkali), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_phosph_varid, & - & zocetratot(iphosph), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_phosph_varid, & - & zocetratoc(iphosph), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_oxygen_varid, & - & zocetratot(ioxygen), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_oxygen_varid, & - & zocetratoc(ioxygen), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_gasnit_varid, & - & zocetratot(igasnit), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_gasnit_varid, & - & zocetratoc(igasnit), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_ano3_varid, & - & zocetratot(iano3), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_ano3_varid, & - & zocetratoc(iano3), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_silica_varid, & - & zocetratot(isilica), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_silica_varid, & - & zocetratoc(isilica), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_doc_varid, & - & zocetratot(idoc), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_doc_varid, & - & zocetratoc(idoc), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_poc_varid, & - & zocetratot(idet), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_poc_varid, & - & zocetratoc(idet), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_phyto_varid, & - & zocetratot(iphy), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_phyto_varid, & - & zocetratoc(iphy), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_grazer_varid, & - & zocetratot(izoo), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_grazer_varid, & - & zocetratoc(izoo), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_calciu_varid, & - & zocetratot(icalc), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_calciu_varid, & - & zocetratoc(icalc), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_opal_varid, & - & zocetratot(iopal), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_opal_varid, & - & zocetratoc(iopal), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_n2o_varid, & - & zocetratot(ian2o), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_n2o_varid, & - & zocetratoc(ian2o), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_dms_varid, & - & zocetratot(idms), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_dms_varid, & - & zocetratoc(idms), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_fdust_varid, & - & zocetratot(ifdust), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_fdust_varid, & - & zocetratoc(ifdust), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_iron_varid, & - & zocetratot(iiron), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_iron_varid, & - & zocetratoc(iiron), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_prefo2_varid, & - & zocetratot(iprefo2), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_prefo2_varid, & - & zocetratoc(iprefo2), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_prefpo4_varid, & - & zocetratot(iprefpo4), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_prefpo4_varid, & - & zocetratoc(iprefpo4), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_prefalk_varid, & - & zocetratot(iprefalk), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_prefalk_varid, & - & zocetratoc(iprefalk), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_prefdic_varid, & - & zocetratot(iprefdic), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_prefdic_varid, & - & zocetratoc(iprefdic), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zt_dicsat_varid, & - & zocetratot(idicsat), start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, zc_dicsat_varid, & - & zocetratoc(idicsat), start = wrstart) ) - 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) ) - endif - 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) ) - endif - 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) ) - endif - 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) ) - endif - 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) ) - endif - !--- Write data : sum of inventory - call nccheck( NF90_PUT_VAR(ncid, totcarb_varid, totalcarbon, & - & start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, totphos_varid, totalphos, & - & start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, totsili_varid, totalsil, & - & start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, totnitr_varid, totalnitr, & - & start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, totoxyg_varid, totaloxy, & - & start = wrstart) ) - !--- Write data : fluxes into sediments - call nccheck( NF90_PUT_VAR(ncid, sum_zprorca_varid, sum_zprorca, & - & start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, sum_zprcaca_varid, sum_zprcaca, & - & start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, sum_zsilpro_varid, sum_zsilpro, & - & start = wrstart) ) - !--- Write data : global total export production - call nccheck( NF90_PUT_VAR(ncid, sum_expoor_varid, sum_expoor, & - & start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, sum_expoca_varid, sum_expoca, & - & start = wrstart) ) - call nccheck( NF90_PUT_VAR(ncid, sum_exposi_varid, sum_exposi, & - & start = wrstart) ) - - !--- Close netCDF file - call nccheck( NF90_CLOSE(ncid) ) - - !=== Check if file should be appended next time inventory routine is called - if (( (fileann_bgc(iogrp) .and. nday_of_year == 1 .or. & - & filemon_bgc(iogrp) .and. date%day == 1) .and. & - & mod(nstep, nstep_in_day) == 0) .or. & - & .not.(fileann_bgc(iogrp) .or. filemon_bgc(iogrp)) .and. & - & mod(nstep + .5, filefq_bgc(iogrp)) < 1.) then - append2file_inv(iogrp) = .false. - ncrec(iogrp) = 0 - else - append2file_inv(iogrp) = .true. - endif - - end subroutine write_netcdf - - - subroutine nccheck(status) - use netcdf, only: nf90_noerr - use mod_xc, only: xchalt - implicit none - - integer, intent(in) :: status - - if (status /= nf90_noerr) then - call xchalt('(inventory_bgc: Problem with netCDF)') - stop '(inventory_bgc: Problem with netCDF)' - endif - end subroutine nccheck - - -END SUBROUTINE INVENTORY_BGC diff --git a/hamocc/meson.build b/hamocc/meson.build index 16939429..0ea8ee2f 100644 --- a/hamocc/meson.build +++ b/hamocc/meson.build @@ -1,19 +1,16 @@ sources += files( - 'accfields.F90', - 'aufr_bgc.F90', - 'aufw_bgc.F90', - 'mo_ini_fields.F90', - 'carchm.F90', - 'carchm_kequi.F90', - 'carchm_solve.F90', - 'carchm_solve_DICsat.F90', - 'cyano.F90', - 'dipowa.F90', - 'get_cfc.F90', - 'hamocc4bcm.F90', - 'hamocc_init.F90', - 'hamocc_step.F90', - 'inventory_bgc.F90', + 'mo_accfields.F90', + 'mo_aufr_bgc.F90', + 'mo_aufw_bgc.F90', + 'mo_mo_ini_fields.F90', + 'mo_carchm.F90', + 'mo_cyano.F90', + 'mo_dipowa.F90', + 'mo_get_cfc.F90', + 'mo_hamocc4bcm.F90', + 'mo_hamocc_init.F90', + 'mo_hamocc_step.F90', + 'mo_inventory_bgc.F90', 'mo_Gdata_read.F90', 'mo_apply_fedep.F90', 'mo_apply_ndep.F90', @@ -37,15 +34,15 @@ sources += files( 'mo_read_sedpor.F90', 'mo_sedmnt.F90', 'mo_vgrid.F90', - 'ncout_hamocc.F90', - 'netcdf_def_vardb.F90', - 'ocprod.F90', - 'powach.F90', - 'powadi.F90', - 'preftrc.F90', - 'profile_gd.F90', - 'read_netcdf_var.F90', - 'restart_hamoccwt.F90', - 'sedshi.F90', - 'trc_limitc.F90', - 'write_netcdf_var.F90') + 'mo_ncout_hamocc.F90', + 'mo_netcdf_def_vardb.F90', + 'mo_ocprod.F90', + 'mo_powach.F90', + 'mo_powadi.F90', + 'mo_preftrc.F90', + 'mo_profile_gd.F90', + 'mo_read_netcdf_var.F90', + 'mo_restart_hamoccwt.F90', + 'mo_sedshi.F90', + 'mo_trc_limitc.F90', + 'mo_write_netcdf_var.F90') diff --git a/hamocc/mo_accfields.F90 b/hamocc/mo_accfields.F90 new file mode 100644 index 00000000..b8fd7cd8 --- /dev/null +++ b/hamocc/mo_accfields.F90 @@ -0,0 +1,475 @@ +! Copyright (C) 2020 J. Schwinger, A. Moree +! +! 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. +! +! 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. +! +! 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_ACCFIELDS + + implicit none + private + + public :: ACCFIELDS + +CONTAINS + + SUBROUTINE ACCFIELDS(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask) + + !******************************************************************************* + ! + !**** *ACCFIELDS* - . + ! + ! J.Schwinger, *UNI-RESEARCH* 2018-03-22 + ! + ! Modified + ! -------- + ! + ! Purpose + ! ------- + ! Accumulate fields for time-avaraged output and write output + ! + ! + ! + !**** Parameter list: + ! --------------- + ! + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. + ! *REAL* *pdlxp* - size of scalar grid cell (1st dimension) [m]. + ! *REAL* *pdlyp* - size of scalar grid cell (2nd dimension) [m]. + ! *REAL* *pddpo* - size of scalar grid cell (3rd dimension) [m]. + ! *REAL* *omask* - land/ocean mask + ! + !******************************************************************************* + 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, & + 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, & + int_chbr3_prod,int_chbr3_uv,asize3d,eps3d,wnumb,wmass + use mo_param_bgc, only: 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_inventory_bgc, only: inventory_bgc + use mo_ncwrt_bgc , only: ncwrt_bgc + + ! Arguments + 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 + + 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 + endif + + + ! 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 + + ! Atmosphere-ocean fluxes + bgct2d(i,j,jco2flux) = bgct2d(i,j,jco2flux) + atmflx(i,j,iatmco2)/2.0 + bgct2d(i,j,jo2flux) = bgct2d(i,j,jo2flux) + atmflx(i,j,iatmo2)/2.0 + bgct2d(i,j,jn2flux) = bgct2d(i,j,jn2flux) + atmflx(i,j,iatmn2)/2.0 + bgct2d(i,j,jn2oflux) = bgct2d(i,j,jn2oflux) + atmflx(i,j,iatmn2o)/2.0 + ! Particle fluxes between water-column and sediment + 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 + 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 + endif + ! 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 + bgct2d(i,j,jirdin) = bgct2d(i,j,jirdin) + rivinflx(i,j,irdin)/2.0 + bgct2d(i,j,jirdip) = bgct2d(i,j,jirdip) + rivinflx(i,j,irdip)/2.0 + bgct2d(i,j,jirsi) = bgct2d(i,j,jirsi) + rivinflx(i,j,irsi)/2.0 + bgct2d(i,j,jiralk) = bgct2d(i,j,jiralk) + rivinflx(i,j,iralk)/2.0 + bgct2d(i,j,jiriron) = bgct2d(i,j,jiriron) + rivinflx(i,j,iriron)/2.0 + bgct2d(i,j,jirdoc) = bgct2d(i,j,jirdoc) + rivinflx(i,j,irdoc)/2.0 + bgct2d(i,j,jirdet) = bgct2d(i,j,jirdet) + rivinflx(i,j,irdet)/2.0 + + endif + enddo + enddo + + ! Accumulate atmosphere fields and fluxes + call accsrf(jatmco2,atm(1,1,iatmco2),omask,0) + if (use_BOXATM) then + call accsrf(jatmo2 ,atm(1,1,iatmo2),omask,0) + call accsrf(jatmn2 ,atm(1,1,iatmn2),omask,0) + endif + 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) + 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) + 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 + call accsrf(jpco2,pco2d,omask,0) + call accsrf(jpco2m,pco2m,omask,0) + call accsrf(jkwco2khm,kwco2sol,omask,0) + call accsrf(jkwco2,kwco2d,omask,0) + call accsrf(jco2kh,co2sold,omask,0) + call accsrf(jco2khm,co2solm,omask,0) + call accsrf(jsrfphosph,ocetra(1,1,1,iphosph),omask,0) + call accsrf(jsrfoxygen,ocetra(1,1,1,ioxygen),omask,0) + call accsrf(jsrfiron,ocetra(1,1,1,iiron),omask,0) + call accsrf(jsrfano3,ocetra(1,1,1,iano3),omask,0) + call accsrf(jsrfalkali,ocetra(1,1,1,ialkali),omask,0) + call accsrf(jsrfsilica,ocetra(1,1,1,isilica),omask,0) + call accsrf(jsrfdic,ocetra(1,1,1,isco212),omask,0) + call accsrf(jsrfphyto,ocetra(1,1,1,iphy),omask,0) + call accsrf(jsrfph,hi(1,1,1),omask,0) + call accsrf(jdms,ocetra(1,1,1,idms),omask,0) + call accsrf(jexport,expoor,omask,0) + call accsrf(jexpoca,expoca,omask,0) + call accsrf(jexposi,exposi,omask,0) + call accsrf(jdmsprod,intdmsprod,omask,0) + call accsrf(jdms_uv,intdms_uv,omask,0) + call accsrf(jdms_bac,intdms_bac,omask,0) + call accsrf(jintphosy,intphosy,omask,0) + call accsrf(jintdnit,intdnit,omask,0) + call accsrf(jintnfix,intnfix,omask,0) + 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 + call accsrf(jndepfx,ndepflx,omask,0) + call accsrf(joalkfx,oalkflx,omask,0) + + ! Accumulate the diagnostic mass sinking field + IF( domassfluxes ) THEN + call accsrf(jcarflx0100,carflx0100,omask,0) + call accsrf(jbsiflx0100,bsiflx0100,omask,0) + call accsrf(jcalflx0100,calflx0100,omask,0) + call accsrf(jcarflx0500,carflx0500,omask,0) + call accsrf(jbsiflx0500,bsiflx0500,omask,0) + call accsrf(jcalflx0500,calflx0500,omask,0) + call accsrf(jcarflx1000,carflx1000,omask,0) + call accsrf(jbsiflx1000,bsiflx1000,omask,0) + call accsrf(jcalflx1000,calflx1000,omask,0) + call accsrf(jcarflx2000,carflx2000,omask,0) + call accsrf(jbsiflx2000,bsiflx2000,omask,0) + call accsrf(jcalflx2000,calflx2000,omask,0) + call accsrf(jcarflx4000,carflx4000,omask,0) + call accsrf(jbsiflx4000,bsiflx4000,omask,0) + call accsrf(jcalflx4000,calflx4000,omask,0) + call accsrf(jcarflx_bot,carflx_bot,omask,0) + call accsrf(jbsiflx_bot,bsiflx_bot,omask,0) + call accsrf(jcalflx_bot,calflx_bot,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 + 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) + call acclyr(jphosph,ocetra(1,1,1,iphosph),pddpo,1) + call acclyr(joxygen,ocetra(1,1,1,ioxygen),pddpo,1) + call acclyr(jiron,ocetra(1,1,1,iiron),pddpo,1) + call acclyr(jano3,ocetra(1,1,1,iano3),pddpo,1) + call acclyr(jalkali,ocetra(1,1,1,ialkali),pddpo,1) + call acclyr(jsilica,ocetra(1,1,1,isilica),pddpo,1) + call acclyr(jdic,ocetra(1,1,1,isco212),pddpo,1) + call acclyr(jdoc,ocetra(1,1,1,idoc),pddpo,1) + call acclyr(jpoc,ocetra(1,1,1,idet),pddpo,1) + call acclyr(jcalc,ocetra(1,1,1,icalc),pddpo,1) + call acclyr(jopal,ocetra(1,1,1,iopal),pddpo,1) + call acclyr(jn2o,ocetra(1,1,1,ian2o),pddpo,1) + call acclyr(jco3,co3,pddpo,1) + call acclyr(jph,hi,pddpo,1) + call acclyr(jomegaa,OmegaA,pddpo,1) + call acclyr(jomegac,OmegaC,pddpo,1) + call acclyr(jphosy,phosy3d,pddpo,1) + call acclyr(jo2sat,satoxy,pddpo,1) + call acclyr(jprefo2,ocetra(1,1,1,iprefo2),pddpo,1) + call acclyr(jprefpo4,ocetra(1,1,1,iprefpo4),pddpo,1) + 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) + 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 + IF (SUM(jlvlphyto+jlvlgrazer+jlvlphosph+jlvloxygen+jlvliron+ & + & jlvlano3+jlvlalkali+jlvlsilica+jlvldic+jlvldoc+jlvlpoc+jlvlcalc+& + & jlvlopal+jlvln2o+jlvlco3+jlvlph+jlvlomegaa+jlvlomegac+jlvlphosy+& + & jlvlo2sat+jlvlprefo2+jlvlprefpo4+jlvlprefalk+jlvlprefdic+ & + & jlvldicsat+jlvlnatdic+jlvlnatalkali+jlvlnatcalc+jlvlnatco3+ & + & jlvlnatomegaa+jlvlnatomegac+jlvldic13+jlvldic14+jlvld13c+ & + & jlvld14c+jlvlbigd14c+jlvlpoc13+jlvldoc13+jlvlcalc13+jlvlphyto13+& + & jlvlgrazer13+jlvlnos+jlvlwphy+jlvlwnos+jlvleps+jlvlasize+ & + & jlvlcfc11+jlvlcfc12+jlvlsf6+jlvlbromo).NE.0) THEN + DO k=1,kpke + call bgczlv(pddpo,k,ind1,ind2,wghts) + call acclvl(jlvlphyto,ocetra(1,1,1,iphy),k,ind1,ind2,wghts) + call acclvl(jlvlgrazer,ocetra(1,1,1,izoo),k,ind1,ind2,wghts) + call acclvl(jlvlphosph,ocetra(1,1,1,iphosph),k,ind1,ind2,wghts) + call acclvl(jlvloxygen,ocetra(1,1,1,ioxygen),k,ind1,ind2,wghts) + call acclvl(jlvliron,ocetra(1,1,1,iiron),k,ind1,ind2,wghts) + call acclvl(jlvlano3,ocetra(1,1,1,iano3),k,ind1,ind2,wghts) + call acclvl(jlvlalkali,ocetra(1,1,1,ialkali),k,ind1,ind2,wghts) + call acclvl(jlvlsilica,ocetra(1,1,1,isilica),k,ind1,ind2,wghts) + call acclvl(jlvldic,ocetra(1,1,1,isco212),k,ind1,ind2,wghts) + call acclvl(jlvldoc,ocetra(1,1,1,idoc),k,ind1,ind2,wghts) + call acclvl(jlvlpoc,ocetra(1,1,1,idet),k,ind1,ind2,wghts) + call acclvl(jlvlcalc,ocetra(1,1,1,icalc),k,ind1,ind2,wghts) + call acclvl(jlvlopal,ocetra(1,1,1,iopal),k,ind1,ind2,wghts) + call acclvl(jlvln2o,ocetra(1,1,1,ian2o),k,ind1,ind2,wghts) + call acclvl(jlvlco3,co3,k,ind1,ind2,wghts) + call acclvl(jlvlph,hi,k,ind1,ind2,wghts) + call acclvl(jlvlomegaa,OmegaA,k,ind1,ind2,wghts) + call acclvl(jlvlomegac,OmegaC,k,ind1,ind2,wghts) + call acclvl(jlvlphosy,phosy3d,k,ind1,ind2,wghts) + call acclvl(jlvlo2sat,satoxy,k,ind1,ind2,wghts) + call acclvl(jlvlprefo2,ocetra(1,1,1,iprefo2),k,ind1,ind2,wghts) + call acclvl(jlvlprefpo4,ocetra(1,1,1,iprefpo4),k,ind1,ind2,wghts) + 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) + 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 + + + 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)) + endif + + ! Write output if requested + DO l=1,nbgc + nacc_bgc(l)=nacc_bgc(l)+1 + if (bgcwrt(l)) then + if (GLB_INVENTORY(l).ne.0) then + CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,l) + endif + call ncwrt_bgc(l) + nacc_bgc(l)=0 + endif + ENDDO + + atmflx=0. ! nullifying atm flux here to have zero fluxes for stepwise inventory fluxes + ndepflx=0. + oalkflx=0. + rivinflx=0. + + END SUBROUTINE ACCFIELDS + +END MODULE MO_ACCFIELDS diff --git a/hamocc/mo_aufr_bgc.F90 b/hamocc/mo_aufr_bgc.F90 new file mode 100644 index 00000000..36abd8fc --- /dev/null +++ b/hamocc/mo_aufr_bgc.F90 @@ -0,0 +1,616 @@ +! Copyright (C) 2002 Ernst Maier-Reimer, S. Legutke, P. Wetzel +! Copyright (C) 2020 K. Assmann, J. Tjiputra, J. Schwinger, A. Moree +! M. Bentsen, P.-G. Chiu +! +! 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. +! +! 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. +! +! 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_AUFR_BGC + + implicit none + private + + public :: AUFR_BGC + +CONTAINS + + SUBROUTINE AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & + kplyear,kplmon,kplday,omask,rstfnm) + + !****************************************************************************** + ! + !**** *AUFR_BGC* - reads marine bgc restart data. + ! + ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 + ! + ! Modified + ! -------- + ! S.Legutke, *MPI-MaD, HH* 10.04.01 + ! - extra SBR for reading bgc data from the restart file. + ! S.Legutke, *MPI-MaD, HH* 15.08.01 + ! - netCDF version (with cond.comp. PNETCDF) + ! - no use of chemc values from netCDF restart + ! + ! Patrick Wetzel, *MPI-Met, HH* 16.04.02 + ! - read chemcm(i,j,7,12) from netCDF restart + ! + ! J.Schwinger, *GFI, Bergen* 2013-10-21 + ! - removed reading of chemcm and ak* fields + ! - code cleanup, remoded preprocessor option "PNETCDF" + ! and "NOMPI" + ! + ! J.Schwinger, *GFI, Bergen* 2014-05-21 + ! - adapted code for writing of two time level tracer + ! and sediment fields + ! + ! A.Moree, *GFI, Bergen* 2018-04-12 + ! - new version of carbon isotope code + ! + ! J.Tjiputra, *Uni Research, Bergen* 2018-04-12 + ! - added preformed and saturated DIC tracers + ! + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - added cappability to restart c-isotopes from scratch (from + ! 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 + ! not found in the restart file. + ! - removed satn2o which is not needed to restart the model + ! - added sediment bypass preprocessor option + ! + ! J.Schwinger, *Uni Research, Bergen* 2018-08-23 + ! - added reading of atmosphere field for BOXATM + ! + ! M. Bentsen, *NORCE, Bergen* 2020-05-03 + ! - changed ocean model from MICOM to BLOM + ! + ! Purpose + ! ------- + ! Read restart data to continue an interrupted integration. + ! + ! Method + ! ------- + ! 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 + ! difference of the offsets of restart files. + ! + ! + !** Interface to ocean model (parameter list): + ! ----------------------------------------- + ! + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. + ! *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 + ! ocean model [mol/kg] + ! *INTEGER* *kplyear* - year in ocean restart date + ! *INTEGER* *kplmon* - month in ocean restart date + ! *INTEGER* *kplday* - day in ocean restart date + ! *REAL* *omask* - land/ocean mask + ! *CHAR* *rstfnm* - restart file name-informations + ! + ! + !************************************************************************** + + use netcdf, only: nf90_global,nf90_noerr,nf90_nowrite,nf90_close, & + nf90_open,nf90_get_att,nf90_inq_varid + use mod_xc, only: nbdy,mnproc,iqr,jqr,xcbcst,xchalt + use mod_dia, only: iotype + use mo_carbch, only: co2star,co3,hi,satoxy,ocetra,atm,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, & + 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 + use mo_vgrid, only: kbo + use mo_sedmnt, only: sedhpl + use mo_intfcblom, only: sedlay2,powtra2,burial2,atm2 + use mo_param_bgc, only: bifr13,bifr14,c14fac,re1312,re14to,prei13,prei14 + use mo_read_netcdf_var, only: read_netcdf_var + + ! Arguments + integer, intent(in) :: kpie + integer, intent(in) :: kpje + integer, intent(in) :: kpke + integer, intent(in) :: ntr + integer, intent(in) :: ntrbgc + integer, intent(in) :: 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, 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 + real :: rco213,rco214,alpha14,beta13,beta14,d13c_atm,d14cat ! cisonew + integer :: ncid,ncstat,ncvarid + +#ifdef PNETCDF +# include +# include + integer*4 ,save :: info=MPI_INFO_NULL + integer :: mpicomm,mpierr,mpireq,mpistat + common/xcmpii/ mpicomm,mpierr,mpireq(4),mpistat(mpi_status_size,4*max(iqr,jqr)) + save /xcmpii/ +#endif + character(len=3) :: stripestr + 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 + ! + testio=0 + IF(mnproc==1 .AND. IOTYPE==0) THEN + + ncstat = NF90_OPEN(rstfnm,NF90_NOWRITE, ncid) + IF ( ncstat .NE. NF90_NOERR ) THEN + CALL xchalt('(AUFR: Problem with netCDF1)') + stop '(AUFR: Problem with netCDF1)' + ENDIF + ! + ! 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)' + ENDIF + restyear = idate(1) + restmonth = idate(2) + restday = idate(3) + restdtoce = idate(4) + ldtbgc = idate(5) + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) 'Date of bgc restart file : ' + WRITE(io_stdo_bgc,*) ' year = ',restyear + WRITE(io_stdo_bgc,*) ' month = ',restmonth + WRITE(io_stdo_bgc,*) ' day = ',restday + WRITE(io_stdo_bgc,*) ' dtoce = ',restdtoce + WRITE(io_stdo_bgc,*) ' dtbgc = ',ldtbgc + WRITE(io_stdo_bgc,*) ' ' + + ELSE IF(IOTYPE==1) THEN + +#ifdef PNETCDF + testio=1 + write(stripestr,('(i3)')) 16 + write(stripestr2,('(i9)')) 1024*1024 + call mpi_info_create(info,ierr) + call mpi_info_set(info,'romio_ds_read','disable',ierr) + call mpi_info_set(info,'romio_ds_write','disable',ierr) + call mpi_info_set(info,"striping_factor",stripestr,ierr) + call mpi_info_set(info,"striping_unit",stripestr2,ierr) + + ncstat = NFMPI_OPEN(mpicomm,rstfnm,NF_NOWRITE,INFO, ncid) + IF ( ncstat .NE. NF_NOERR ) THEN + CALL xchalt('(AUFR: Problem with netCDF1)') + stop '(AUFR: Problem with netCDF1)' + ENDIF + ! + ! 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)' + ENDIF + restyear = idate(1) + restmonth = idate(2) + restday = idate(3) + restdtoce = idate(4) + ldtbgc = idate(5) + IF(mnproc==1) THEN + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) 'Date of bgc restart file : ' + WRITE(io_stdo_bgc,*) ' year = ',restyear + WRITE(io_stdo_bgc,*) ' month = ',restmonth + WRITE(io_stdo_bgc,*) ' day = ',restday + WRITE(io_stdo_bgc,*) ' dtoce = ',restdtoce + WRITE(io_stdo_bgc,*) ' dtbgc = ',ldtbgc + WRITE(io_stdo_bgc,*) ' ' + ENDIF +#endif + if(testio .eq. 0) then + CALL xchalt('(AUFR: Problem with namelist iotype)') + stop '(AUFR: Problem with namelist iotype)' + endif + + ENDIF ! mnproc==1 .AND. IOTYPE==0 + + ! + ! Compare with date read from ocean restart file + ! + IF (mnproc.eq.1) THEN + + IF ( kplyear .NE. restyear ) WRITE(io_stdo_bgc,*) & + 'WARNING: restart years in oce/bgc are not the same : ', kplyear,'/',restyear,' !!!' + + IF ( kplmon .NE. restmonth ) WRITE(io_stdo_bgc,*) & + 'WARNING: restart months in oce/bgc are not the same : ',kplmon,'/',restmonth,' !!!' + + IF ( kplday .NE. restday ) WRITE(io_stdo_bgc,*) & + 'WARNING: restart days in oce/bgc are not the same : ', kplday,'/',restday,' !!!' + + ENDIF + + ! 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,'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 + 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,'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 + endif + + ! 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,'sco213',ncvarid) + if(ncstat.ne.nf_noerr) lread_iso=.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 + 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,'bromo',ncvarid) + if(ncstat.ne.nf_noerr) lread_bro=.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 (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 + 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 + ! + ! 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) + CALL read_netcdf_var(ncid,'oxygen',locetra(1,1,1,ioxygen),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'gasnit',locetra(1,1,1,igasnit),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'ano3',locetra(1,1,1,iano3),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'silica',locetra(1,1,1,isilica),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'doc',locetra(1,1,1,idoc),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'phyto',locetra(1,1,1,iphy),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'grazer',locetra(1,1,1,izoo),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'poc',locetra(1,1,1,idet),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'calciu',locetra(1,1,1,icalc),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'opal',locetra(1,1,1,iopal),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'n2o',locetra(1,1,1,ian2o),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'dms',locetra(1,1,1,idms),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'fdust',locetra(1,1,1,ifdust),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'iron',locetra(1,1,1,iiron),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'prefo2',locetra(1,1,1,iprefo2),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'prefpo4',locetra(1,1,1,iprefpo4),2*kpke,0,iotype) + CALL read_netcdf_var(ncid,'prefalk',locetra(1,1,1,iprefalk),2*kpke,0,iotype) + 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) + + if (use_cisonew .and. 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 + 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) + endif + if (use_CFC .and. 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 + 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 + endif + if (use_BROMO .and. lread_bro) then + CALL read_netcdf_var(ncid,'bromo',locetra(1,1,1,ibromo),2*kpke,0,iotype) + endif + ! + ! 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. + ! + 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 .and. 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 + ! + ! 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 + endif + + IF(mnproc==1 .AND. IOTYPE==0) THEN + ncstat = NF90_CLOSE(ncid) + ELSE IF(IOTYPE==1) THEN +#ifdef PNETCDF + ncstat = NFMPI_CLOSE(ncid) +#endif + ENDIF + + if (use_cisonew .and. .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 + DO k=1,2*ks + DO j=1,kpje + DO i=1,kpie + IF(omask(i,j) .GT. 0.5) THEN + rco213=locetra(i,j,kbo(i,j),isco213)/(locetra(i,j,kbo(i,j),isco212)+safediv) + rco214=locetra(i,j,kbo(i,j),isco214)/(locetra(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=locetra(i,j,kbo(i,j),isco213)/(locetra(i,j,kbo(i,j),isco212)+safediv) + rco214=locetra(i,j,kbo(i,j),isco214)/(locetra(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 ! .NOT. use_sedbypass + endif ! use_cisonew .and. .NOT. lread_iso + + ! 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) + + END SUBROUTINE AUFR_BGC + +END MODULE MO_AUFR_BGC diff --git a/hamocc/mo_aufw_bgc.F90 b/hamocc/mo_aufw_bgc.F90 new file mode 100644 index 00000000..f570a081 --- /dev/null +++ b/hamocc/mo_aufw_bgc.F90 @@ -0,0 +1,960 @@ +! Copyright (C) 2001 Ernst Maier-Reimer, S. Legutke +! Copyright (C) 2020 K. Assmann, J. Tjiputra, J. Schwinger, A. Moree +! M. Bentsen, P.-G. Chiu +! +! 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. +! +! 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. +! +! 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_AUFW_BGC + + implicit none + private + + public :: AUFW_BGC + +CONTAINS + + SUBROUTINE AUFW_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & + kplyear,kplmon,kplday,kpldtoce,omask,rstfnm) + + !****************************************************************************** + ! + !**** *AUFW_BGC* - write marine bgc restart data. + ! + ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 + ! + ! Modified + ! -------- + ! S.Legutke, *MPI-MaD, HH* 10.04.01 + ! - extra SBR for writing bgc data to the restart file. + ! S.Legutke, *MPI-MaD, HH* 15.08.01 + ! - netCDF version (cond.comp. PNETCDF) + ! - chemcm is multiplied with layer-dependent constant in order + ! to be displayable by ncview. It is not read in AUFR_BGC! + ! + ! J.Schwinger, *GFI, Bergen* 2013-10-21 + ! - tracer field is passed from ocean model for writing now + ! - removed writing of chemcm and ak* fields + ! - code cleanup, removed preprocessor option "PNETCDF" + ! + ! J.Schwinger, *GFI, Bergen* 2014-05-21 + ! - adapted code for writing of two time level tracer and + ! sediment fields + ! + ! A.Moree, *GFI, Bergen* 2018-04-12 + ! - new version of carbon isotope code + ! + ! J.Tjiputra, *Uni Research, Bergen* 2018-04-12 + ! - added preformed and saturated DIC tracers + ! + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - removed satn2o which is not needed to restart the model + ! - added sediment bypass preprocessor option + ! + ! J.Schwinger, *Uni Research, Bergen* 2018-08-23 + ! - added writing of atmosphere field for BOXATM + ! + ! M. Bentsen, *NORCE, Bergen* 2020-05-03 + ! - changed ocean model from MICOM to BLOM + ! + ! Purpose + ! ------- + ! Write restart data for continuation of interrupted integration. + ! + ! Method + ! ------- + ! 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)). + ! It can differ from that of the ocean (idate(4)) by the difference + ! of the offsets of restart files. + ! + ! + !** Interface to ocean model (parameter list): + ! ----------------------------------------- + ! + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. + ! *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 + ! ocean model [mol/kg] + ! *REAL* *sedlay2* - initial/restart sediment (two time levels) field + ! *REAL* *powtra2* - initial/restart pore water tracer (two time levels) field + ! *REAL* *burial2* - initial/restart sediment burial (two time levels) field + ! *INTEGER* *kplyear* - year in ocean restart date + ! *INTEGER* *kplmon* - month in ocean restart date + ! *INTEGER* *kplday* - day in ocean restart date + ! *INTEGER* *kpldtoce* - step in ocean restart date + ! *REAL* *omask* - land/ocean mask + ! *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 mod_xc, only: nbdy,itdm,jtdm,mnproc,iqr,jqr,xchalt + use mod_dia, only: iotype + use mo_carbch, only: co2star,co3,hi,satoxy,nathi + use mo_control_bgc, only: io_stdo_bgc,ldtbgc,rmasks,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 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 + use mo_netcdf_def_vardb, only: netcdf_def_vardb + use mo_write_netcdf_var, only: write_netcdf_var + + ! Arguments + INTEGER, intent(in) :: kpie,kpje,kpke,ntr,ntrbgc,itrbgc + REAL, intent(in) :: trc(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy,2*kpke,ntr) + REAL, intent(in) :: omask(kpie,kpje) + INTEGER, intent(in) :: kplyear,kplmon,kplday,kpldtoce + character(len=*), intent(in) :: rstfnm + + ! Local variables + INTEGER :: i,j + REAL :: locetra(kpie,kpje,2*kpke,nocetra) + INTEGER :: errstat + + ! Variables for netcdf + INTEGER :: ncid,ncvarid,ncstat,ncoldmod,ncdimst(4) + INTEGER :: nclatid,nclonid,nclevid,nclev2id,ncksid,ncks2id,nctlvl2id + INTEGER :: idate(5),ierr,testio + REAL :: rmissing + character(len=3) :: stripestr + character(len=9) :: stripestr2 +#ifdef PNETCDF +# include +# include + integer(kind=MPI_OFFSET_KIND) :: clen + integer*4 ,save :: info=MPI_INFO_NULL + integer :: mpicomm,mpierr,mpireq,mpistat + common/xcmpii/ mpicomm,mpierr,mpireq(4),mpistat(mpi_status_size,4*max(iqr,jqr)) + 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 + !-------------------------------------------------------------------- + ! + testio=0 + ! + ! Initialize local array for writing (locetra) + ! + locetra(:,:,:,:) = trc(1:kpie,1:kpje,:,itrbgc:itrbgc+ntrbgc-1) + + idate(1) = kplyear + idate(2) = kplmon + idate(3) = kplday + 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) + ENDIF + + rmissing = rmasko + ! + ! 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) + IF ( ncstat .NE. NF90_NOERR ) THEN + call xchalt('(AUFW: Problem with netCDF1)') + stop '(AUFW: Problem with netCDF1)' + ENDIF + ELSE IF (IOTYPE==1) THEN +#ifdef PNETCDF + testio=1 + IF(mnproc==1) write(io_stdo_bgc,*) 'BGC RESTART ',rstfnm + write(stripestr,('(i3)')) 16 + write(stripestr2,('(i9)')) 1024*1024 + call mpi_info_create(info,ierr) + call mpi_info_set(info,'romio_ds_read','disable',ierr) + call mpi_info_set(info,'romio_ds_write','disable',ierr) + call mpi_info_set(info,"striping_factor",stripestr,ierr) + call mpi_info_set(info,"striping_unit",stripestr2,ierr) + ncstat = NFMPI_CREATE(mpicomm,rstfnm, & + & IOR(nf_clobber,nf_64bit_offset),info,ncid) + IF ( ncstat .NE. NF_NOERR ) THEN + call xchalt('(AUFW: Problem with PnetCDF1)') + stop '(AUFW: Problem with PnetCDF1)' + ENDIF +#endif + if(testio .eq. 0) then + CALL xchalt('(AUFW: Problem with namelist iotype)') + stop '(AUFW: Problem with namelist iotype)' + endif + + ENDIF + ! + ! 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)' + ENDIF + + ncstat = NF90_DEF_DIM(ncid, 'lat', jtdm, nclatid) + IF ( ncstat .NE. NF90_NOERR ) THEN + call xchalt('(AUFW: Problem with netCDF3)') + stop '(AUFW: Problem with netCDF3)' + ENDIF + + ncstat = NF90_DEF_DIM(ncid, 'depth', kpke, nclevid) + IF ( ncstat .NE. NF90_NOERR ) THEN + call xchalt('(AUFW: Problem with netCDF4)') + stop '(AUFW: Problem with netCDF4)' + ENDIF + + ncstat = NF90_DEF_DIM(ncid, 'depth2', 2*kpke, nclev2id) + IF ( ncstat .NE. NF90_NOERR ) THEN + call xchalt('(AUFW: Problem with netCDF5)') + stop '(AUFW: Problem with netCDF5)' + ENDIF + + ncstat = NF90_DEF_DIM(ncid, 'nks', ks, ncksid) + IF ( ncstat .NE. NF90_NOERR ) THEN + call xchalt('(AUFW: Problem with netCDF6)') + stop '(AUFW: Problem with netCDF6)' + ENDIF + + ncstat = NF90_DEF_DIM(ncid, 'nks2', 2*ks, ncks2id) + IF ( ncstat .NE. NF90_NOERR ) THEN + call xchalt('(AUFW: Problem with netCDF7)') + stop '(AUFW: Problem with netCDF7)' + ENDIF + + ncstat = NF90_DEF_DIM(ncid, 'tlvl2', 2, nctlvl2id) + IF ( ncstat .NE. NF90_NOERR ) THEN + call xchalt('(AUFW: Problem with netCDF8)') + stop '(AUFW: Problem with netCDF8)' + ENDIF + + ELSE IF (IOTYPE==1) THEN +#ifdef PNETCDF + clen=itdm + ncstat = NFMPI_DEF_DIM(ncid, 'lon', clen, nclonid) + IF ( ncstat .NE. NF_NOERR ) THEN + call xchalt('(AUFW: Problem with PnetCDF2)') + stop '(AUFW: Problem with PnetCDF2)' + ENDIF + + clen=jtdm + ncstat = NFMPI_DEF_DIM(ncid, 'lat', clen, nclatid) + IF ( ncstat .NE. NF_NOERR ) THEN + call xchalt('(AUFW: Problem with PnetCDF3)') + stop '(AUFW: Problem with PnetCDF3)' + ENDIF + + clen=kpke + ncstat = NFMPI_DEF_DIM(ncid, 'depth', clen, nclevid) + IF ( ncstat .NE. NF_NOERR ) THEN + call xchalt('(AUFW: Problem with PnetCDF4)') + stop '(AUFW: Problem with PnetCDF4)' + ENDIF + + clen=2*kpke + ncstat = NFMPI_DEF_DIM(ncid, 'depth2', clen, nclev2id) + IF ( ncstat .NE. NF_NOERR ) THEN + call xchalt('(AUFW: Problem with PnetCDF5)') + stop '(AUFW: Problem with PnetCDF5)' + ENDIF + + clen=ks + ncstat = NFMPI_DEF_DIM(ncid, 'nks', clen, ncksid) + IF ( ncstat .NE. NF_NOERR ) THEN + call xchalt('(AUFW: Problem with PnetCDF6)') + stop '(AUFW: Problem with PnetCDF6)' + ENDIF + + clen=2*ks + ncstat = NFMPI_DEF_DIM(ncid, 'nks2', clen, ncks2id) + IF ( ncstat .NE. NF_NOERR ) THEN + call xchalt('(AUFW: Problem with PnetCDF7)') + stop '(AUFW: Problem with PnetCDF7)' + ENDIF + + clen=2 + ncstat = NFMPI_DEF_DIM(ncid, 'tlvl2', clen, nctlvl2id) + IF ( ncstat .NE. NF_NOERR ) THEN + call xchalt('(AUFW: Problem with PnetCDF8)') + stop '(AUFW: Problem with PnetCDF8)' + ENDIF +#endif + ENDIF !mnproc==1 .AND. IOTYPE==0 + + ! + ! Define global attributes + ! ---------------------------------------------------------------------- + ! + IF (mnproc==1 .AND. IOTYPE==0) THEN + + ncstat = NF90_PUT_ATT(ncid, NF90_GLOBAL,'title' & + &, 'Restart data for marine bgc modules') + IF ( ncstat .NE. NF90_NOERR ) THEN + call xchalt('(AUFW: Problem with netCDF9)') + stop '(AUFW: Problem with netCDF9)' + ENDIF + + ncstat = NF90_PUT_ATT(ncid, NF90_GLOBAL,'history' & + &, 'Restart data for marine bgc modules') + IF ( ncstat .NE. NF90_NOERR ) THEN + call xchalt('(AUFW: Problem with netCDF10)') + stop '(AUFW: Problem with netCDF10)' + ENDIF + + ncstat = NF90_PUT_ATT(ncid, NF90_GLOBAL,'conventions' & + &,'COARDS') + IF ( ncstat .NE. NF90_NOERR ) THEN + call xchalt('(AUFW: Problem with netCDF11)') + stop '(AUFW: Problem with netCDF11)' + ENDIF + + ncstat = NF90_PUT_ATT(ncid, NF90_GLOBAL,'source' & + &, 'Marine bgc model output HOPC68/grob') + IF ( ncstat .NE. NF90_NOERR ) THEN + call xchalt('(AUFW: Problem with netCDF12)') + stop '(AUFW: Problem with netCDF12)' + ENDIF + + ncstat = NF90_PUT_ATT(ncid, NF90_GLOBAL, 'date', idate) + IF ( ncstat .NE. NF90_NOERR ) THEN + call xchalt('(AUFW: Problem with netCDF13)') + stop '(AUFW: Problem with netCDF13)' + ENDIF + + ELSE IF (IOTYPE==1) THEN +#ifdef PNETCDF + clen=len('Restart data for marine bgc modules') + ncstat = NFMPI_PUT_ATT_TEXT(ncid, NF_GLOBAL,'title' & + &, clen,'Restart data for marine bgc modules') + IF ( ncstat .NE. NF_NOERR ) THEN + call xchalt('(AUFW: Problem with PnetCDF9)') + stop '(AUFW: Problem with PnetCDF9)' + ENDIF + + clen=len('Restart data for marine bgc modules') + ncstat = NFMPI_PUT_ATT_TEXT(ncid, NF_GLOBAL,'history' & + &, clen,'Restart data for marine bgc modules') + IF ( ncstat .NE. NF_NOERR ) THEN + call xchalt('(AUFW: Problem with PnetCDF10)') + stop '(AUFW: Problem with PnetCDF10)' + ENDIF + + clen=6 + ncstat = NFMPI_PUT_ATT_TEXT(ncid, NF_GLOBAL,'conventions' & + &,clen, 'COARDS') + IF ( ncstat .NE. NF_NOERR ) THEN + call xchalt('(AUFW: Problem with PnetCDF11)') + stop '(AUFW: Problem with PnetCDF11)' + ENDIF + + clen=len('Marine bgc model output HOPC68/grob') + ncstat = NFMPI_PUT_ATT_TEXT(ncid, NF_GLOBAL,'source' & + &,clen, 'Marine bgc model output HOPC68/grob') + IF ( ncstat .NE. NF_NOERR ) THEN + call xchalt('(AUFW: Problem with PnetCDF12)') + stop '(AUFW: Problem with PnetCDF12)' + ENDIF + + clen=5 + ncstat = NFMPI_PUT_ATT_INT(ncid, NF_GLOBAL, 'date', & + & nf_int, clen, idate) + IF ( ncstat .NE. NF_NOERR ) THEN + call xchalt('(AUFW: Problem with netCDF13)') + stop '(AUFW: Problem with netCDF13)' + + ENDIF +#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,'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,'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,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,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,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,'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,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,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,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,'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,6,'dicsat',3,ncdimst,ncvarid, & + & 6,'mol/kg',13,'Saturated dic', & + rmissing,31,io_stdo_bgc) + + 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) + + CALL NETCDF_DEF_VARDB(ncid,6,'sco214',3,ncdimst,ncvarid, & + & 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) + + CALL NETCDF_DEF_VARDB(ncid,5,'doc14',3,ncdimst,ncvarid, & + & 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) + + CALL NETCDF_DEF_VARDB(ncid,5,'poc14',3,ncdimst,ncvarid, & + & 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) + + 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) + + CALL NETCDF_DEF_VARDB(ncid,8,'grazer14',3,ncdimst,ncvarid, & + & 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) + + CALL NETCDF_DEF_VARDB(ncid,8,'calciu14',3,ncdimst,ncvarid, & + & 7,'molC/kg',19,'Calcium carbonate14', & + & rmissing,43,io_stdo_bgc) + endif + 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) + + CALL NETCDF_DEF_VARDB(ncid,5,'adust',3,ncdimst,ncvarid, & + & 4,'g/kg',15,'Aggregated dust', & + & rmissing,45,io_stdo_bgc) + endif + if (use_CFC) then + CALL NETCDF_DEF_VARDB(ncid,5,'cfc11',3,ncdimst,ncvarid, & + & 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) + + CALL NETCDF_DEF_VARDB(ncid,3,'sf6',3,ncdimst,ncvarid, & + & 6,'mol/kg',4,'SF-6', & + & rmissing,49,io_stdo_bgc) + endif + 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) + + CALL NETCDF_DEF_VARDB(ncid,9,'natalkali',3,ncdimst,ncvarid, & + & 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 + 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 + + 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,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) + + 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 + ! + ! Define variables : sediment + ! ---------------------------------------------------------------------- + ! + if (.not. use_sedbypass) then + + IF((mnproc==1 .AND. IOTYPE==0) .OR. IOTYPE==1) THEN + 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) + + CALL NETCDF_DEF_VARDB(ncid,6,'sssc12',3,ncdimst,ncvarid, & + & 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) + + CALL NETCDF_DEF_VARDB(ncid,6,'ssster',3,ncdimst,ncvarid, & + & 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) + + CALL NETCDF_DEF_VARDB(ncid,6,'powaal',3,ncdimst,ncvarid, & + & 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) + + CALL NETCDF_DEF_VARDB(ncid,6,'powaox',3,ncdimst,ncvarid, & + & 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) + + 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) + + 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) + + 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,'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,'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 + + IF((mnproc==1 .AND. IOTYPE==0) .OR. IOTYPE==1) THEN + 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 + ! ---------------------------------------------------------------------- + ! + 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,7,'bur_o12',3,ncdimst,ncvarid, & + & 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) + + 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) + + 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) + + 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) + endif + + endif ! not sedbypass + ! + ! Define variables: atmosphere + ! ---------------------------------------------------------------------- + ! + if (use_BOXATM) then + + 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) + + CALL NETCDF_DEF_VARDB(ncid,5,'atmo2',3,ncdimst,ncvarid, & + & 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) + + 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) + endif + 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) + endif + endif ! 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)' + ENDIF + ! + ! Set fill mode + ! ---------------------------------------------------------------------- + ! + ncstat = NF90_SET_FILL(ncid,NF90_NOFILL, ncoldmod) + IF ( ncstat .NE. NF90_NOERR ) THEN + call xchalt('(AUFW: Problem with netCDF97)') + stop '(AUFW: Problem with netCDF97)' + ENDIF + + 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) + 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) + endif + 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 + 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 + 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 + 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) + if (use_natDIC) then + CALL write_netcdf_var(ncid,'nathi',nathi(1,1,1),kpke,0) + endif + ! + ! 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) + CALL write_netcdf_var(ncid,'ssster',sedlay2(1,1,1,issster),2*ks,0) + CALL write_netcdf_var(ncid,'bur_o12',burial2(1,1,1,issso12),2,0) + CALL write_netcdf_var(ncid,'bur_c12',burial2(1,1,1,isssc12),2,0) + CALL write_netcdf_var(ncid,'bur_sil',burial2(1,1,1,issssil),2,0) + CALL write_netcdf_var(ncid,'bur_clay',burial2(1,1,1,issster),2,0) + CALL write_netcdf_var(ncid,'sedhpl',sedhpl(1,1,1),ks,0) + CALL write_netcdf_var(ncid,'powaic',powtra2(1,1,1,ipowaic),2*ks,0) + CALL write_netcdf_var(ncid,'powaal',powtra2(1,1,1,ipowaal),2*ks,0) + CALL write_netcdf_var(ncid,'powaph',powtra2(1,1,1,ipowaph),2*ks,0) + CALL write_netcdf_var(ncid,'powaox',powtra2(1,1,1,ipowaox),2*ks,0) + 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) + 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) + endif + endif + ! + ! 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) + 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) + endif + if (use_natDIC) then + 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 +#ifdef PNETCDF + 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 + WRITE(io_stdo_bgc,*) 'End of AUFW_BGC' + WRITE(io_stdo_bgc,*) '***************' + ENDIF + + END SUBROUTINE AUFW_BGC + +END MODULE MO_AUFW_BGC diff --git a/hamocc/carchm.F90 b/hamocc/mo_carchm.F90 similarity index 99% rename from hamocc/carchm.F90 rename to hamocc/mo_carchm.F90 index 9844982c..3cfa3e22 100644 --- a/hamocc/carchm.F90 +++ b/hamocc/mo_carchm.F90 @@ -23,8 +23,9 @@ MODULE MO_CARCHM private public :: CARCHM + public :: CARCHM_SOLVE + private :: CARCHM_KEQUI - private :: CARCHM_SOLVE private :: CARCHM_SOLVE_DICSAT CONTAINS @@ -125,8 +126,7 @@ SUBROUTINE CARCHM(kpie,kpje,kpke,kbnd, & nathi,natco3,natpco2d,natomegaa,natomegac use mo_sedmnt, only: sedlay,powtra,burial - implicit none - + ! Arguments INTEGER, intent(in) :: kpie,kpje,kpke,kbnd REAL, intent(in) :: pdlxp(kpie,kpje) REAL, intent(in) :: pdlyp(kpie,kpje) diff --git a/hamocc/mo_clim_swa.F90 b/hamocc/mo_clim_swa.F90 index 0cee6ba0..96fb4910 100644 --- a/hamocc/mo_clim_swa.F90 +++ b/hamocc/mo_clim_swa.F90 @@ -69,12 +69,15 @@ subroutine ini_swa_clim(kpie,kpje,omask) use netcdf, only: nf90_noerr,nf90_nowrite,nf90_close,nf90_open use mod_xc, only: mnproc,xchalt use mo_control_bgc, only: io_stdo_bgc + use mo_read_netcdf_var, only: read_netcdf_var implicit none - integer, intent(in) :: kpie,kpje - real, intent(in) :: omask(kpie,kpje) + ! Arguments + integer, intent(in) :: kpie,kpje + real, intent(in) :: omask(kpie,kpje) + ! Local variables integer :: i,j integer :: ncid,ncstat,ncvarid,errstat diff --git a/hamocc/mo_cyano.F90 b/hamocc/mo_cyano.F90 new file mode 100644 index 00000000..084c31d4 --- /dev/null +++ b/hamocc/mo_cyano.F90 @@ -0,0 +1,136 @@ +! Copyright (C) 2001 Ernst Maier-Reimer, S. Legutke +! Copyright (C) 2020 J. Schwinger, I. Kriest +! +! 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. +! +! 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. +! +! 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_CYANO + + implicit none + private + + public :: CYANO + +CONTAINS + + SUBROUTINE CYANO(kpie,kpje,kpke,kbnd,pddpo,omask,ptho) + + !********************************************************************** + ! + !**** *CYANO* - . + ! + ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 + ! + ! Modified + ! -------- + ! S.Legutke, *MPI-MaD, HH* 10.04.01 + ! - included : surface reduction of gaseous nitrogen + ! + ! I.Kriest, *GEOMAR, Kiel* 2016-08-11 + ! - included T-dependence of cyanobacteria growth + ! - modified oxygen stoichiometry for N2-Fixation + ! + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - moved accumulation of all output fields to seperate subroutine, + ! related code-restructuring + ! - added reduction of alkalinity through N-fixation + ! + ! Purpose + ! ------- + ! Nitrogen-fixation by cyano bacteria, followed by remineralisation + ! and nitrification + ! + ! Method: + ! ------ + ! + ! + !** Interface to ocean model (parameter list): + ! ----------------------------------------- + ! + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. + ! *INTEGER* *kbnd* - nb of halo grid points + ! *REAL* *ptho* - potential temperature. + ! + ! Externals + ! --------- + ! . + !********************************************************************** + + use mo_vgrid, only: kmle + use mo_carbch, only: ocetra + use mo_param_bgc, only: bluefix,rnit,tf0,tf1,tf2,tff + use mo_param1_bgc, only: ialkali,iano3,igasnit,iphosph,ioxygen,inatalkali + use mo_biomod, only: intnfix + use mo_control_bgc, only: use_natDIC + + ! Arguments + integer, intent(in) :: kpie,kpje,kpke,kbnd + real, intent(in) :: pddpo(kpie,kpje,kpke) + real, intent(in) :: omask(kpie,kpje) + real, intent(in) :: ptho(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) + + ! Local variables + integer :: i,j,k + real :: oldocetra,dano3 + real :: ttemp,nfixtfac + + intnfix(:,:)=0.0 + ! + ! N-fixation by cyano bacteria (followed by remineralisation and nitrification), + ! it is assumed here that this process is limited to the mixed layer + ! + DO j=1,kpje + DO i=1,kpie + IF(omask(i,j).gt.0.5) THEN + DO k=1,kmle(i,j) + IF(ocetra(i,j,k,iano3).LT.(rnit*ocetra(i,j,k,iphosph))) THEN + + oldocetra = ocetra(i,j,k,iano3) + ttemp = min(40.,max(-3.,ptho(i,j,k))) + + ! Temperature dependence of nitrogen fixation, Kriest and Oschlies 2015. + nfixtfac = MAX(0.0,tf2*ttemp*ttemp + tf1*ttemp + tf0)/tff + + ocetra(i,j,k,iano3)=ocetra(i,j,k,iano3)*(1-bluefix*nfixtfac) & + + bluefix*nfixtfac*rnit*ocetra(i,j,k,iphosph) + + dano3=ocetra(i,j,k,iano3)-oldocetra + + ocetra(i,j,k,igasnit)=ocetra(i,j,k,igasnit)-dano3*(1./2.) + + ! Note: to fix one mole N2 requires: N2+H2O+y*O2 = 2* HNO3 <-> y=2.5 mole O2. + ! I.e., to release one mole HNO3 = H+ + NO3- requires 1.25 mole O2 + ocetra(i,j,k,ioxygen)=ocetra(i,j,k,ioxygen)-dano3*1.25 + + ! 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 + if (use_natDIC) then + ocetra(i,j,k,inatalkali)=ocetra(i,j,k,inatalkali)-dano3 + endif + + intnfix(i,j) = intnfix(i,j) + (ocetra(i,j,k,iano3)-oldocetra)*pddpo(i,j,k) + + ENDIF + ENDDO + ENDIF + ENDDO + ENDDO + + END SUBROUTINE CYANO + +END MODULE MO_CYANO diff --git a/hamocc/mo_dipowa.F90 b/hamocc/mo_dipowa.F90 new file mode 100644 index 00000000..129029fb --- /dev/null +++ b/hamocc/mo_dipowa.F90 @@ -0,0 +1,212 @@ +! Copyright (C) 2001 Ernst Maier-Reimer, S. Legutke +! Copyright (C) 2020 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. +! +! 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. +! +! 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_DIPOWA + + implicit none + private + + public :: DIPOWA + +CONTAINS + + SUBROUTINE DIPOWA(kpie,kpje,kpke,omask,lspin) + + !********************************************************************** + ! + !**** *DIPOWA* - 'diffusion of pore water' + ! vertical diffusion of sediment pore water tracers + ! + ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 + ! + ! Modified + ! -------- + ! S.Legutke, *MPI-MaD, HH* 10.04.01 + ! - all npowtra-1 properties are diffused in 1 go. + ! js: not mass conserving check c13/powtra/ocetra + ! + ! Purpose + ! ------- + ! calculate vertical diffusion of sediment pore water properties + ! and diffusive flux through the ocean/sediment interface. + ! integration. + ! + ! Method + ! ------- + ! implicit formulation; + ! constant diffusion coefficient : 1.e-9 set in ini_sedmnt in mo_sedmnt + ! diffusion coefficient : zcoefsu/zcoeflo for upper/lower + ! sediment layer boundary. + ! + !** Interface. + ! ---------- + ! + ! *CALL* *DIPOWA* + ! + ! Externals + ! --------- + ! none. + ! + !********************************************************************** + + use mo_carbch, only: ocetra, sedfluxo + use mo_sedmnt, only: powtra,porwat,porwah,seddw,zcoefsu,zcoeflo + use mo_param1_bgc, only: ks,npowtra,map_por2octra + use mo_vgrid, only: kbo,bolay + ! cisonew + use mo_param1_bgc, only: ipowc13,ipowc14,isco213,isco214 + ! natDIC + use mo_param1_bgc, only: ialkali,inatalkali,inatsco212,isco212 + use mo_control_bgc, only: use_natDIC + + implicit none + + integer, intent(in) :: kpie, kpje, kpke + real, intent(in) :: omask(kpie,kpje) + logical, intent(in) :: lspin + + ! Local variables + integer :: i,j,k,l,iv + integer :: iv_oc ! index of ocetra in powtra loop + + real :: sedb1(kpie,0:ks,npowtra) ! ???? + real :: tredsy(kpie,0:kpke,3) ! redsy for 'reduced system'? + real :: aprior ! start value of oceanic tracer in bottom layer + + + !$OMP PARALLEL DO & + !$OMP&PRIVATE(i,k,iv,l,tredsy,sedb1,aprior,iv_oc) + j_loop: do j=1,kpje + + k = 0 + do i = 1,kpie + tredsy(i,k,1) = zcoefsu(i,j,k) + tredsy(i,k,3) = zcoeflo(i,j,k) + tredsy(i,k,2) = bolay(i,j) - tredsy(i,k,1) - tredsy(i,k,3) + ! dz(kbo) - diff upper - diff lower + enddo + + k = 0 + do iv = 1,npowtra ! loop over pore water tracers + iv_oc = map_por2octra(iv) + do i = 1,kpie + sedb1(i,k,iv) = 0. + if (omask(i,j) > 0.5) then + sedb1(i,k,iv) = ocetra(i,j,kbo(i,j),iv_oc) * bolay(i,j) + ! tracer_concentration(kbo) * dz(kbo) + endif + enddo + enddo + + do k = 1,ks + do i = 1,kpie + tredsy(i,k,1) = zcoefsu(i,j,k) + tredsy(i,k,3) = zcoeflo(i,j,k) + tredsy(i,k,2) = seddw(k)*porwat(i,j,k) -tredsy(i,k,1) -tredsy(i,k,3) + enddo + enddo + + do iv = 1,npowtra + do k = 1,ks + do i = 1,kpie + ! tracer_concentration(k[1:ks]) * porewater fraction(k) * dz(k) + sedb1(i,k,iv) = powtra(i,j,k,iv) * porwat(i,j,k) * seddw(k) + enddo + enddo + enddo + + do k = 1,ks + do i = 1,kpie + if (omask(i,j) > 0.5) then + ! this overwrites tredsy(k=0) for k=1 + tredsy(i,k-1,1) = tredsy(i,k,1) / tredsy(i,k-1,2) + ! diff upper / conc (k-1) + tredsy(i,k,2) = tredsy(i,k,2) & + & - tredsy(i,k-1,3) * tredsy(i,k,1) / tredsy(i,k-1,2) + ! concentration - diff lower * diff upper / conc(k-1) + endif + enddo + enddo + + ! diffusion from above + do iv = 1,npowtra + do k = 1,ks + do i = 1,kpie + sedb1(i,k,iv) = sedb1(i,k,iv) - tredsy(i,k-1,1) * sedb1(i,k-1,iv) + enddo + enddo + enddo + + ! sediment bottom layer + k = ks + do iv = 1,npowtra + do i = 1,kpie + if (omask(i,j) > 0.5) then + powtra(i,j,k,iv) = sedb1(i,k,iv) / tredsy(i,k,2) + endif + enddo + enddo + + ! sediment column + do iv = 1,npowtra + do k = 1,ks-1 + l = ks-k + do i = 1,kpie + if (omask(i,j) > 0.5) then + powtra(i,j,l,iv) = ( sedb1(i,l,iv) & + & - tredsy(i,l,3) * powtra(i,j,l+1,iv) ) / tredsy(i,l,2) + endif + enddo + enddo + enddo + + if(.not. lspin) THEN + ! sediment ocean interface + do iv = 1, npowtra + iv_oc = map_por2octra(iv) + do i = 1,kpie + l = 0 + if (omask(i,j) > 0.5) then + aprior = ocetra(i,j,kbo(i,j),iv_oc) + ocetra(i,j,kbo(i,j),iv_oc) = & + & ( sedb1(i,l,iv) - tredsy(i,l,3) * powtra(i,j,l+1,iv) ) & + & / tredsy(i,l,2) + + ! diffusive fluxes (positive downward) + sedfluxo(i,j,iv) = sedfluxo(i,j,iv) & + & -(ocetra(i,j,kbo(i,j),iv_oc) - aprior)* bolay(i,j) + 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 + endif + endif + enddo + enddo + + endif ! .not. lspin + + enddo j_loop + + END SUBROUTINE DIPOWA + +END MODULE MO_DIPOWA diff --git a/hamocc/mo_get_cfc.F90 b/hamocc/mo_get_cfc.F90 new file mode 100644 index 00000000..fb0b250d --- /dev/null +++ b/hamocc/mo_get_cfc.F90 @@ -0,0 +1,199 @@ +! Copyright (C) 2020 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. +! +! 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. +! +! 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_GET_CFC + + implicit none + private + + public :: GET_CFC + +CONTAINS + + SUBROUTINE GET_CFC(kplyear,atm_cfc11_nh,atm_cfc12_nh,atm_sf6_nh, & + atm_cfc11_sh,atm_cfc12_sh,atm_sf6_sh) + ! + !********************************************************************** + ! + !**** *GET_CFC* - . + ! + ! Jerry Tjiputra *BCCR* 05.12.2012 + ! + use mo_control_bgc, only: io_stdo_bgc + use mod_xc, only: mnproc + + ! Arguments + integer, intent(in) :: kplyear + real, intent(out) :: atm_cfc11_nh,atm_cfc12_nh,atm_sf6_nh + real, intent(out) :: atm_cfc11_sh,atm_cfc12_sh,atm_sf6_sh + + ! Local variables + integer :: i + integer :: yr_dat(105) + integer :: start_yr + real :: cfc_11_nh(105),cfc_12_nh(105),sf_6_nh(105) + real :: cfc_11_sh(105),cfc_12_sh(105),sf_6_sh(105) + integer, save :: kplyear_old = 0 + + ! ****************************************************************** + ! Data from EMil Jeansson (Bullister, 2008; Walker et al. 2000; Maiss and Brenninkmeijer (1998) + ! First (last) data represents year 1910.5 (2014.5), Units are all in [ppt] + DATA cfc_11_nh & + & / 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.1, 0.1, 0.1, 0.2, 0.4, 0.7, & + & 1.01, 1.51, 2.21, 3.02, 4.12, 5.33, 6.83, 8.14, 9.45,11.06, & + & 13.27,16.18,19.60,23.72,28.44,33.67,39.40,46.03,53.77,62.41, & + & 72.06, 82.71, 94.87, 108.34, 121.41, & + & 133.97, 145.93, 156.58, 168.34, 176.68, & + & 184.32, 191.46, 199.30, 208.04, 217.99, & + & 229.35, 241.61, 252.86, 259.30, 265.83, & + & 268.24, 268.14, 269.55, 269.65, 268.34, & + & 266.93, 265.73, 264.52, 263.12, 261.71, & + & 260.00, 258.19, 256.18, 253.97, 251.96, & + & 249.55, 247.54, 245.63, 243.61, 241.33, & + & 239.41, 236.60, 235.08, 233.55/ + + DATA cfc_11_sh & + & / 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.1, 0.1, 0.1, 0.2, 0.4, & + & 0.7, 1.01, 1.51, 2.21, 3.02, 4.02, 5.23, 6.53, 7.84, 9.15, & + & 10.85,13.07,15.78,19.20,23.12,27.64,32.66,38.29,44.82,52.26, & + & 60.70, 69.95, 80.40, 92.16, 104.72, & + & 117.09, 129.35, 140.80, 148.74, 159.30, & + & 167.84, 176.08, 184.52, 192.46, 202.01, & + & 211.36, 222.21, 233.27, 242.11, 251.06, & + & 256.68, 260.80, 262.51, 263.72, 263.22, & + & 262.91, 262.01, 261.01, 259.90, 258.29, & + & 256.98, 255.08, 253.27, 251.36, 249.15, & + & 247.34, 245.03, 243.12, 241.07, 239.19, & + & 236.92, 234.60, 233.29, 231.97/ + + DATA cfc_12_nh & + & / 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.1, 0.1, 0.2, 0.3, 0.4, & + & 0.5, 0.7, 0.9, 1.2, 1.7, 2.3, 3.4, 4.8, 6.1, 7.6, & + & 9.2, 11.0, 12.8, 15.0, 17.4, 20.2, 23.4, 26.8, 30.5, 35.0, & + & 40.0, 45.8, 52.5, 60.4, 69.3, 79.2, 90.3,102.8,116.8,132.00, & + & 148.40, 166.10, 185.80, 207.10, 228.20, & + & 248.10, 266.90, 284.30, 306.10, 323.20, & + & 339.60, 353.40, 369.00, 385.70, 403.40, & + & 424.30, 444.00, 465.40, 483.60, 497.70, & + & 506.00, 516.30, 523.20, 528.50, 533.40, & + & 537.30, 540.10, 542.90, 544.40, 545.90, & + & 546.50, 546.70, 546.70, 545.70, 544.90, & + & 543.10, 541.10, 538.60, 536.11, 533.30, & + & 530.67, 527.16, 525.26, 523.36/ + + DATA cfc_12_sh & + & / 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.1, 0.1, 0.2, 0.3, & + & 0.4, 0.5, 0.7, 0.9, 1.2, 1.7, 2.4, 3.4, 4.7, 6.0, & + & 7.4, 9.0, 10.7, 12.6, 14.7, 17.1, 19.9, 23.0, 26.3, 30.1, & + & 34.4, 39.4, 45.1, 51.8, 59.5, 68.2, 77.9, 88.8,101.1,114.7, & + & 129.6,145.7,163.3,182.5,202.9,223.2,242.7,261.2,273.5,292.3, & + & 308.8,325.5,342.6,359.4,378.2,396.5,416.3,435.8,454.4,472.7, & + & 487.3,498.3,507.0,514.8,521.0,526.5,530.8,534.3,537.2,539.0, & + & 540.6, 541.3, 541.6, 541.5, 540.7, & + & 539.8, 538.1, 536.2, 533.53, 530.94, & + & 528.47, 525.88, 523.48, 521.08/ + + DATA sf_6_nh & + & / 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & + & 0.000, 0.000, 0.042, 0.043, 0.043, & + & 0.044, 0.046, 0.048, 0.051, 0.055, & + & 0.061, 0.068, 0.078, 0.091, 0.109, & + & 0.131, 0.155, 0.181, 0.207, 0.235, & + & 0.266, 0.301, 0.341, 0.386, 0.438, & + & 0.501, 0.579, 0.665, 0.766, 0.887, & + & 1.011, 1.141, 1.273, 1.409, 1.562, & + & 1.722, 1.892, 2.063, 2.237, 2.427, & + & 2.640, 2.868, 3.104, 3.350, 3.600, & + & 3.861, 4.080, 4.262, 4.485, 4.690, & + & 4.909, 5.135, 5.360, 5.580, 5.795, & + & 6.034, 6.324, 6.613, 6.876, 7.191, & + & 7.439, 7.715, 8.066, 8.417/ + + DATA sf_6_sh & + & / 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & + & 0.000, 0.000, 0.039, 0.039, 0.040, & + & 0.041, 0.042, 0.044, 0.047, 0.051, & + & 0.056, 0.062, 0.071, 0.084, 0.100, & + & 0.120, 0.142, 0.166, 0.190, 0.215, & + & 0.243, 0.276, 0.312, 0.354, 0.401, & + & 0.459, 0.531, 0.610, 0.703, 0.813, & + & 0.927, 1.046, 1.167, 1.292, 1.432, & + & 1.579, 1.735, 1.892, 2.051, 2.225, & + & 2.420, 2.629, 2.846, 3.071, 3.300, & + & 3.560, 3.824, 4.026, 4.262, 4.471, & + & 4.657, 4.887, 5.081, 5.305, 5.513, & + & 5.749, 6.028, 6.286, 6.576, 6.856, & + & 7.159, 7.424, 7.754, 8.084/ + + start_yr=1910 + do i=1,105 + yr_dat(i)=start_yr+i-1 + enddo + + ! ****************************************************************** + !if (kplyear.lt.start_yr) then + atm_cfc11_nh=0.0 + atm_cfc11_sh=0.0 + atm_cfc12_nh=0.0 + atm_cfc12_sh=0.0 + atm_sf6_nh=0.0 + atm_sf6_sh=0.0 + + do i=1,105 + if (kplyear.eq.yr_dat(i)) then + atm_cfc11_nh=cfc_11_nh(i) + atm_cfc11_sh=cfc_11_sh(i) + atm_cfc12_nh=cfc_12_nh(i) + atm_cfc12_sh=cfc_12_sh(i) + atm_sf6_nh=sf_6_nh(i) + atm_sf6_sh=sf_6_sh(i) + endif + enddo + + IF (mnproc.EQ.1 .AND. kplyear.GT.kplyear_old) THEN + write(io_stdo_bgc,*) 'ATM NH CFC11, CFC12, SF6=', & + & kplyear,atm_cfc11_nh,atm_cfc12_nh,atm_sf6_nh + write(io_stdo_bgc,*) 'ATM SH CFC11, CFC12, SF6=', & + & kplyear,atm_cfc11_sh,atm_cfc12_sh,atm_sf6_sh + kplyear_old = kplyear + ENDIF + + END SUBROUTINE get_cfc + +END MODULE MO_GET_CFC diff --git a/hamocc/mo_hamocc4bcm.F90 b/hamocc/mo_hamocc4bcm.F90 new file mode 100644 index 00000000..bef23145 --- /dev/null +++ b/hamocc/mo_hamocc4bcm.F90 @@ -0,0 +1,433 @@ +! Copyright (C) 2001 Ernst Maier-Reimer +! 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. +! +! 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. +! +! 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_HAMOCC4BCM + + implicit none + private + + public :: HAMOCC4BCM + +CONTAINS + + SUBROUTINE HAMOCC4BCM(kpie,kpje,kpke,kbnd,kplyear,kplmon,kplday,kldtday,& + pdlxp,pdlyp,pddpo,prho,pglat,omask, & + dust,rivin,ndep,oafx,pi_ph, & + pfswr,psicomo,ppao,pfu10,ptho,psao, & + patmco2,pflxco2,pflxdms,patmbromo,pflxbromo) + + !****************************************************************************** + ! + ! HAMOCC4BGC - main routine of iHAMOCC. + ! + ! Modified + ! -------- + ! J.Schwinger *GFI, Bergen* 2013-10-21 + ! - added GNEWS2 option for riverine input of carbon and nutrients + ! - code cleanup + ! + ! J.Schwinger *GFI, Bergen* 2014-05-21 + ! - moved copying of tracer field to ocetra to micom2hamocc + ! and hamocc2micom + ! + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - moved accumulation of all output fields to seperate subroutine, + ! related code-restructuring + ! - added sediment bypass preprocessor option + ! + ! J.Schwinger, *NORCE Climate, Bergen* 2020-05-28 + ! - restructuring of iHAMOCC code, cleanup parameter list + ! - boundary conditions (dust, riverinput, N-deposition) are now passed as + ! an argument + ! + ! Parameter list: + ! --------------- + ! + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. + ! *INTEGER* *kbnd* - nb of halo grid points. + ! *INTEGER* *kplyear* - current year. + ! *INTEGER* *kplmon* - current month. + ! *INTEGER* *kplday* - current day. + ! *INTEGER* *kldtday* - number of time step in current day. + ! *REAL* *pdlxp* - size of grid cell (longitudinal) [m]. + ! *REAL* *pdlyp* - size of grid cell (latitudinal) [m]. + ! *REAL* *pddpo* - size of grid cell (depth) [m]. + ! *REAL* *prho* - density [kg/m^3]. + ! *REAL* *pglat* - latitude of grid cells [deg north]. + ! *REAL* *omask* - land/ocean mask. + ! *REAL* *dust* - dust deposition flux [kg/m2/month]. + ! *REAL* *rivin* - riverine input [kmol m-2 yr-1]. + ! *REAL* *ndep* - nitrogen deposition [kmol m-2 yr-1]. + ! *REAL* *oaflx* - alkalinity flux from alkalinization [kmol m-2 yr-1] + ! *REAL* *pfswr* - solar radiation [W/m**2]. + ! *REAL* *psicomo* - sea ice concentration + ! *REAL* *ppao* - sea level pressure [Pascal]. + ! *REAL* *pfu10* - absolute wind speed at 10m height [m/s] + ! *REAL* *ptho* - potential temperature [deg C]. + ! *REAL* *psao* - salinity [psu.]. + ! *REAL* *patmco2* - atmospheric CO2 concentration [ppm] used in + ! fully coupled mode (prognostic/diagnostic CO2). + ! *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. + ! + !****************************************************************************** + use mod_xc, only: mnproc + 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_BROMO, use_CFC, use_PBGC_CK_TIMESTEP,& + use_BOXATM, use_sedbypass,ocn_co2_type + 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 + use mo_boxatm, only: update_boxatm + use mo_inventory_bgc, only: inventory_bgc + use mo_sedshi, only: sedshi + use mo_get_cfc, only: get_cfc + use mo_powach, only: powach + use mo_preftrc, only: preftrc + use mo_cyano, only: cyano + use mo_ocprod, only: ocprod + use mo_carchm, only: carchm + + ! Arguments + integer, intent(in) :: kpie,kpje,kpke,kbnd + integer, intent(in) :: kplyear,kplmon,kplday,kldtday + real, intent(in) :: pdlxp (kpie,kpje) + real, intent(in) :: pdlyp (kpie,kpje) + real, intent(in) :: pddpo (kpie,kpje,kpke) + real, intent(in) :: prho (kpie,kpje,kpke) + real, intent(in) :: pglat (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) + real, intent(in) :: omask (kpie,kpje) + real, intent(in) :: dust (kpie,kpje) + real, intent(in) :: rivin (kpie,kpje,nriv) + real, intent(in) :: ndep (kpie,kpje) + real, intent(in) :: oafx (kpie,kpje) + real, intent(in) :: pi_ph (kpie,kpje) + real, intent(in) :: pfswr (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) + real, intent(in) :: psicomo(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) + real, intent(in) :: ppao (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) + real, intent(in) :: pfu10 (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) + real, intent(in) :: ptho (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) + 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(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) + + ! Local variables + integer :: i,j,k,l + integer :: nspin,it + logical :: lspin + + IF (mnproc.eq.1) THEN + write(io_stdo_bgc,*) 'iHAMOCC',KLDTDAY,LDTRUNBGC,NDTDAYBGC + ENDIF + + + !-------------------------------------------------------------------- + ! Increment bgc time step counter of run (initialized in HAMOCC_INIT). + ! + ldtrunbgc = ldtrunbgc + 1 + + !-------------------------------------------------------------------- + ! Increment bgc time step counter of experiment. + ! + ldtbgc = ldtbgc + 1 + + !-------------------------------------------------------------------- + ! Calculate variables related to the vertical grid + ! + call set_vgrid(kpie,kpje,kpke,pddpo) + + !-------------------------------------------------------------------- + ! Pass net solar radiation + ! + !$OMP PARALLEL DO PRIVATE(i) + DO j=1,kpje + DO i=1,kpie + strahl(i,j)=pfswr(i,j) + ENDDO + ENDDO + !$OMP END PARALLEL DO + + !-------------------------------------------------------------------- + ! Pass atmospheric co2 if coupled to an active atmosphere model + ! + if (trim(ocn_co2_type) == 'diagnostic' .or. trim(ocn_co2_type) == 'prognostic') 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' + endif + + 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' + endif + + !-------------------------------------------------------------------- + ! Read atmospheric cfc concentrations + ! + 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) + 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) + endif + + !--------------------------------------------------------------------- + ! Biogeochemistry + ! + ! Apply dust (iron) deposition + ! This routine should be moved to the other routines that handle + ! external inputs below for consistency. For now we keep it here + ! to maintain bit-for-bit reproducibility with the CMIP6 version of + ! the model + call apply_fedep(kpie,kpje,kpke,pddpo,omask,dust) + + call ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) + + 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) + endif + + + do l=1,nocetra + do K=1,kpke + !$OMP PARALLEL DO PRIVATE(i) + do J=1,kpje + do I=1,kpie + if (OMASK(I,J) .gt. 0.5 ) then + OCETRA(I,J,K,L)=MAX(0.,OCETRA(I,J,K,L)) + endif + enddo + enddo + !$OMP END PARALLEL DO + enddo + enddo + + 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) + endif + + call cyano(kpie,kpje,kpke,kbnd,pddpo,omask,ptho) + + 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) + endif + + call carchm(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,prho,pglat,omask, & + psicomo,ppao,pfu10,ptho,psao) + + 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) + endif + + ! Apply n-deposition + call apply_ndep(kpie,kpje,kpke,pddpo,omask,ndep) + + 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) + endif + + ! Apply riverine input of carbon and nutrients + call apply_rivin(kpie,kpje,kpke,pddpo,omask,rivin) + + 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) + endif + + ! Apply alkalinity flux due to ocean alkalinization + call apply_oafx(kpie,kpje,kpke,pddpo,omask,oafx) + + 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) + endif + + ! Update atmospheric pCO2 [ppm] + if (use_BOXATM) then + call update_boxatm(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask) + 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) + endif + + ! update preformed tracers + call preftrc(kpie,kpje,omask) + + !-------------------------------------------------------------------- + ! Sediment module + + if (.not. use_sedbypass) then + + ! 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( itsedspin_yr_e) then + call xchalt('(invalid sediment spinup start/end year)') + stop '(invalid sediment spinup start/end year)' + endif + if(sedspin_ncyc < 2) then + call xchalt('(invalid nb. of sediment spinup subcycles)') + stop '(invalid nb. of sediment spinup subcycles)' + endif + endif + ENDIF + + ! init the index-mapping between pore water and ocean tracers + CALL init_por2octra_mapping() + ! + ! --- Memory allocation + ! + CALL ALLOC_MEM_INTFCBLOM(idm,jdm,kdm) + CALL ALLOC_MEM_BGCMEAN(idm,jdm,kdm) + CALL ALLOC_MEM_VGRID(idm,jdm,kdm) + CALL ALLOC_MEM_BIOMOD(idm,jdm,kdm) + CALL ALLOC_MEM_SEDMNT(idm,jdm) + CALL ALLOC_MEM_CARBCH(idm,jdm,kdm) + ! + ! --- initialise trc array (two time levels) + ! + do nt=itrbgc,itrbgc+ntrbgc-1 + do k=1,2*kk + do j=1,jj + do i=1,ii + trc(i,j,k,nt)=0.0 + enddo + enddo + enddo + enddo + ! + ! --- initialise HAMOCC land/ocean mask + ! + do j=1,jj + do l=1,isp(j) + do i=max(1,ifp(j,l)),min(ii,ilp(j,l)) + omask(i,j)=1. + enddo + enddo + enddo + ! + ! --- BLOM to HAMOCC interface + ! + call blom2hamocc(2,1,kk,0) + ! + ! --- Calculate variables related to the vertical grid + ! + call set_vgrid(idm,jdm,kdm,bgc_dp) + ! + ! --- Initialize parameters + ! + CALL ini_parambgc(idm,jdm) + + ! --- Initialize atmospheric fields with (updated) parameter values + call ini_fields_atm(idm,jdm) + + ! --- Initialize sediment and ocean tracers + CALL ini_fields_ocean(read_rest,idm,jdm,kdm,nbdy,bgc_dp,bgc_rho,omask,plon,plat) + + ! --- Initialize sediment layering + ! First, read the porosity and potentially apply it in ini_sedimnt + CALL read_sedpor(idm,jdm,ks,omask,sed_por) + CALL ini_sedmnt(idm,jdm,kdm,omask,sed_por) + ! + ! --- Initialise reading of input data (dust, n-deposition, river, etc.) + ! + CALL ini_read_fedep(idm,jdm,omask) + + CALL ini_read_ndep(idm,jdm) + + CALL ini_read_rivin(idm,jdm,omask) + + CALL ini_read_oafx(idm,jdm,bgc_dx,bgc_dy,plat,omask) + + if (use_BROMO) then + CALL ini_swa_clim(idm,jdm,omask) + endif + + call ini_pi_ph(idm,jdm,omask) + ! + ! --- Read restart fields from restart file if requested, otherwise + ! (at first start-up) copy ocetra and sediment arrays (which are + ! initialised in BELEG_VARS) to both timelevels of their respective + ! two-time-level counterpart + ! + IF(read_rest.eq.1) THEN + CALL AUFR_BGC(idm,jdm,kdm,ntr,ntrbgc,itrbgc,trc, & + & date%year,date%month,date%day,omask,rstfnm_hamocc) + ELSE + trc(1:idm,1:jdm,1:kdm, itrbgc:itrbgc+ntrbgc-1) = & + & ocetra(:,:,:,:) + trc(1:idm,1:jdm,kdm+1:2*kdm,itrbgc:itrbgc+ntrbgc-1) = & + & ocetra(:,:,:,:) + if (.not. use_sedbypass) then + sedlay2(:,:,1:ks,:) = sedlay(:,:,:,:) + sedlay2(:,:,ks+1:2*ks,:) = sedlay(:,:,:,:) + powtra2(:,:,1:ks,:) = powtra(:,:,:,:) + powtra2(:,:,ks+1:2*ks,:) = powtra(:,:,:,:) + burial2(:,:,1,:) = burial(:,:,:) + burial2(:,:,2,:) = burial(:,:,:) + endif + if (use_BOXATM) then + atm2(:,:,1,:) = atm(:,:,:) + atm2(:,:,2,:) = atm(:,:,:) + endif + ENDIF + + if (mnproc.eq.1) then + write(io_stdo_bgc,*) + WRITE(io_stdo_bgc,*)'********************************************' + write(io_stdo_bgc,*) 'iHAMOCC: finished initialisation' + write(io_stdo_bgc,*) + endif + + !****************************************************************************** + END SUBROUTINE HAMOCC_INIT + +END MODULE MO_HAMOCC_INIT diff --git a/hamocc/mo_hamocc_step.F90 b/hamocc/mo_hamocc_step.F90 new file mode 100644 index 00000000..0b66c1fd --- /dev/null +++ b/hamocc/mo_hamocc_step.F90 @@ -0,0 +1,101 @@ +! Copyright (C) 2020 K. Assmann, J. Tjiputra, J. Schwinger, M. Bentsen +! +! 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. +! +! 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. +! +! 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_HAMOCC_STEP + + implicit none + private + + public :: HAMOCC_STEP + +CONTAINS + + SUBROUTINE HAMOCC_STEP(m,n,mm,nn,k1m,k1n) + ! + ! --- ------------------------------------------------------------------ + ! --- perform one HAMOCC step + ! --- ------------------------------------------------------------------ + ! + use mod_xc, only: idm,jdm,kdm,nbdy + use mod_time, only: date,nday_of_year,nstep,nstep_in_day + use mod_grid, only: plat + use mod_state, only: temp,saln + use mod_forcing, only: swa,slp,abswnd,atmco2,flxco2,flxdms, & + atmbrf,flxbrf + use mod_seaice, only: ficem + use mo_bgcmean, only: nbgc,bgcwrt, diagfq_bgc,diagmon_bgc, & + diagann_bgc + use mo_intfcblom, only: bgc_dx,bgc_dy,bgc_dp,bgc_rho,omask, & + blom2hamocc,hamocc2blom + use mo_read_rivin, only: rivflx + use mo_read_fedep, only: get_fedep + use mo_read_ndep, only: get_ndep + use mo_read_oafx, only: get_oafx + use mo_read_pi_ph, only: get_pi_ph,pi_ph + use mo_control_bgc, only: with_dmsph + use mo_accfields, only: accfields + use mo_hamocc4bcm, only: hamocc4bcm + use mo_trc_limitc, only: trc_limitc + + ! Arguments + integer, intent(in) :: m,n,mm,nn,k1m,k1n + + ! Local variables + integer :: l,ldtday + real :: ndep(idm,jdm) + real :: dust(idm,jdm) + real :: oafx(idm,jdm) + + call trc_limitc(nn) + + call blom2hamocc(m,n,mm,nn) + + ldtday = mod(nstep,nstep_in_day) + + do l=1,nbgc + bgcwrt(l)=.false. + if (((diagann_bgc(l).and.nday_of_year.eq.1.or.diagmon_bgc(l) & + & .and.date%day.eq.1).and.mod(nstep,nstep_in_day).eq.0).or. & + & .not.(diagann_bgc(l).or.diagmon_bgc(l)).and. & + & mod(nstep+.5,diagfq_bgc(l)).lt.1.) then + bgcwrt(l)=.true. + end if + enddo + + call get_fedep(idm,jdm,date%month,dust) + call get_ndep(idm,jdm,date%year,date%month,omask,ndep) + call get_oafx(idm,jdm,date%year,date%month,omask,oafx) + if(with_dmsph) call get_pi_ph(idm,jdm,date%month) + + call hamocc4bcm(idm,jdm,kdm,nbdy, & + & date%year,date%month,date%day,ldtday, & + & bgc_dx,bgc_dy,bgc_dp,bgc_rho,plat,omask, & + & dust,rivflx,ndep,oafx,pi_ph, & + & swa,ficem,slp,abswnd, & + & temp(1-nbdy,1-nbdy,1+nn),saln(1-nbdy,1-nbdy,1+nn), & + & atmco2,flxco2,flxdms,atmbrf,flxbrf) + + ! + ! --- accumulate fields and write output + ! + call accfields(idm,jdm,kdm,bgc_dx,bgc_dy,bgc_dp,omask) + + call hamocc2blom(m,n,mm,nn) + + END SUBROUTINE HAMOCC_STEP + +END MODULE MO_HAMOCC_STEP diff --git a/hamocc/mo_ini_fields.F90 b/hamocc/mo_ini_fields.F90 index 8a848fa5..af8e7850 100644 --- a/hamocc/mo_ini_fields.F90 +++ b/hamocc/mo_ini_fields.F90 @@ -16,18 +16,20 @@ ! ! 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_ini_fields - implicit none +MODULE MO_INI_FIELDS + implicit none private - public :: ini_fields_ocean,ini_fields_atm + public :: INI_FIELDS_OCEAN + public :: INI_FIELDS_ATM contains - !--------------------------------------------------------------------------------------------------------------------------------- - subroutine ini_fields_atm(kpie,kpje) + !******************************************************************************* + SUBROUTINE INI_FIELDS_ATM(kpie,kpje) + use mo_control_bgc, only: use_natDIC,use_cisonew,use_BROMO use mo_param1_bgc, only: iatmco2,iatmo2,iatmn2,iatmnco2,iatmc13,iatmc14,iatmbromo use mo_param_bgc, only: atm_o2,atm_n2,atm_co2_nat,atm_c13,atm_c14,c14fac,atm_bromo @@ -62,11 +64,12 @@ subroutine ini_fields_atm(kpie,kpje) endif ENDDO ENDDO - end subroutine ini_fields_atm + END SUBROUTINE INI_FIELDS_ATM + ! =============================================================================== + SUBROUTINE INI_FIELDS_OCEAN(kpaufr,kpie,kpje,kpke,kbnd,pddpo,prho,omask,pglon,pglat) - SUBROUTINE ini_fields_ocean(kpaufr,kpie,kpje,kpke,kbnd,pddpo,prho,omask,pglon,pglat) !****************************************************************************** ! ! BELEG_VARS - initialize bgc variables. @@ -104,30 +107,30 @@ SUBROUTINE ini_fields_ocean(kpaufr,kpie,kpje,kpke,kbnd,pddpo,prho,omask,pglon,pg use mo_param_bgc, only: fesoly,cellmass,fractdim,bifr13,bifr14,c14fac,re1312,re14to use mo_biomod, only: abs_oce 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, & - 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_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, & + 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 use mo_carbch, only: nathi,natco3 use mo_sedmnt, only: sedhpl,burial,powtra,sedlay + use mo_profile_gd, only: profile_gd - implicit none - - INTEGER, intent(in) :: kpaufr,kpie,kpje,kpke,kbnd - REAL, intent(in) :: pddpo(kpie,kpje,kpke) - REAL, intent(in) :: prho (kpie,kpje,kpke) - REAL, intent(in) :: omask(kpie,kpje) - REAL, intent(in) :: pglon(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - REAL, intent(in) :: pglat(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) + ! Arguments + integer, intent(in) :: kpaufr,kpie,kpje,kpke,kbnd + real, intent(in) :: pddpo(kpie,kpje,kpke) + real, intent(in) :: prho (kpie,kpje,kpke) + real, intent(in) :: omask(kpie,kpje) + real, intent(in) :: pglon(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) + real, intent(in) :: pglat(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) ! local variables - INTEGER :: i,j,k,l - REAL :: rco213,rco214,beta13,beta14 ! cisonew - REAL :: snow ! AGG + integer :: i,j,k,l + real :: rco213,rco214,beta13,beta14 ! cisonew + real :: snow ! agg if (use_FB_BGC_OCE) then DO k=1,kpke @@ -141,7 +144,6 @@ SUBROUTINE ini_fields_ocean(kpaufr,kpie,kpje,kpke,kbnd,pddpo,prho,omask,pglon,pg ! ! Initialisation of ocean tracers and sediment ! - ! Initialise ocean tracers with WOA and GLODAP data. This is done even in case ! of a restart since some tracers (e.g. C-isotopes) might not be in the restart ! file and aufr.f90 instead expects an initialised field. @@ -321,8 +323,6 @@ SUBROUTINE ini_fields_ocean(kpaufr,kpie,kpje,kpke,kbnd,pddpo,prho,omask,pglon,pg ENDDO endif - return - !****************************************************************************** - end subroutine ini_fields_ocean + END SUBROUTINE INI_FIELDS_OCEAN -end module mo_ini_fields +END MODULE MO_INI_FIELDS diff --git a/hamocc/mo_inventory_bgc.F90 b/hamocc/mo_inventory_bgc.F90 new file mode 100644 index 00000000..79ef2311 --- /dev/null +++ b/hamocc/mo_inventory_bgc.F90 @@ -0,0 +1,1910 @@ +! Copyright (C) 2002 P. Wetzel +! Copyright (C) 2022 K. Assmann, J. Tjiputra, J. Schwinger, T. Torsvik +! +! 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. +! +! 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. +! +! 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_INVENTORY_BGC + + implicit none + private + + public :: INVENTORY_BGC + +CONTAINS + + SUBROUTINE INVENTORY_BGC(kpie,kpje,kpke,dlxp,dlyp,ddpo,omask,iogrp) + + !******************************************************************* + ! + !**** *INVENTORY_BGC* - calculate the BGC inventory. + ! + ! P.Wetzel, *MPI-Met, HH* 29.07.02 + ! + ! Modified + ! -------- + ! T. Torsvik *UiB* 22.02.22 + ! Include option for writing inventory to netCDF file. + ! + ! Purpose + ! ------- + ! - calculate the BGC inventory. + ! + ! Method + ! ------- + ! - + ! + !** Interface. + ! ---------- + ! + ! *CALL* *INVENTORY_BGC* + ! + ! + !** Interface to ocean model (parameter list): + ! ----------------------------------------- + ! + ! + ! Externals + ! --------- + ! none. + ! + !********************************************************************** + use mod_xc, only: mnproc,ips,nbdy,xcsum + use mo_carbch, only: atm,atmflx,co3,hi,ndepflx,rivinflx,ocetra,sedfluxo + use mo_sedmnt, only: prcaca,prorca,silpro + use mo_biomod, only: expoor,expoca,exposi + use mo_param_bgc, only: rcar,rnit + use mo_control_bgc, only: do_ndep,do_rivinpt,io_stdo_bgc + use mo_bgcmean, only: bgct2d,jco2flux,jirdin,jn2flux,jn2oflux,jndep,jo2flux,jprcaca,jprorca,jsilpro,nbgcmax,glb_inventory + use mo_param1_bgc, only: ialkali,ian2o,iano3,iatmco2,iatmn2,iatmn2o,iatmo2,icalc,idet,idoc,igasnit,iopal,ioxygen,iphosph, & + iphy,ipowaic,ipowaox,ipowaph,ipowasi,ipown2,ipowno3,isco212,isilica,isssc12,issso12,issssil,izoo, & + irdin,irdip,irsi,iralk,irdoc,irdet,nocetra,npowtra,nsedtra,nriv + use mo_vgrid, only: dp_min + + ! NOT sedbypass + use mo_param1_bgc, only: ks + use mo_sedmnt, only: porwat,seddw,sedlay,burial,sedhpl,powtra,porsol + use mo_control_bgc, only: use_PBGC_CK_TIMESTEP,use_BOXATM,use_sedbypass,use_cisonew,use_AGG,use_CFC,use_natDIC,use_BROMO + + ! Arguments + integer, intent(in) :: kpie,kpje,kpke + integer, intent(in) :: iogrp + real, intent(in) :: dlxp(kpie,kpje) + real, intent(in) :: dlyp(kpie,kpje) + real, intent(in) :: ddpo(kpie,kpje,kpke) + real, intent(in) :: omask(kpie,kpje) + + ! Local variables + integer :: i,j,k,l + real :: ztmp1(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy) + real :: ztmp2(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy) + real :: vol + ! ppm2con: atmospheric weight: ~10000kg/m^2, avrg. ~29 g/mol + ! --> 350 kmol/m^2 --> 1ppm ~ 0.35e-3 kmol/m^2 + real, parameter :: ppm2con = 0.35e-3 + !=== Variables for global sums + real :: ztotvol ! Total ocean volume + real :: ztotarea ! Total sea surface area + !--- aqueous sediment tracer + real :: zsedtotvol ! Total pore water volume + real :: zpowtratot(npowtra) ! Sum : Pore water tracers + real :: zpowtratoc(npowtra) ! Mean concentration of pore water tracers + !--- non aqueous sediment tracer + real :: zsedhplto ! Total sediment accumulated hydrogen ions + real :: zsedlayto(nsedtra) ! Sum : Sediment layer tracers + real :: zburial(nsedtra) ! Sum : Sediment burial tracers + !--- oceanic tracers + real :: zocetratot(nocetra) ! Sum : Ocean tracers + real :: zocetratoc(nocetra) ! Mean concentration of ocean racers + !--- additional ocean tracer + real :: zhito ! Total hydrogen ion tracer + real :: zco3to ! Total dissolved carbonate (CO3) tracer + !--- alkalinity of the first layer + real :: zvoltop ! Total volume of top ocean layer + real :: zalkali ! Total alkalinity of top ocean layer + !--- river fluxes + real :: srivflux(nriv) ! sum of riverfluxes + !--- atmosphere flux and atmospheric CO2 + real :: sndepflux ! sum of N dep fluxes + real :: zatmco2,zatmo2,zatmn2 + real :: co2flux,so2flux,sn2flux,sn2oflux + real :: zprorca,zprcaca,zsilpro + !--- total tracer budgets + real :: totalcarbon,totalphos,totalsil,totalnitr,totaloxy + !--- sediment fluxes + real :: sum_zprorca + real :: sum_zprcaca + real :: sum_zsilpro + real :: sum_sedfluxo(npowtra) + !--- export production + real :: sum_expoor + real :: sum_expoca + real :: sum_exposi + + !=== aqueous sediment tracer + !---------------------------------------------------------------------- + if (use_sedbypass) then + + zsedtotvol = 0.0 + zpowtratot(:)=0.0 + zpowtratoc(:)=0.0 + zsedlayto(:)=0.0 + zburial(:)=0.0 + zsedhplto=0.0 + + else + + ztmp1(:,:)=0.0 + DO k=1,ks + DO j=1,kpje + DO i=1,kpie + ztmp1(i,j) = ztmp1(i,j) + omask(i,j)*seddw(k) & + & *dlxp(i,j)*dlyp(i,j)*porwat(i,j,k) + ENDDO + ENDDO + ENDDO + + CALL xcsum(zsedtotvol,ztmp1,ips) + + DO l=1,npowtra + ztmp1(:,:)=0.0 + DO k=1,ks + DO j=1,kpje + DO i=1,kpie + vol = seddw(k)*dlxp(i,j)*dlyp(i,j)*porwat(i,j,k) + ztmp1(i,j)= ztmp1(i,j) + omask(i,j)*powtra(i,j,k,l)*vol + ENDDO + ENDDO + ENDDO + + CALL xcsum(zpowtratot(l),ztmp1,ips) + zpowtratoc(l) = zpowtratot(l)/zsedtotvol + ENDDO + + !=== non aqueous sediment tracer + !---------------------------------------------------------------------- + zburial = sum2d_array(burial, nsedtra) + + DO l=1,nsedtra + ztmp1(:,:)=0.0 + DO k=1,ks + DO j=1,kpje + DO i=1,kpie + vol = porsol(i,j,k)*seddw(k)*dlxp(i,j)*dlyp(i,j) + ztmp1(i,j) = ztmp1(i,j) + omask(i,j)*sedlay(i,j,k,l)*vol + ENDDO + ENDDO + ENDDO + + CALL xcsum(zsedlayto(l),ztmp1,ips) + ENDDO + + ztmp1(:,:)=0.0 + DO k=1,ks + DO j=1,kpje + DO i=1,kpie + vol = porsol(i,j,k)*seddw(k)*dlxp(i,j)*dlyp(i,j) + ztmp1(i,j) = ztmp1(i,j) + omask(i,j)*sedhpl(i,j,k)*vol + ENDDO + ENDDO + ENDDO + + CALL xcsum(zsedhplto,ztmp1,ips) + + endif ! not sedbypass + + !=== oceanic tracers + !---------------------------------------------------------------------- + ztotvol = 0. + zocetratot = 0. + zocetratoc = 0. + + ztmp1(:,:)=0.0 + DO k=1,kpke + DO j=1,kpje + DO i=1,kpie + IF(ddpo(i,j,k).gt.dp_min) THEN + ztmp1(i,j) = ztmp1(i,j) & + & + omask(i,j)*dlxp(i,j)*dlyp(i,j)*ddpo(i,j,k) + ENDIF + ENDDO + ENDDO + ENDDO + + CALL xcsum(ztotvol,ztmp1,ips) + + DO l=1,nocetra + ztmp1(:,:)=0.0 + DO k=1,kpke + DO j=1,kpje + DO i=1,kpie + IF(ddpo(i,j,k).gt.dp_min) THEN + vol = dlxp(i,j)*dlyp(i,j)*ddpo(i,j,k) + ztmp1(i,j) = ztmp1(i,j) + omask(i,j)*ocetra(i,j,k,l)*vol + ! if (ocetra(i,j,k,l).lt.0.0) then + ! WRITE(io_stdo_bgc,*) 'ocetra -ve', l,ocetra(i,j,k,l) + ! endif + ENDIF + ENDDO + ENDDO + ENDDO + + CALL xcsum(zocetratot(l),ztmp1,ips) + zocetratoc(l) = zocetratot(l)/ztotvol + ENDDO + + !=== additional ocean tracer + !---------------------------------------------------------------------- + zhito = 0. + zco3to = 0. + + ztmp1(:,:)=0.0 + ztmp2(:,:)=0.0 + DO k=1,kpke + DO j=1,kpje + DO i=1,kpie + IF(ddpo(i,j,k).gt.dp_min) THEN + vol = dlxp(i,j)*dlyp(i,j)*ddpo(i,j,k) + ztmp1(i,j) = ztmp1(i,j) + omask(i,j)*hi(i,j,k) *vol + ztmp2(i,j) = ztmp2(i,j) + omask(i,j)*co3(i,j,k)*vol + ENDIF + ENDDO + ENDDO + ENDDO + + CALL xcsum(zhito ,ztmp1,ips) + CALL xcsum(zco3to,ztmp2,ips) + + !=== alkalinity of the first layer + !-------------------------------------------------------------------- + zvoltop = 0. + zalkali = 0. + + k=1 + ztmp1(:,:)=0.0 + ztmp2(:,:)=0.0 + DO j=1,kpje + DO i=1,kpie + ztmp1(i,j) = omask(i,j)*dlxp(i,j)*dlyp(i,j)*ddpo(i,j,k) + ztmp2(i,j) = ocetra(i,j,k,ialkali)*ztmp1(i,j) + ENDDO + ENDDO + + CALL xcsum(zvoltop,ztmp1,ips) + CALL xcsum(zalkali,ztmp2,ips) + + !=== atmosphere flux and atmospheric CO2 + !-------------------------------------------------------------------- + ztotarea =0. + co2flux =0. + so2flux =0. + sn2flux =0. + sn2oflux =0. + sndepflux=0. + srivflux =0. + zatmco2 =0. + zatmo2 =0. + zatmn2 =0. + + ztmp1(:,:)=0.0 + DO j=1,kpje + DO i=1,kpie + ztmp1(i,j) = dlxp(i,j)*dlyp(i,j) + ENDDO + ENDDO + CALL xcsum(ztotarea,ztmp1,ips) + + if (use_PBGC_CK_TIMESTEP) then + ! only consider instantaneous fluxes in debugging mode + co2flux = sum2d(atmflx(:,:,iatmco2)) + so2flux = sum2d(atmflx(:,:,iatmo2)) + sn2flux = sum2d(atmflx(:,:,iatmn2)) + sn2oflux = sum2d(atmflx(:,:,iatmn2o)) + + ! nitrogen deposition + if(do_ndep) then + sndepflux = sum2d(ndepflx) + endif + + ! river fluxes + if(do_rivinpt) then + srivflux = sum2d_array(rivinflx, nriv) + endif + else + ! consider accumulated fluxes in the regular mode + co2flux = sum2d(bgct2d(:,:,jco2flux)) + so2flux = sum2d(bgct2d(:,:,jo2flux)) + sn2flux = sum2d(bgct2d(:,:,jn2flux)) + sn2oflux = sum2d(bgct2d(:,:,jn2oflux)) + + ! nitrogen deposition fluxes + if(do_ndep) then + sndepflux = sum2d(bgct2d(:,:,jndep)) + endif + + ! River fluxes + if(do_rivinpt) then + srivflux = sum2d_array(bgct2d(:,:,jirdin:jirdin+nriv-1), nriv) + endif + endif + + if (use_BOXATM) then + zatmco2 = sum2d(atm(:,:,iatmco2)) + zatmo2 = sum2d(atm(:,:,iatmo2)) + zatmn2 = sum2d(atm(:,:,iatmn2)) + endif + + !--- Complete sum of inventory in between bgc.f90 + zprorca = sum2d(prorca) + zprcaca = sum2d(prcaca) + zsilpro = sum2d(silpro) + + !=== Sum of inventory + !---------------------------------------------------------------------- + ! Units in P have a C:P Ratio of 122:1 + + ! totalcarbon= & + ! & (zocetratot(idet)+zocetratot(idoc)+zocetratot(iphy) & + ! & +zocetratot(izoo))*rcar+zocetratot(isco212)+zocetratot(icalc) + + + totalcarbon= & + (zocetratot(idet)+zocetratot(idoc)+zocetratot(iphy) & + + zocetratot(izoo))*rcar+zocetratot(isco212)+zocetratot(icalc) & + + zpowtratot(ipowaic)+zsedlayto(isssc12)+zsedlayto(issso12)*rcar & + + zburial(isssc12)+zburial(issso12)*rcar & + + zprorca*rcar+zprcaca + + if (use_BOXATM) then + totalcarbon = totalcarbon + zatmco2*ppm2con + else + totalcarbon = totalcarbon + co2flux + endif + + totalnitr= & + (zocetratot(idet)+zocetratot(idoc)+zocetratot(iphy) & + + zocetratot(izoo))*rnit+zocetratot(iano3)+zocetratot(igasnit)*2 & + + zpowtratot(ipowno3)+zpowtratot(ipown2)*2 & + + zsedlayto(issso12)*rnit+zburial(issso12)*rnit & + + zocetratot(ian2o)*2 & + - sndepflux & + + zprorca*rnit + + if (use_BOXATM) then + totalnitr = totalnitr + zatmn2*ppm2con*2 + else + totalnitr = totalnitr + sn2flux*2+sn2oflux*2 + endif + + totalphos= & + zocetratot(idet)+zocetratot(idoc)+zocetratot(iphy) & + + zocetratot(izoo)+zocetratot(iphosph) & + + zpowtratot(ipowaph)+zsedlayto(issso12) & + + zburial(issso12) & + + zprorca + + totalsil= & + zocetratot(isilica)+zocetratot(iopal) & + + zpowtratot(ipowasi)+zsedlayto(issssil)+zburial(issssil) & + + zsilpro + + totaloxy= & + (zocetratot(idet)+zocetratot(idoc)+zocetratot(iphy) & + + zocetratot(izoo))*(-24.)+zocetratot(ioxygen) & + + zocetratot(iphosph)*2 +zocetratot(isco212)+zocetratot(icalc) & + + zocetratot(iano3)*1.5+zocetratot(ian2o)*0.5 & + + zsedlayto(issso12)*(-24.) + zsedlayto(isssc12) & + !+ zburial(issso12)*(-24.) + zburial(isssc12) & + + zpowtratot(ipowno3)*1.5+zpowtratot(ipowaic) & + + zpowtratot(ipowaox)+zpowtratot(ipowaph)*2 & + - sndepflux*1.5 & + + zprorca*(-24.)+zprcaca + + if (use_BOXATM) then + totaloxy = totaloxy + zatmo2*ppm2con+zatmco2*ppm2con + else + totaloxy = totaloxy + so2flux+sn2oflux*0.5+co2flux + endif + + IF (do_rivinpt) THEN + totalcarbon = totalcarbon & + - (srivflux(irdoc)+srivflux(irdet))*rcar -(srivflux(iralk)+srivflux(irdin)+srivflux(irdip)) ! =sco212 + totalnitr = totalnitr & + - (srivflux(irdoc)+srivflux(irdet))*rnit - srivflux(irdin) + totalphos = totalphos & + -(srivflux(irdoc)+srivflux(irdet)+srivflux(irdip)) + totalsil = totalsil & + - srivflux(irsi) + totaloxy = totaloxy & + - (srivflux(irdoc)+srivflux(irdet))*(-24.) & + - srivflux(irdin)*1.5 - srivflux(irdip)*2. & + - (srivflux(iralk)+srivflux(irdin)+srivflux(irdip)) ! =sco212 + ENDIF + + !=== Compute sediment fluxes + !---------------------------------------------------------------------- + sum_zprorca = sum2d(bgct2d(:,:,jprorca)) + sum_zprcaca = sum2d(bgct2d(:,:,jprcaca)) + sum_zsilpro = sum2d(bgct2d(:,:,jsilpro)) + + sum_sedfluxo = sum2d_array(sedfluxo, npowtra) + + sum_expoor = sum2d(expoor) + sum_expoca = sum2d(expoca) + sum_exposi = sum2d(exposi) + + !=== Write output to netCDF file or stdout + !---------------------------------------------------------------------- + if (mnproc == 1) then + if (iogrp == 0) then ! debug mode + call write_stdout + else if (GLB_INVENTORY(iogrp) == 2) then ! netcdf output + call write_netcdf(iogrp) + else ! default + call write_stdout + endif + endif + + return + + contains + + function sum2d(var2d) result(total) + !********************************************************************** + !**** Sum 2D scalar fields + !********************************************************************** + implicit none + real, dimension(kpie,kpje), intent(in) :: var2d + real :: total + + ! Local variables + integer :: i,j + !--- input to xcsum require halo indices + real, dimension(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy) :: ztmp + + ztmp(:,:)=0.0 + do j=1,kpje + do i=1,kpie + ztmp(i,j) = var2d(i,j)*dlxp(i,j)*dlyp(i,j)*omask(i,j) + enddo + enddo + call xcsum(total,ztmp,ips) + end function sum2d + + + function sum2d_array(var3d, narr) result(total) + !********************************************************************** + !**** Sum 2D array fields + !********************************************************************** + implicit none + integer, intent(in) :: narr + real, dimension(kpie,kpje,narr), intent(in) :: var3d + real, dimension(narr) :: total + + ! Local variables + integer :: i,j,k + !--- input to xcsum require halo indices + real, dimension(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy) :: ztmp + + ztmp(:,:)=0.0 + do k=1,narr + do j=1,kpje + do i=1,kpie + ztmp(i,j) = var3d(i,j,k)*dlxp(i,j)*dlyp(i,j)*omask(i,j) + enddo + enddo + call xcsum(total(k),ztmp,ips) + enddo + end function sum2d_array + + + subroutine write_stdout + !********************************************************************** + !**** Write inventory to log file. + !********************************************************************** + implicit none + + integer :: l + + if (.not. use_sedbypass) then + !=== aqueous sediment tracer + !------------------------------------------------------------------ + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*)'Global inventory of aqueous sediment tracer' + WRITE(io_stdo_bgc,*)'-------------------------------------------' + WRITE(io_stdo_bgc,*) ' total[kmol] concentration[mol/L]' + DO l=1,npowtra + WRITE(io_stdo_bgc,*)'No. ',l,' ',zpowtratot(l), & + & ' ',zpowtratoc(l),' ',zsedtotvol + ENDDO + WRITE(io_stdo_bgc,*) ' ' + + !=== non aqueous sediment tracer + !------------------------------------------------------------------ + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) & + & 'Global inventory of solid sediment constituents' + WRITE(io_stdo_bgc,*) & + & '----------------------------------------------------' + WRITE(io_stdo_bgc,*) ' [kmol]' + + DO l=1,nsedtra + WRITE(io_stdo_bgc,*) 'Sediment No. ',l,' ', zsedlayto(l) + WRITE(io_stdo_bgc,*) 'Burial No. ',l,' ', zburial(l) + ENDDO + WRITE(io_stdo_bgc,*) 'hpl ', zsedhplto + WRITE(io_stdo_bgc,*) ' ' + endif + + !=== oceanic tracers + !------------------------------------------------------------------ + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) 'Global inventory of advected ocean tracers' + WRITE(io_stdo_bgc,*) '------------------------------------------' + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) ' total[kmol] concentration[kmol/m^3]' + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) 'ztotvol',ztotvol + DO l=1,nocetra + WRITE(io_stdo_bgc,*) 'No. ',l, zocetratot(l), zocetratoc(l) + ENDDO + + !=== additional ocean tracer + !------------------------------------------------------------------ + ! WRITE(io_stdo_bgc,*) ' ' + ! WRITE(io_stdo_bgc,*) 'Glob. inventory of additional ocean tracer' + ! WRITE(io_stdo_bgc,*) '------------------------------------------' + ! WRITE(io_stdo_bgc,*) ' total[kmol] concentration[kmol/m^3]' + ! WRITE(io_stdo_bgc,*) ' ' + ! WRITE(io_stdo_bgc,*) ' hi', zhito, zhito/ztotvol + ! WRITE(io_stdo_bgc,*) ' co3', zco3to, zco3to/ztotvol + ! WRITE(io_stdo_bgc,*) ' ' + + !=== alkalinity of the first layer + !------------------------------------------------------------------ + ! WRITE(io_stdo_bgc,*) ' ' + ! WRITE(io_stdo_bgc,*) 'Global inventory of first layer alkalinity' + ! WRITE(io_stdo_bgc,*) '------------------------------------------' + ! WRITE(io_stdo_bgc,*) ' ' + ! WRITE(io_stdo_bgc,*) ' total[kmol] concentration[kmol/m^3]' + ! WRITE(io_stdo_bgc,*) ' ' + ! WRITE(io_stdo_bgc,*) zalkali, zalkali/zvoltop + + !=== atmosphere flux and atmospheric CO2 + !------------------------------------------------------------------ + ! WRITE(io_stdo_bgc,*) ' ' + ! WRITE(io_stdo_bgc,*) 'Global fluxes into atmosphere' + ! WRITE(io_stdo_bgc,*) '-----------------------------' + ! WRITE(io_stdo_bgc,*) ' [kmol]' + ! WRITE(io_stdo_bgc,*) ' ' + ! WRITE(io_stdo_bgc,*) 'CO2Flux :',co2flux + ! WRITE(io_stdo_bgc,*) 'O2 Flux :',so2flux + ! WRITE(io_stdo_bgc,*) 'N2 Flux :',sn2flux + ! WRITE(io_stdo_bgc,*) 'N2O Flux :',sn2oflux + ! WRITE(io_stdo_bgc,*) ' ' + if (use_BOXATM) then + ! WRITE(io_stdo_bgc,*) 'global atm. CO2[ppm] / kmol: ', & + ! & zatmco2/ztotarea,zatmco2*ppm2con + ! WRITE(io_stdo_bgc,*) 'global atm. O2[ppm] / kmol : ', & + ! & zatmo2/ztotarea,zatmo2*ppm2con + ! WRITE(io_stdo_bgc,*) 'global atm. N2[ppm] / kmol : ', & + ! & zatmn2/ztotarea,zatmn2*ppm2con + endif + ! WRITE(io_stdo_bgc,*) ' ' + ! WRITE(io_stdo_bgc,*) 'Should be zero at the end: ' + ! WRITE(io_stdo_bgc,*) 'prorca, prcaca, silpro ', & + ! & zprorca, zprcaca, zsilpro + ! WRITE(io_stdo_bgc,*) ' ' + + IF(do_ndep) WRITE(io_stdo_bgc,*) 'NdepFlux :',sndepflux + + ! riverine fluxes + !------------------------------------------------------------------ + IF(do_rivinpt)THEN + WRITE(io_stdo_bgc,*) 'Riverine fluxes:' + DO l=1,nriv + WRITE(io_stdo_bgc,*) 'No. ',l,srivflux(l) + ENDDO + ENDIF + + !=== Sum of inventory + !------------------------------------------------------------------ + ! Units in P have a C:P Ratio of 122:1 + WRITE(io_stdo_bgc,*) 'Global total[kmol] of carbon : ', totalcarbon + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) 'Global total[kmol] of phosph. : ', totalphos + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) 'Global total[kmol] of silicate : ', totalsil + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) 'Global total[kmol] of nitrogen. : ', totalnitr + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) 'Global total[kmol] of oxygen. : ', totaloxy + + !=== Write sediment fluxes + !------------------------------------------------------------------ + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) 'Global fluxes into and out of the sediment' + WRITE(io_stdo_bgc,*) '------------------------------------------' + WRITE(io_stdo_bgc,*) ' [kmol]' + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) 'Detritus, Calcium Carbonate, Silicate ', & + & sum_zprorca, sum_zprcaca, sum_zsilpro + WRITE(io_stdo_bgc,*) ' ' + DO l=1,npowtra + WRITE(io_stdo_bgc,*) 'No. ',l,' ',sum_sedfluxo(l) + ENDDO + WRITE(io_stdo_bgc,*) ' ' + WRITE(io_stdo_bgc,*) 'Global total export production' + WRITE(io_stdo_bgc,*) '------------------------------' + WRITE(io_stdo_bgc,*) ' [kmol]' + WRITE(io_stdo_bgc,*) 'carbon : ',sum_expoor + WRITE(io_stdo_bgc,*) 'carbonate: ',sum_expoca + WRITE(io_stdo_bgc,*) 'silicate : ',sum_exposi + WRITE(io_stdo_bgc,*) ' ' + + end subroutine write_stdout + + + subroutine write_netcdf(iogrp) + !********************************************************************** + !**** Write inventory to netCDF file. + !********************************************************************** + use netcdf, only: nf90_clobber, nf90_close, nf90_create, nf90_def_dim, & + & nf90_def_var, nf90_double, nf90_enddef, nf90_global, & + & nf90_inq_dimid, nf90_inq_varid, nf90_open, & + & nf90_put_att, nf90_put_var, nf90_unlimited, nf90_write + use mod_types, only: r8 + use mod_config, only: expcnf, runid, inst_suffix + use mod_time, only: date0, time0, date, time, nstep, nday_of_year, & + & nstep_in_day + use mo_bgcmean, only: filefq_bgc, fileann_bgc, filemon_bgc,glb_fnametag + use mo_param1_bgc, only: idicsat,idms,ifdust,iiron,iprefalk,iprefdic,iprefo2, & + & iprefpo4 + ! AGG + use mo_param1_bgc, only: iadust,inos + ! BROMO + use mo_param1_bgc, only: ibromo + ! CFC + use mo_param1_bgc, only: icfc11,icfc12,isf6 + ! cisonew + use mo_param1_bgc, only: icalc13,icalc14,idet13,idet14,idoc13,idoc14, & + & iphy13,iphy14,isco213,isco214,izoo13,izoo14 + ! natDIC + use mo_param1_bgc, only: inatalkali,inatcalc,inatsco212 + use mo_control_bgc, only: use_PBGC_CK_TIMESTEP,use_BOXATM,use_sedbypass,use_cisonew,use_AGG,use_CFC,use_natDIC,use_BROMO + + implicit none + + integer, intent(in) :: iogrp + + !=== Save filename and counter variables + !--- netCDF output file names + character(len=256), dimension(nbgcmax), save :: fname_inv + integer, dimension(nbgcmax), save :: ncrec = 0 + logical, dimension(nbgcmax), save :: append2file_inv + data append2file_inv /nbgcmax*.false./ + + !=== Local variables + character(len=:), allocatable :: prefix, sep1, sep2 + character(len=20) :: tstamp + character(len=30) :: timeunits + integer :: l + real(r8) :: datenum + + !=== Variables for netcdf + integer :: ncid, ncvarid, ncstat + integer :: wrstart(1) + !--- time: dimension and variable id + integer :: time_dimid + integer :: time_varid + + ! NOT sedbypass + !--- aqueous sediment tracers + integer :: npowtra_dimid ! id: aqueous sediments + integer :: zpowtra_dimids(2) ! aqueous sediment dimensions + integer :: zpowtra_wrstart(2) ! record start point + integer :: zpowtra_count(2) ! record count + integer :: zsedtotvol_varid ! id: Total sediment volume + integer :: zpowtratot_varid ! id: Total aqueous sediment tracer [kmol] + integer :: zpowtratoc_varid ! id: Sediment tracer concentration [kmol/L] + !--- non-aqueous sediment tracers + integer :: nsedtra_dimid ! id: solid sediments + integer :: zsedtra_dimids(2) ! solid sediments dimensions + integer :: zsedtra_wrstart(2) ! record start point + integer :: zsedtra_count(2) ! record count + integer :: zsedlayto_varid ! id: sediment layer tracers + integer :: zburial_varid ! id: sediment burial tracers + integer :: zsedhplto_varid ! id: accumulated hydrogen ions + + !--- oceanic tracers + !--- Write total sum zt__varid, and mean concentration zc__varid + integer :: ztotvol_varid ! Total ocean volume + integer :: zt_sco212_varid, zc_sco212_varid ! Dissolved CO2 + integer :: zt_alkali_varid, zc_alkali_varid ! Alkalinity + integer :: zt_phosph_varid, zc_phosph_varid ! Dissolved phosphate + integer :: zt_oxygen_varid, zc_oxygen_varid ! Dissolved oxygen + integer :: zt_gasnit_varid, zc_gasnit_varid ! Gaseous nitrogen (N2) + integer :: zt_ano3_varid, zc_ano3_varid ! Dissolved nitrate + integer :: zt_silica_varid, zc_silica_varid ! Silicid acid (Si(OH)4) + integer :: zt_doc_varid, zc_doc_varid ! Dissolved organic carbon + integer :: zt_poc_varid, zc_poc_varid ! Particulate organic carbon + integer :: zt_phyto_varid, zc_phyto_varid ! Phytoplankton concentration + integer :: zt_grazer_varid, zc_grazer_varid ! Zooplankton concentration + integer :: zt_calciu_varid, zc_calciu_varid ! Calcium carbonate + integer :: zt_opal_varid, zc_opal_varid ! Biogenic silica + integer :: zt_n2o_varid, zc_n2o_varid ! Laughing gas (N2O) + integer :: zt_dms_varid, zc_dms_varid ! DiMethylSulfide + integer :: zt_fdust_varid, zc_fdust_varid ! Non-aggregated dust + integer :: zt_iron_varid, zc_iron_varid ! Dissolved iron + integer :: zt_prefo2_varid, zc_prefo2_varid ! Preformed oxygen + integer :: zt_prefpo4_varid, zc_prefpo4_varid ! Preformed phosphate + 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 + + ! 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 + integer :: zt_doc14_varid, zc_doc14_varid ! Dissolved organic carbon-C14 + integer :: zt_poc13_varid, zc_poc13_varid ! Particulate organic carbon-C13 + integer :: zt_poc14_varid, zc_poc14_varid ! Particulate organic carbon-C14 + integer :: zt_phyto13_varid, zc_phyto13_varid ! Phytoplankton concentration-C13 + integer :: zt_phyto14_varid, zc_phyto14_varid ! Phytoplankton concentration-C14 + integer :: zt_grazer13_varid, zc_grazer13_varid ! Zooplankton concentration-C13 + 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 + + ! AGG + integer :: zt_snos_varid, zc_snos_varid ! Marine snow aggregates per g sea water + integer :: zt_adust_varid, zc_adust_varid ! Aggregated dust + + ! 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 + + ! 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 + + ! BROMO + integer :: zt_bromo_varid, zc_bromo_varid ! Bromoform + + !--- sum of inventory + integer :: totcarb_varid, totphos_varid, totsili_varid, totnitr_varid + integer :: totoxyg_varid + !--- sediment fluxes + integer :: sum_zprorca_varid, sum_zprcaca_varid, sum_zsilpro_varid + integer :: sum_sedfluxo_varid + integer :: sum_expoor_varid, sum_expoca_varid, sum_exposi_varid + + + !=== Create new or open existing netCDF file + if (.not.append2file_inv(iogrp)) then + !--- file name : fname_inv(iogrp) + if (expcnf.eq.'cesm') then + prefix=trim(runid)//'.blom'//trim(inst_suffix) + sep1='.' + sep2='-' + else + prefix=trim(runid) + sep1='_' + sep2='.' + endif + write(tstamp,'(i4.4,a1,i2.2,a1,i2.2)') & + & date%year,sep2,date%month,sep2,date%day + fname_inv(iogrp) = prefix//sep1//trim(glb_fnametag(iogrp))//sep1// & + & 'i'//sep1//trim(tstamp)//'.nc' + + !--- create a new netCDF file + write(io_stdo_bgc,*) 'Create BGC inventory file : ',trim(fname_inv(iogrp)) + call nccheck( NF90_CREATE(trim(fname_inv(iogrp)), NF90_CLOBBER, ncid) ) + + !--- set time information + timeunits=' ' + write(timeunits,'(a11,i4.4,a1,i2.2,a1,i2.2,a6)') & + & 'days since ',date0%year,'-',date0%month,'-',date0%day,' 00:00' + + !--- Define global attributes + call nccheck( NF90_PUT_ATT(ncid, NF90_GLOBAL, 'title', & + & 'Global inventory for marine bgc') ) + call nccheck( NF90_PUT_ATT(ncid, NF90_GLOBAL, 'history', & + & 'Global inventory for marine bgc') ) + call nccheck( NF90_PUT_ATT(ncid, NF90_GLOBAL, 'date', timeunits) ) + + !--- Define dimensions + 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) ) + endif + 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. + if (.not. use_sedbypass) then + zpowtra_dimids = (/ npowtra_dimid, time_dimid /) + zsedtra_dimids = (/ nsedtra_dimid, time_dimid /) + endif + + !--- 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') ) + + 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') ) + endif + + !--- Define variables : oceanic tracers + call nccheck( NF90_DEF_VAR(ncid, 'ztotvol', NF90_DOUBLE, time_dimid, & + & ztotvol_varid) ) + call nccheck( NF90_PUT_ATT(ncid, ztotvol_varid, 'long_name', & + & 'Total ocean volume') ) + call nccheck( NF90_PUT_ATT(ncid, ztotvol_varid, 'units', 'm^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_sco212', NF90_DOUBLE, & + & time_dimid, zt_sco212_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_sco212_varid, 'long_name', & + & 'Total dissolved CO2 tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_sco212_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_sco212', NF90_DOUBLE, & + & time_dimid, zc_sco212_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_sco212_varid, 'long_name', & + & 'Mean dissolved CO2 concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_sco212_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_alkali', NF90_DOUBLE, & + & time_dimid, zt_alkali_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_alkali_varid, 'long_name', & + & 'Total alkalinity tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_alkali_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_alkali', NF90_DOUBLE, & + & time_dimid, zc_alkali_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_alkali_varid, 'long_name', & + & 'Mean alkalinity concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_alkali_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_phosph', NF90_DOUBLE, & + & time_dimid, zt_phosph_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_phosph_varid, 'long_name', & + & 'Total dissolved phosphate tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_phosph_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_phosph', NF90_DOUBLE, & + & time_dimid, zc_phosph_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_phosph_varid, 'long_name', & + & 'Mean dissolved phosphate concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_phosph_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_oxygen', NF90_DOUBLE, & + & time_dimid, zt_oxygen_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_oxygen_varid, 'long_name', & + & 'Total dissolved oxygen tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_oxygen_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_oxygen', NF90_DOUBLE, & + & time_dimid, zc_oxygen_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_oxygen_varid, 'long_name', & + & 'Mean dissolved oxygen concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_oxygen_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_gasnit', NF90_DOUBLE, & + & time_dimid, zt_gasnit_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_gasnit_varid, 'long_name', & + & 'Total gaseous nitrogen (N2) tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_gasnit_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_gasnit', NF90_DOUBLE, & + & time_dimid, zc_gasnit_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_gasnit_varid, 'long_name', & + & 'Mean gaseous nitrogen (N2) concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_gasnit_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_ano3', NF90_DOUBLE, & + & time_dimid, zt_ano3_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_ano3_varid, 'long_name', & + & 'Total dissolved nitrate tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_ano3_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_ano3', NF90_DOUBLE, & + & time_dimid, zc_ano3_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_ano3_varid, 'long_name', & + & 'Mean dissolved nitrate concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_ano3_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_silica', NF90_DOUBLE, & + & time_dimid, zt_silica_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_silica_varid, 'long_name', & + & 'Total silicid acid (Si(OH)4) tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_silica_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_silica', NF90_DOUBLE, & + & time_dimid, zc_silica_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_silica_varid, 'long_name', & + & 'Mean silicid acid (Si(OH)4) concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_silica_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_doc', NF90_DOUBLE, & + & time_dimid, zt_doc_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_doc_varid, 'long_name', & + & 'Total dissolved organic carbon tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_doc_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_doc', NF90_DOUBLE, & + & time_dimid, zc_doc_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_doc_varid, 'long_name', & + & 'Mean dissolved organic carbon concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_doc_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_poc', NF90_DOUBLE, & + & time_dimid, zt_poc_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_poc_varid, 'long_name', & + & 'Total particulate organic carbon tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_poc_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_poc', NF90_DOUBLE, & + & time_dimid, zc_poc_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_poc_varid, 'long_name', & + & 'Mean particulate organic carbon concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_poc_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_phyto', NF90_DOUBLE, & + & time_dimid, zt_phyto_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_phyto_varid, 'long_name', & + & 'Total phytoplankton tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_phyto_varid, 'units', 'kmolP') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_phyto', NF90_DOUBLE, & + & time_dimid, zc_phyto_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_phyto_varid, 'long_name', & + & 'Mean phytoplankton concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_phyto_varid, 'units', 'kmolP/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_grazer', NF90_DOUBLE, & + & time_dimid, zt_grazer_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_grazer_varid, 'long_name', & + & 'Total zooplankton tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_grazer_varid, 'units', 'kmolP') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_grazer', NF90_DOUBLE, & + & time_dimid, zc_grazer_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_grazer_varid, 'long_name', & + & 'Mean zooplankton concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_grazer_varid, 'units', 'kmolP/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_calciu', NF90_DOUBLE, & + & time_dimid, zt_calciu_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_calciu_varid, 'long_name', & + & 'Total calcium carbonate tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_calciu_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_calciu', NF90_DOUBLE, & + & time_dimid, zc_calciu_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_calciu_varid, 'long_name', & + & 'Mean calcium carbonate concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_calciu_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_opal', NF90_DOUBLE, & + & time_dimid, zt_opal_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_opal_varid, 'long_name', & + & 'Total biogenic silica tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_opal_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_opal', NF90_DOUBLE, & + & time_dimid, zc_opal_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_opal_varid, 'long_name', & + & 'Mean biogenic silica concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_opal_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_n2o', NF90_DOUBLE, & + & time_dimid, zt_n2o_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_n2o_varid, 'long_name', & + & 'Total laughing gas (N2O) tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_n2o_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_n2o', NF90_DOUBLE, & + & time_dimid, zc_n2o_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_n2o_varid, 'long_name', & + & 'Mean laughing gas (N2O) concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_n2o_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_dms', NF90_DOUBLE, & + & time_dimid, zt_dms_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_dms_varid, 'long_name', & + & 'Total DiMethylSulfide tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_dms_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_dms', NF90_DOUBLE, & + & time_dimid, zc_dms_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_dms_varid, 'long_name', & + & 'Mean DiMethylSulfide concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_dms_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_fdust', NF90_DOUBLE, & + & time_dimid, zt_fdust_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_fdust_varid, 'long_name', & + & 'Total non-aggregated dust tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_fdust_varid, 'units', 'Mg') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_fdust', NF90_DOUBLE, & + & time_dimid, zc_fdust_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_fdust_varid, 'long_name', & + & 'Mean non-aggregate dust concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_fdust_varid, 'units', 'Mg/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_iron', NF90_DOUBLE, & + & time_dimid, zt_iron_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_iron_varid, 'long_name', & + & 'Total dissolved iron tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_iron_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_iron', NF90_DOUBLE, & + & time_dimid, zc_iron_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_iron_varid, 'long_name', & + & 'Mean dissolved iron concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_iron_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_prefo2', NF90_DOUBLE, & + & time_dimid, zt_prefo2_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_prefo2_varid, 'long_name', & + & 'Total preformed oxygen tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_prefo2_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_prefo2', NF90_DOUBLE, & + & time_dimid, zc_prefo2_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_prefo2_varid, 'long_name', & + & 'Mean preformed oxygen concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_prefo2_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_prefpo4', NF90_DOUBLE, & + & time_dimid, zt_prefpo4_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_prefpo4_varid, 'long_name', & + & 'Total preformed phosphate tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_prefpo4_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_prefpo4', NF90_DOUBLE, & + & time_dimid, zc_prefpo4_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_prefpo4_varid, 'long_name', & + & 'Mean preformed phosphate concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_prefpo4_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_prefalk', NF90_DOUBLE, & + & time_dimid, zt_prefalk_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_prefalk_varid, 'long_name', & + & 'Total preformed alkalinity tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_prefalk_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_prefalk', NF90_DOUBLE, & + & time_dimid, zc_prefalk_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_prefalk_varid, 'long_name', & + & 'Mean preformed alkalinity concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_prefalk_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_prefdic', NF90_DOUBLE, & + & time_dimid, zt_prefdic_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_prefdic_varid, 'long_name', & + & 'Total preformed DIC tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_prefdic_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_prefdic', NF90_DOUBLE, & + & time_dimid, zc_prefdic_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_prefdic_varid, 'long_name', & + & 'Mean preformed DIC concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_prefdic_varid, 'units', 'kmol/m^3') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zt_dicsat', NF90_DOUBLE, & + & time_dimid, zt_dicsat_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zt_dicsat_varid, 'long_name', & + & 'Total saturated DIC tracer') ) + call nccheck( NF90_PUT_ATT(ncid, zt_dicsat_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'zc_dicsat', NF90_DOUBLE, & + & time_dimid, zc_dicsat_varid) ) + call nccheck( NF90_PUT_ATT(ncid, zc_dicsat_varid, 'long_name', & + & 'Mean saturated DIC concentration') ) + call nccheck( NF90_PUT_ATT(ncid, zc_dicsat_varid, 'units', 'kmol/m^3') ) + + 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') ) + endif + + 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? + endif + + 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') ) + endif + + 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') ) + endif + + 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') ) + endif + + !--- Define variables : sum of inventory + call nccheck( NF90_DEF_VAR(ncid, 'totcarb', NF90_DOUBLE, time_dimid, & + & totcarb_varid) ) + call nccheck( NF90_PUT_ATT(ncid, totcarb_varid, 'long_name', & + & 'Global total of carbon') ) + call nccheck( NF90_PUT_ATT(ncid, totcarb_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'totphos', NF90_DOUBLE, time_dimid, & + & totphos_varid) ) + call nccheck( NF90_PUT_ATT(ncid, totphos_varid, 'long_name', & + & 'Global total of phosphorous') ) + call nccheck( NF90_PUT_ATT(ncid, totphos_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'totsili', NF90_DOUBLE, time_dimid, & + & totsili_varid) ) + call nccheck( NF90_PUT_ATT(ncid, totsili_varid, 'long_name', & + & 'Global total of silicate') ) + call nccheck( NF90_PUT_ATT(ncid, totsili_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'totnitr', NF90_DOUBLE, time_dimid, & + & totnitr_varid) ) + call nccheck( NF90_PUT_ATT(ncid, totnitr_varid, 'long_name', & + & 'Global total of nitrogen') ) + call nccheck( NF90_PUT_ATT(ncid, totnitr_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'totoxyg', NF90_DOUBLE, time_dimid, & + & totoxyg_varid) ) + call nccheck( NF90_PUT_ATT(ncid, totoxyg_varid, 'long_name', & + & 'Global total of oxygen') ) + call nccheck( NF90_PUT_ATT(ncid, totoxyg_varid, 'units', 'kmol') ) + + !--- Define variables : sediment fluxes + call nccheck( NF90_DEF_VAR(ncid, 'sum_zprorca', NF90_DOUBLE, & + & time_dimid, sum_zprorca_varid) ) + call nccheck( NF90_PUT_ATT(ncid, sum_zprorca_varid, 'long_name', & + & 'Global flux of detritus into sediments') ) + call nccheck( NF90_PUT_ATT(ncid, sum_zprorca_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'sum_zprcaca', NF90_DOUBLE, & + & time_dimid, sum_zprcaca_varid) ) + call nccheck( NF90_PUT_ATT(ncid, sum_zprcaca_varid, 'long_name', & + & 'Global flux of calcium carbonate into sediments') ) + call nccheck( NF90_PUT_ATT(ncid, sum_zprcaca_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'sum_zsilpro', NF90_DOUBLE, & + & time_dimid, sum_zsilpro_varid) ) + call nccheck( NF90_PUT_ATT(ncid, sum_zsilpro_varid, 'long_name', & + & 'Global flux of silicate into sediments') ) + call nccheck( NF90_PUT_ATT(ncid, sum_zsilpro_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'sum_expoor', NF90_DOUBLE, & + & time_dimid, sum_expoor_varid) ) + call nccheck( NF90_PUT_ATT(ncid, sum_expoor_varid, 'long_name', & + & 'Global total export production of carbon') ) + call nccheck( NF90_PUT_ATT(ncid, sum_expoor_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'sum_expoca', NF90_DOUBLE, & + & time_dimid, sum_expoca_varid) ) + call nccheck( NF90_PUT_ATT(ncid, sum_expoca_varid, 'long_name', & + & 'Global total export production of carbonate') ) + call nccheck( NF90_PUT_ATT(ncid, sum_expoca_varid, 'units', 'kmol') ) + + call nccheck( NF90_DEF_VAR(ncid, 'sum_exposi', NF90_DOUBLE, & + & time_dimid, sum_exposi_varid) ) + call nccheck( NF90_PUT_ATT(ncid, sum_exposi_varid, 'long_name', & + & 'Global total export production of silicate') ) + call nccheck( NF90_PUT_ATT(ncid, sum_exposi_varid, 'units', 'kmol') ) + + !--- End define mode. + call nccheck( NF90_ENDDEF(ncid) ) + + else + !=== Open existing netCDF file + write(io_stdo_bgc,*) 'Write BGC inventory to file : ', & + & trim(fname_inv(iogrp)) + call nccheck( NF90_OPEN(trim(fname_inv(iogrp)), NF90_WRITE, ncid) ) + !--- Inquire dimid + call nccheck( NF90_INQ_DIMID(ncid, "time", time_dimid) ) + if (.not. use_sedbypass) then + call nccheck( NF90_INQ_DIMID(ncid, 'npowtra', npowtra_dimid) ) + call nccheck( NF90_INQ_DIMID(ncid, 'nsedtra', nsedtra_dimid) ) + endif + !--- Inquire varid : time + call nccheck( NF90_INQ_VARID(ncid, "time", time_varid) ) + + 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) ) + endif + + !--- Inquire varid : ocean tracers + call nccheck( NF90_INQ_VARID(ncid, "ztotvol", ztotvol_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_sco212", zt_sco212_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_sco212", zc_sco212_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_alkali", zt_alkali_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_alkali", zc_alkali_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_phosph", zt_phosph_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_phosph", zc_phosph_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_oxygen", zt_oxygen_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_oxygen", zc_oxygen_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_gasnit", zt_gasnit_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_gasnit", zc_gasnit_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_ano3", zt_ano3_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_ano3", zc_ano3_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_silica", zt_silica_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_silica", zc_silica_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_doc", zt_doc_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_doc", zc_doc_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_poc", zt_poc_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_poc", zc_poc_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_phyto", zt_phyto_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_phyto", zc_phyto_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_grazer", zt_grazer_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_grazer", zc_grazer_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_calciu", zt_calciu_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_calciu", zc_calciu_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_opal", zt_opal_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_opal", zc_opal_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_n2o", zt_n2o_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_n2o", zc_n2o_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_dms", zt_dms_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_dms", zc_dms_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_fdust", zt_fdust_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_fdust", zc_fdust_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_iron", zt_iron_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_iron", zc_iron_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_prefo2", zt_prefo2_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_prefo2", zc_prefo2_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_prefpo4", zt_prefpo4_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_prefpo4", zc_prefpo4_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_prefalk", zt_prefalk_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zc_prefalk", zc_prefalk_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "zt_prefdic", zt_prefdic_varid) ) + 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) ) + 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) ) + endif + 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) ) + endif + 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) ) + endif + 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) ) + endif + 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) ) + endif + !--- Inquire varid : sum of inventory + call nccheck( NF90_INQ_VARID(ncid, "totcarb", totcarb_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "totphos", totphos_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "totsili", totsili_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "totnitr", totnitr_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "totoxyg", totoxyg_varid) ) + !--- Inquire varid : sediment fluxes + call nccheck( NF90_INQ_VARID(ncid, "sum_zprorca", sum_zprorca_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "sum_zprcaca", sum_zprcaca_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "sum_zsilpro", sum_zsilpro_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "sum_expoor", sum_expoor_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "sum_expoca", sum_expoca_varid) ) + call nccheck( NF90_INQ_VARID(ncid, "sum_exposi", sum_exposi_varid) ) + endif + + !=== Increment record by 1, reset start and count arrays + ncrec(iogrp) = ncrec(iogrp) + 1 + wrstart = (/ ncrec(iogrp) /) + if (.not. use_sedbypass) then + zpowtra_wrstart = (/ 1, ncrec(iogrp) /) + zpowtra_count = (/ npowtra, 1 /) + zsedtra_wrstart = (/ 1, ncrec(iogrp) /) + zsedtra_count = (/ nsedtra, 1 /) + endif + + !=== Write output data to netCDF file + !--- Write data : time + datenum = time - time0 + call nccheck( NF90_PUT_VAR(ncid, time_varid, datenum, start = wrstart) ) + 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) ) + endif + !--- Write data : ocean tracers + call nccheck( NF90_PUT_VAR(ncid, ztotvol_varid, ztotvol, start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_sco212_varid, & + & zocetratot(isco212), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_sco212_varid, & + & zocetratoc(isco212), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_alkali_varid, & + & zocetratot(ialkali), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_alkali_varid, & + & zocetratoc(ialkali), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_phosph_varid, & + & zocetratot(iphosph), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_phosph_varid, & + & zocetratoc(iphosph), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_oxygen_varid, & + & zocetratot(ioxygen), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_oxygen_varid, & + & zocetratoc(ioxygen), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_gasnit_varid, & + & zocetratot(igasnit), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_gasnit_varid, & + & zocetratoc(igasnit), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_ano3_varid, & + & zocetratot(iano3), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_ano3_varid, & + & zocetratoc(iano3), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_silica_varid, & + & zocetratot(isilica), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_silica_varid, & + & zocetratoc(isilica), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_doc_varid, & + & zocetratot(idoc), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_doc_varid, & + & zocetratoc(idoc), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_poc_varid, & + & zocetratot(idet), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_poc_varid, & + & zocetratoc(idet), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_phyto_varid, & + & zocetratot(iphy), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_phyto_varid, & + & zocetratoc(iphy), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_grazer_varid, & + & zocetratot(izoo), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_grazer_varid, & + & zocetratoc(izoo), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_calciu_varid, & + & zocetratot(icalc), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_calciu_varid, & + & zocetratoc(icalc), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_opal_varid, & + & zocetratot(iopal), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_opal_varid, & + & zocetratoc(iopal), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_n2o_varid, & + & zocetratot(ian2o), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_n2o_varid, & + & zocetratoc(ian2o), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_dms_varid, & + & zocetratot(idms), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_dms_varid, & + & zocetratoc(idms), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_fdust_varid, & + & zocetratot(ifdust), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_fdust_varid, & + & zocetratoc(ifdust), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_iron_varid, & + & zocetratot(iiron), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_iron_varid, & + & zocetratoc(iiron), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_prefo2_varid, & + & zocetratot(iprefo2), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_prefo2_varid, & + & zocetratoc(iprefo2), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_prefpo4_varid, & + & zocetratot(iprefpo4), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_prefpo4_varid, & + & zocetratoc(iprefpo4), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_prefalk_varid, & + & zocetratot(iprefalk), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_prefalk_varid, & + & zocetratoc(iprefalk), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_prefdic_varid, & + & zocetratot(iprefdic), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_prefdic_varid, & + & zocetratoc(iprefdic), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zt_dicsat_varid, & + & zocetratot(idicsat), start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, zc_dicsat_varid, & + & zocetratoc(idicsat), start = wrstart) ) + 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) ) + endif + 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) ) + endif + 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) ) + endif + 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) ) + endif + 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) ) + endif + !--- Write data : sum of inventory + call nccheck( NF90_PUT_VAR(ncid, totcarb_varid, totalcarbon, & + & start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, totphos_varid, totalphos, & + & start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, totsili_varid, totalsil, & + & start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, totnitr_varid, totalnitr, & + & start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, totoxyg_varid, totaloxy, & + & start = wrstart) ) + !--- Write data : fluxes into sediments + call nccheck( NF90_PUT_VAR(ncid, sum_zprorca_varid, sum_zprorca, & + & start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, sum_zprcaca_varid, sum_zprcaca, & + & start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, sum_zsilpro_varid, sum_zsilpro, & + & start = wrstart) ) + !--- Write data : global total export production + call nccheck( NF90_PUT_VAR(ncid, sum_expoor_varid, sum_expoor, & + & start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, sum_expoca_varid, sum_expoca, & + & start = wrstart) ) + call nccheck( NF90_PUT_VAR(ncid, sum_exposi_varid, sum_exposi, & + & start = wrstart) ) + + !--- Close netCDF file + call nccheck( NF90_CLOSE(ncid) ) + + !=== Check if file should be appended next time inventory routine is called + if (( (fileann_bgc(iogrp) .and. nday_of_year == 1 .or. & + & filemon_bgc(iogrp) .and. date%day == 1) .and. & + & mod(nstep, nstep_in_day) == 0) .or. & + & .not.(fileann_bgc(iogrp) .or. filemon_bgc(iogrp)) .and. & + & mod(nstep + .5, filefq_bgc(iogrp)) < 1.) then + append2file_inv(iogrp) = .false. + ncrec(iogrp) = 0 + else + append2file_inv(iogrp) = .true. + endif + + end subroutine write_netcdf + + + subroutine nccheck(status) + use netcdf, only: nf90_noerr + use mod_xc, only: xchalt + implicit none + + integer, intent(in) :: status + + if (status /= nf90_noerr) then + call xchalt('(inventory_bgc: Problem with netCDF)') + stop '(inventory_bgc: Problem with netCDF)' + endif + end subroutine nccheck + + + END SUBROUTINE INVENTORY_BGC + +END MODULE MO_INVENTORY_BGC diff --git a/hamocc/mo_ncout_hamocc.F90 b/hamocc/mo_ncout_hamocc.F90 new file mode 100644 index 00000000..868b776f --- /dev/null +++ b/hamocc/mo_ncout_hamocc.F90 @@ -0,0 +1,1413 @@ +! Copyright (C) 2020 I Bethke, J. Tjiputra, J. Schwinger, A. Moree, M. +! Bentsen +! +! 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. +! +! 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. +! +! 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_NCWRT_BGC + + implicit none + private + + public :: NCWRT_BGC + +CONTAINS + + 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_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_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, & + 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_param_bgc, only: c14fac + + ! Arguments + integer :: i,j,k,l,nt + integer :: ny,nm,nd,dayfrac,cmpflg,iogrp + integer, save :: irec(nbgcmax) + logical, save :: append2file(nbgcmax) + character(len=256), save :: fname(nbgcmax) + character(len=20) :: startdate + character(len=30) :: timeunits + real :: datenum,rnacc + + data append2file /nbgcmax*.false./ + + ! --- set time information + timeunits=' ' + startdate=' ' + write(timeunits,'(a11,i4.4,a1,i2.2,a1,i2.2,a6)') & + & 'days since ',min(1800,date0%year),'-',1,'-',1,' 00:00' + write(startdate,'(i4.4,a1,i2.2,a1,i2.2,a6)') & + & date0%year,'-',date0%month,'-',date0%day,' 00:00' + datenum=time-time0-0.5*diagfq_bgc(iogrp)/nstep_in_day + + ! --- get file name + if (.not.append2file(iogrp)) then + call diafnm(GLB_FNAMETAG(iogrp), & + & filefq_bgc(iogrp)/real(nstep_in_day), & + & filemon_bgc(iogrp),fileann_bgc(iogrp),fname(iogrp)) + append2file(iogrp)=.true. + irec(iogrp)=1 + else + irec(iogrp)=irec(iogrp)+1 + endif + if (((fileann_bgc(iogrp).and.nday_of_year.eq.1.or. & + & filemon_bgc(iogrp).and.date%day.eq.1).and. & + & mod(nstep,nstep_in_day).eq.0).or. & + & .not.(fileann_bgc(iogrp).or.filemon_bgc(iogrp)).and. & + & mod(nstep+.5,filefq_bgc(iogrp)).lt.1.) then + append2file(iogrp)=.false. + endif + + ! --- prepare output fields + if (mnproc.eq.1) then + write (lp,'(a,f6.2,a)') ' ncwrt_bgc: fields averaged over ', & + & real(nacc_bgc(iogrp)),' steps' + write(lp,*) 'irec(iogrp)',irec(iogrp) + endif + rnacc=1./real(nacc_bgc(iogrp)) + cmpflg=GLB_COMPFLAG(iogrp) + + ! --- create output file + if (GLB_NCFORMAT(iogrp).eq.1) then + call ncfopn(fname(iogrp),'w','6',irec(iogrp),iotype) + elseif (GLB_NCFORMAT(iogrp).eq.2) then + call ncfopn(fname(iogrp),'w','h',irec(iogrp),iotype) + else + call ncfopn(fname(iogrp),'w','c',irec(iogrp),iotype) + endif + + ! --- define spatial and time dimensions + if (cmpflg.ne.0) then + call ncdimc('pcomp',ip,0) + else + call ncdims('x',itdm) + call ncdims('y',jtdm) + endif + call ncdims('sigma',kdm) + call ncdims('depth',ddm) + call ncdims('ks',ks) + call ncdims('bounds',2) + call ncdims('time',0) + call hamoccvardef(iogrp,timeunits,calendar,cmpflg) + call nctime(datenum,calendar,timeunits,startdate) + + ! --- write auxillary dimension information + call ncwrt1('sigma','sigma',sigmar1) + call ncwrt1('depth','depth',depthslev) + call ncwrt1('depth_bnds','bounds depth',depthslev_bnds) + + ! --- finalize accumulation + call finlyr(jphyto(iogrp),jdp(iogrp)) + call finlyr(jgrazer(iogrp),jdp(iogrp)) + call finlyr(jdoc(iogrp),jdp(iogrp)) + call finlyr(jphosy(iogrp),jdp(iogrp)) + call finlyr(jphosph(iogrp),jdp(iogrp)) + call finlyr(joxygen(iogrp),jdp(iogrp)) + call finlyr(jiron(iogrp),jdp(iogrp)) + call finlyr(jano3(iogrp),jdp(iogrp)) + call finlyr(jalkali(iogrp),jdp(iogrp)) + call finlyr(jsilica(iogrp),jdp(iogrp)) + call finlyr(jdic(iogrp),jdp(iogrp)) + call finlyr(jpoc(iogrp),jdp(iogrp)) + call finlyr(jcalc(iogrp),jdp(iogrp)) + call finlyr(jopal(iogrp),jdp(iogrp)) + call finlyr(jco3(iogrp),jdp(iogrp)) + call finlyr(jph(iogrp),jdp(iogrp)) + call finlyr(jomegaa(iogrp),jdp(iogrp)) + call finlyr(jomegac(iogrp),jdp(iogrp)) + call finlyr(jn2o(iogrp),jdp(iogrp)) + call finlyr(jprefo2(iogrp),jdp(iogrp)) + call finlyr(jo2sat(iogrp),jdp(iogrp)) + call finlyr(jprefpo4(iogrp),jdp(iogrp)) + call finlyr(jprefalk(iogrp),jdp(iogrp)) + call finlyr(jprefdic(iogrp),jdp(iogrp)) + call finlyr(jdicsat(iogrp),jdp(iogrp)) + 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)) + endif + 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)) + endif + if (use_CFC) then + call finlyr(jcfc11(iogrp),jdp(iogrp)) + call finlyr(jcfc12(iogrp),jdp(iogrp)) + call finlyr(jsf6(iogrp),jdp(iogrp)) + endif + 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)) + endif + if (use_BROMO) then + call finlyr(jbromo(iogrp),jdp(iogrp)) + endif + + ! --- Mask sea floor in mass fluxes + call msksrf(jcarflx0100(iogrp),k0100) + call msksrf(jcarflx0500(iogrp),k0500) + call msksrf(jcarflx1000(iogrp),k1000) + call msksrf(jcarflx2000(iogrp),k2000) + call msksrf(jcarflx4000(iogrp),k4000) + call msksrf(jbsiflx0100(iogrp),k0100) + call msksrf(jbsiflx0500(iogrp),k0500) + call msksrf(jbsiflx1000(iogrp),k1000) + call msksrf(jbsiflx2000(iogrp),k2000) + call msksrf(jbsiflx4000(iogrp),k4000) + call msksrf(jcalflx0100(iogrp),k0100) + call msksrf(jcalflx0500(iogrp),k0500) + call msksrf(jcalflx1000(iogrp),k1000) + call msksrf(jcalflx2000(iogrp),k2000) + call msksrf(jcalflx4000(iogrp),k4000) + + ! --- Mask sea floor in level data + call msklvl(jlvlphyto(iogrp),depths) + call msklvl(jlvlgrazer(iogrp),depths) + call msklvl(jlvldoc(iogrp),depths) + call msklvl(jlvlphosy(iogrp),depths) + call msklvl(jlvlphosph(iogrp),depths) + call msklvl(jlvloxygen(iogrp),depths) + call msklvl(jlvliron(iogrp),depths) + call msklvl(jlvlano3(iogrp),depths) + call msklvl(jlvlalkali(iogrp),depths) + call msklvl(jlvlsilica(iogrp),depths) + call msklvl(jlvldic(iogrp),depths) + call msklvl(jlvlpoc(iogrp),depths) + call msklvl(jlvlcalc(iogrp),depths) + call msklvl(jlvlopal(iogrp),depths) + call msklvl(jlvlco3(iogrp),depths) + call msklvl(jlvlph(iogrp),depths) + call msklvl(jlvlomegaa(iogrp),depths) + call msklvl(jlvlomegac(iogrp),depths) + call msklvl(jlvln2o(iogrp),depths) + call msklvl(jlvlprefo2(iogrp),depths) + call msklvl(jlvlo2sat(iogrp),depths) + call msklvl(jlvlprefpo4(iogrp),depths) + call msklvl(jlvlprefalk(iogrp),depths) + call msklvl(jlvlprefdic(iogrp),depths) + call msklvl(jlvldicsat(iogrp),depths) + 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) + endif + 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) + endif + if (use_CFC) then + call msklvl(jlvlcfc11(iogrp),depths) + call msklvl(jlvlcfc12(iogrp),depths) + call msklvl(jlvlsf6(iogrp),depths) + endif + 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) + endif + if (use_BROMO) then + call msklvl(jlvlbromo(iogrp),depths) + endif + + ! --- 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.) + 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.) + endif + + ! --- Store 2d fields + call wrtsrf(jkwco2(iogrp), SRF_KWCO2(iogrp), rnacc, 0.,cmpflg,'kwco2') + call wrtsrf(jkwco2khm(iogrp), SRF_KWCO2KHM(iogrp), rnacc, 0.,cmpflg,'kwco2khm') + call wrtsrf(jco2kh(iogrp), SRF_CO2KH(iogrp), rnacc, 0.,cmpflg,'co2kh') + call wrtsrf(jco2khm(iogrp), SRF_CO2KHM(iogrp), rnacc, 0.,cmpflg,'co2khm') + call wrtsrf(jpco2(iogrp), SRF_PCO2(iogrp), rnacc, 0.,cmpflg,'pco2') + call wrtsrf(jpco2m(iogrp), SRF_PCO2M(iogrp), rnacc, 0.,cmpflg,'pco2m') + call wrtsrf(jdmsflux(iogrp), SRF_DMSFLUX(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'dmsflux') + call wrtsrf(jco2fxd(iogrp), SRF_CO2FXD(iogrp), rnacc*12./dtbgc,0.,cmpflg,'co2fxd') + call wrtsrf(jco2fxu(iogrp), SRF_CO2FXU(iogrp), rnacc*12./dtbgc,0.,cmpflg,'co2fxu') + call wrtsrf(joxflux(iogrp), SRF_OXFLUX(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'fgo2') + call wrtsrf(jniflux(iogrp), SRF_NIFLUX(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'fgn2') + call wrtsrf(jn2ofx(iogrp), SRF_N2OFX(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'n2oflux') + call wrtsrf(jdms(iogrp), SRF_DMS(iogrp), rnacc, 0.,cmpflg,'dms') + call wrtsrf(jdmsprod(iogrp), SRF_DMSPROD(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'dmsprod') + call wrtsrf(jdms_bac(iogrp), SRF_DMS_BAC(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'dms_bac') + call wrtsrf(jdms_uv(iogrp), SRF_DMS_UV(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'dms_uv') + call wrtsrf(jexport(iogrp), SRF_EXPORT(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'epc100') + call wrtsrf(jexposi(iogrp), SRF_EXPOSI(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'epsi100') + call wrtsrf(jexpoca(iogrp), SRF_EXPOCA(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'epcalc100') + call wrtsrf(jsrfdic(iogrp), SRF_DIC(iogrp), rnacc*1e3, 0.,cmpflg,'srfdissic') + call wrtsrf(jsrfalkali(iogrp), SRF_ALKALI(iogrp), rnacc*1e3, 0.,cmpflg,'srftalk') + call wrtsrf(jsrfphosph(iogrp), SRF_PHOSPH(iogrp), rnacc*1e3, 0.,cmpflg,'srfpo4') + call wrtsrf(jsrfoxygen(iogrp), SRF_OXYGEN(iogrp), rnacc*1e3, 0.,cmpflg,'srfo2') + call wrtsrf(jsrfano3(iogrp), SRF_ANO3(iogrp), rnacc*1e3, 0.,cmpflg,'srfno3') + call wrtsrf(jsrfsilica(iogrp), SRF_SILICA(iogrp), rnacc*1e3, 0.,cmpflg,'srfsi') + call wrtsrf(jsrfiron(iogrp), SRF_IRON(iogrp), rnacc*1e3, 0.,cmpflg,'srfdfe') + call wrtsrf(jsrfphyto(iogrp), SRF_PHYTO(iogrp), rnacc*1e3, 0.,cmpflg,'srfphyc') + call wrtsrf(jsrfph(iogrp), SRF_PH(iogrp), -1., 0.,cmpflg,'srfph') + call wrtsrf(jintphosy(iogrp), INT_PHOSY(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'ppint') + call wrtsrf(jintnfix(iogrp), INT_NFIX(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'nfixint') + call wrtsrf(jintdnit(iogrp), INT_DNIT(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'dnitint') + call wrtsrf(jndepfx(iogrp), FLX_NDEP(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'ndep') + call wrtsrf(joalkfx(iogrp), FLX_OALK(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'oalkfx') + call wrtsrf(jcarflx0100(iogrp), FLX_CAR0100(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'carflx0100') + call wrtsrf(jcarflx0500(iogrp), FLX_CAR0500(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'carflx0500') + call wrtsrf(jcarflx1000(iogrp), FLX_CAR1000(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'carflx1000') + call wrtsrf(jcarflx2000(iogrp), FLX_CAR2000(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'carflx2000') + call wrtsrf(jcarflx4000(iogrp), FLX_CAR4000(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'carflx4000') + call wrtsrf(jcarflx_bot(iogrp), FLX_CAR_BOT(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'carflx_bot') + call wrtsrf(jbsiflx0100(iogrp), FLX_BSI0100(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'bsiflx0100') + call wrtsrf(jbsiflx0500(iogrp), FLX_BSI0500(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'bsiflx0500') + call wrtsrf(jbsiflx1000(iogrp), FLX_BSI1000(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'bsiflx1000') + call wrtsrf(jbsiflx2000(iogrp), FLX_BSI2000(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'bsiflx2000') + call wrtsrf(jbsiflx4000(iogrp), FLX_BSI4000(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'bsiflx4000') + call wrtsrf(jbsiflx_bot(iogrp), FLX_BSI_BOT(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'bsiflx_bot') + call wrtsrf(jcalflx0100(iogrp), FLX_CAL0100(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'calflx0100') + call wrtsrf(jcalflx0500(iogrp), FLX_CAL0500(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'calflx0500') + call wrtsrf(jcalflx1000(iogrp), FLX_CAL1000(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'calflx1000') + 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') + 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') + endif + 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') + endif + 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') + endif + 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') + endif + 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') + endif + call wrtsrf(jatmco2(iogrp), SRF_ATMCO2(iogrp), rnacc, 0.,cmpflg,'atmco2') + 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') + endif + 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') + endif + + ! --- Store 3d layer fields + call wrtlyr(jdp(iogrp), LYR_DP(iogrp), rnacc, 0.,cmpflg,'pddpo') + call wrtlyr(jdic(iogrp), LYR_DIC(iogrp), 1e3, 0.,cmpflg,'dissic') + call wrtlyr(jalkali(iogrp), LYR_ALKALI(iogrp), 1e3, 0.,cmpflg,'talk') + call wrtlyr(jphosph(iogrp), LYR_PHOSPH(iogrp), 1e3, 0.,cmpflg,'po4') + call wrtlyr(joxygen(iogrp), LYR_OXYGEN(iogrp), 1e3, 0.,cmpflg,'o2') + call wrtlyr(jano3(iogrp), LYR_ANO3(iogrp), 1e3, 0.,cmpflg,'no3') + call wrtlyr(jsilica(iogrp), LYR_SILICA(iogrp), 1e3, 0.,cmpflg,'si') + call wrtlyr(jdoc(iogrp), LYR_DOC(iogrp), 1e3, 0.,cmpflg,'dissoc') + call wrtlyr(jphyto(iogrp), LYR_PHYTO(iogrp), 1e3, 0.,cmpflg,'phyc') + call wrtlyr(jgrazer(iogrp), LYR_GRAZER(iogrp), 1e3, 0.,cmpflg,'zooc') + call wrtlyr(jpoc(iogrp), LYR_POC(iogrp), 1e3, 0.,cmpflg,'detoc') + call wrtlyr(jcalc(iogrp), LYR_CALC(iogrp), 1e3, 0.,cmpflg,'calc') + call wrtlyr(jopal(iogrp), LYR_OPAL(iogrp), 1e3, 0.,cmpflg,'opal') + call wrtlyr(jiron(iogrp), LYR_IRON(iogrp), 1e3, 0.,cmpflg,'dfe') + call wrtlyr(jphosy(iogrp), LYR_PHOSY(iogrp), 1e3/dtbgc, 0.,cmpflg,'pp') + call wrtlyr(jco3(iogrp), LYR_CO3(iogrp), 1e3, 0.,cmpflg,'co3') + call wrtlyr(jph(iogrp), LYR_PH(iogrp), -1., 0.,cmpflg,'ph') + call wrtlyr(jomegaa(iogrp), LYR_OMEGAA(iogrp), 1., 0.,cmpflg,'omegaa') + call wrtlyr(jomegac(iogrp), LYR_OMEGAC(iogrp), 1., 0.,cmpflg,'omegac') + call wrtlyr(jn2o(iogrp), LYR_N2O(iogrp), 1e3, 0.,cmpflg,'n2o') + call wrtlyr(jprefo2(iogrp), LYR_PREFO2(iogrp), 1e3, 0.,cmpflg,'p_o2') + call wrtlyr(jo2sat(iogrp), LYR_O2SAT(iogrp), 1e3, 0.,cmpflg,'satoxy') + call wrtlyr(jprefpo4(iogrp), LYR_PREFPO4(iogrp), 1e3, 0.,cmpflg,'p_po4') + 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') + 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') + endif + 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') + endif + 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') + endif + 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') + endif + if (use_BROMO) then + call wrtlyr(jbromo(iogrp), LYR_BROMO(iogrp), 1e3, 0.,cmpflg,'bromo') + endif + + ! --- Store 3d level fields + call wrtlvl(jlvldic(iogrp), LVL_DIC(iogrp), rnacc*1e3, 0.,cmpflg,'dissiclvl') + call wrtlvl(jlvlalkali(iogrp), LVL_ALKALI(iogrp), rnacc*1e3, 0.,cmpflg,'talklvl') + call wrtlvl(jlvlphosph(iogrp), LVL_PHOSPH(iogrp), rnacc*1e3, 0.,cmpflg,'po4lvl') + call wrtlvl(jlvloxygen(iogrp), LVL_OXYGEN(iogrp), rnacc*1e3, 0.,cmpflg,'o2lvl') + call wrtlvl(jlvlano3(iogrp), LVL_ANO3(iogrp), rnacc*1e3, 0.,cmpflg,'no3lvl') + call wrtlvl(jlvlsilica(iogrp), LVL_SILICA(iogrp), rnacc*1e3, 0.,cmpflg,'silvl') + call wrtlvl(jlvldoc(iogrp), LVL_DOC(iogrp), rnacc*1e3, 0.,cmpflg,'dissoclvl') + call wrtlvl(jlvlphyto(iogrp), LVL_PHYTO(iogrp), rnacc*1e3, 0.,cmpflg,'phyclvl') + call wrtlvl(jlvlgrazer(iogrp), LVL_GRAZER(iogrp), rnacc*1e3, 0.,cmpflg,'zooclvl') + call wrtlvl(jlvlpoc(iogrp), LVL_POC(iogrp), rnacc*1e3, 0.,cmpflg,'detoclvl') + call wrtlvl(jlvlcalc(iogrp), LVL_CALC(iogrp), rnacc*1e3, 0.,cmpflg,'calclvl') + call wrtlvl(jlvlopal(iogrp), LVL_OPAL(iogrp), rnacc*1e3, 0.,cmpflg,'opallvl') + call wrtlvl(jlvliron(iogrp), LVL_IRON(iogrp), rnacc*1e3, 0.,cmpflg,'dfelvl') + call wrtlvl(jlvlphosy(iogrp), LVL_PHOSY(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'pplvl') + call wrtlvl(jlvlco3(iogrp), LVL_CO3(iogrp), rnacc*1e3, 0.,cmpflg,'co3lvl') + call wrtlvl(jlvlph(iogrp), LVL_PH(iogrp), -1., 0.,cmpflg,'phlvl') + call wrtlvl(jlvlomegaa(iogrp), LVL_OMEGAA(iogrp), rnacc, 0.,cmpflg,'omegaalvl') + call wrtlvl(jlvlomegac(iogrp), LVL_OMEGAC(iogrp), rnacc, 0.,cmpflg,'omegaclvl') + call wrtlvl(jlvln2o(iogrp), LVL_N2O(iogrp), rnacc*1e3, 0.,cmpflg,'n2olvl') + call wrtlvl(jlvlprefo2(iogrp), LVL_PREFO2(iogrp), rnacc*1e3, 0.,cmpflg,'p_o2lvl') + call wrtlvl(jlvlo2sat(iogrp), LVL_O2SAT(iogrp), rnacc*1e3, 0.,cmpflg,'satoxylvl') + call wrtlvl(jlvlprefpo4(iogrp), LVL_PREFPO4(iogrp), rnacc*1e3, 0.,cmpflg,'p_po4lvl') + 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') + 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') + endif + 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') + endif + 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') + endif + 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') + endif + if (use_BROMO) then + call wrtlvl(jlvlbromo(iogrp), LVL_BROMO(iogrp), rnacc*1e3, 0.,cmpflg,'bromolvl') + endif + + ! --- Store sediment fields + 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 + + ! --- close netcdf file + call ncfcls + + ! --- Initialise fields + call inisrf(jkwco2(iogrp),0.) + call inisrf(jkwco2khm(iogrp),0.) + call inisrf(jco2kh(iogrp),0.) + call inisrf(jco2khm(iogrp),0.) + call inisrf(jpco2(iogrp),0.) + call inisrf(jpco2m(iogrp),0.) + call inisrf(jdmsflux(iogrp),0.) + call inisrf(jco2fxd(iogrp),0.) + call inisrf(jco2fxu(iogrp),0.) + call inisrf(joxflux(iogrp),0.) + call inisrf(jniflux(iogrp),0.) + call inisrf(jn2ofx(iogrp),0.) + call inisrf(jdms(iogrp),0.) + call inisrf(jdmsprod(iogrp),0.) + call inisrf(jdms_bac(iogrp),0.) + call inisrf(jdms_uv(iogrp),0.) + call inisrf(jexport(iogrp),0.) + call inisrf(jexposi(iogrp),0.) + call inisrf(jexpoca(iogrp),0.) + call inisrf(jsrfdic(iogrp),0.) + call inisrf(jsrfalkali(iogrp),0.) + call inisrf(jsrfphosph(iogrp),0.) + call inisrf(jsrfoxygen(iogrp),0.) + call inisrf(jsrfano3(iogrp),0.) + call inisrf(jsrfsilica(iogrp),0.) + call inisrf(jsrfiron(iogrp),0.) + call inisrf(jsrfphyto(iogrp),0.) + call inisrf(jsrfph(iogrp),0.) + call inisrf(jintphosy(iogrp),0.) + call inisrf(jintnfix(iogrp),0.) + call inisrf(jintdnit(iogrp),0.) + call inisrf(jndepfx(iogrp),0.) + call inisrf(joalkfx(iogrp),0.) + call inisrf(jcarflx0100(iogrp),0.) + call inisrf(jcarflx0500(iogrp),0.) + call inisrf(jcarflx1000(iogrp),0.) + call inisrf(jcarflx2000(iogrp),0.) + call inisrf(jcarflx4000(iogrp),0.) + call inisrf(jcarflx_bot(iogrp),0.) + call inisrf(jbsiflx0100(iogrp),0.) + call inisrf(jbsiflx0500(iogrp),0.) + call inisrf(jbsiflx1000(iogrp),0.) + call inisrf(jbsiflx2000(iogrp),0.) + call inisrf(jbsiflx4000(iogrp),0.) + call inisrf(jbsiflx_bot(iogrp),0.) + call inisrf(jcalflx0100(iogrp),0.) + call inisrf(jcalflx0500(iogrp),0.) + call inisrf(jcalflx1000(iogrp),0.) + call inisrf(jcalflx2000(iogrp),0.) + call inisrf(jcalflx4000(iogrp),0.) + call inisrf(jcalflx_bot(iogrp),0.) + 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.) + endif + if (use_cisonew) then + call inisrf(jco213fxd(iogrp),0.) + call inisrf(jco213fxu(iogrp),0.) + call inisrf(jco214fxd(iogrp),0.) + call inisrf(jco214fxu(iogrp),0.) + endif + if (use_CFC) then + call inisrf(jcfc11fx(iogrp),0.) + call inisrf(jcfc12fx(iogrp),0.) + call inisrf(jsf6fx(iogrp),0.) + endif + 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.) + endif + 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.) + endif + + + call inisrf(jatmco2(iogrp),0.) + if (use_BOXATM) then + call inisrf(jatmo2(iogrp),0.) + call inisrf(jatmn2(iogrp),0.) + endif + if (use_cisonew) then + call inisrf(jatmc13(iogrp),0.) + call inisrf(jatmc14(iogrp),0.) + endif + + call inilyr(jdp(iogrp),0.) + call inilyr(jdic(iogrp),0.) + call inilyr(jalkali(iogrp),0.) + call inilyr(jphosy(iogrp),0.) + call inilyr(jphosph(iogrp),0.) + call inilyr(joxygen(iogrp),0.) + call inilyr(jano3(iogrp),0.) + call inilyr(jsilica(iogrp),0.) + call inilyr(jdoc(iogrp),0.) + call inilyr(jphyto(iogrp),0.) + call inilyr(jgrazer(iogrp),0.) + call inilyr(jpoc(iogrp),0.) + call inilyr(jcalc(iogrp),0.) + call inilyr(jopal(iogrp),0.) + call inilyr(jiron(iogrp),0.) + call inilyr(jco3(iogrp),0.) + call inilyr(jph(iogrp),0.) + call inilyr(jomegaa(iogrp),0.) + call inilyr(jomegac(iogrp),0.) + call inilyr(jn2o(iogrp),0.) + call inilyr(jprefo2(iogrp),0.) + call inilyr(jo2sat(iogrp),0.) + call inilyr(jprefpo4(iogrp),0.) + call inilyr(jprefalk(iogrp),0.) + call inilyr(jprefdic(iogrp),0.) + call inilyr(jdicsat(iogrp),0.) + 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.) + endif + 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.) + endif + if (use_CFC) then + call inilyr(jcfc11(iogrp),0.) + call inilyr(jcfc12(iogrp),0.) + call inilyr(jsf6(iogrp),0.) + endif + 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.) + endif + if (use_BROMO) then + call inilyr(jbromo(iogrp),0.) + endif + + call inilvl(jlvldic(iogrp),0.) + call inilvl(jlvlalkali(iogrp),0.) + call inilvl(jlvlphosy(iogrp),0.) + call inilvl(jlvlphosph(iogrp),0.) + call inilvl(jlvloxygen(iogrp),0.) + call inilvl(jlvlano3(iogrp),0.) + call inilvl(jlvlsilica(iogrp),0.) + call inilvl(jlvldoc(iogrp),0.) + call inilvl(jlvlphyto(iogrp),0.) + call inilvl(jlvlgrazer(iogrp),0.) + call inilvl(jlvlpoc(iogrp),0.) + call inilvl(jlvlcalc(iogrp),0.) + call inilvl(jlvlopal(iogrp),0.) + call inilvl(jlvliron(iogrp),0.) + call inilvl(jlvlco3(iogrp),0.) + call inilvl(jlvlph(iogrp),0.) + call inilvl(jlvlomegaa(iogrp),0.) + call inilvl(jlvlomegac(iogrp),0.) + call inilvl(jlvln2o(iogrp),0.) + call inilvl(jlvlprefo2(iogrp),0.) + call inilvl(jlvlo2sat(iogrp),0.) + call inilvl(jlvlprefpo4(iogrp),0.) + call inilvl(jlvlprefalk(iogrp),0.) + call inilvl(jlvlprefdic(iogrp),0.) + call inilvl(jlvldicsat(iogrp),0.) + 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.) + endif + 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.) + endif + if (use_CFC) then + call inilvl(jlvlcfc11(iogrp),0.) + call inilvl(jlvlcfc12(iogrp),0.) + call inilvl(jlvlsf6(iogrp),0.) + endif + 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.) + endif + if (use_BROMO) then + call inilvl(jlvlbromo(iogrp),0.) + endif + + 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 + + nacc_bgc(iogrp)=0 + + 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, & + 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 + + ! Arguments + integer :: iogrp,cmpflg + character :: timeunits*30,calendar*19 + + call ncdefvar('time','time',ndouble,0) + call ncattr('long_name','time') + call ncattr('units',timeunits) + call ncattr('calendar',calendar) + call ncdefvar('sigma','sigma',ndouble,8) + call ncattr('long_name','Potential density') + call ncattr('standard_name','sea_water_sigma_theta') + call ncattr('units','kg m-3') + call ncattr('positive','down') + call ncdefvar('depth','depth',ndouble,8) + call ncattr('long_name','z level') + call ncattr('units','m') + call ncattr('positive','down') + call ncattr('bounds','depth_bnds') + call ncdefvar('depth_bnds','bounds depth',ndouble,8) + call ncdefvar3d(SRF_KWCO2(iogrp),cmpflg,'p', & + & 'kwco2','CO2 piston velocity',' ','m s-1',0) + call ncdefvar3d(SRF_KWCO2KHM(iogrp),cmpflg,'p', & + & 'kwco2khm','CO2 piston velocity times solubility (moist air)',' ', & + & 'm s-1 mol kg-1 muatm-1',0) + call ncdefvar3d(SRF_CO2KH(iogrp),cmpflg,'p', & + & 'co2kh','CO2 solubility (dry air)',' ','mol kg-1 atm-1',0) + call ncdefvar3d(SRF_CO2KHM(iogrp),cmpflg,'p', & + & 'co2khm','CO2 solubility (moist air)',' ','mol kg-1 atm-1',0) + call ncdefvar3d(SRF_PCO2(iogrp),cmpflg,'p', & + & 'pco2','Surface PCO2',' ','uatm',0) + call ncdefvar3d(SRF_PCO2M(iogrp),cmpflg,'p', & + & 'pco2m','Surface PCO2 (moist air)',' ','uatm',0) + call ncdefvar3d(SRF_DMSFLUX(iogrp), & + & cmpflg,'p','dmsflux','DMS flux',' ','mol DMS m-2 s-1',0) + call ncdefvar3d(SRF_CO2FXD(iogrp), & + & cmpflg,'p','co2fxd','Downward CO2 flux',' ','kg C m-2 s-1',0) + call ncdefvar3d(SRF_CO2FXU(iogrp), & + & cmpflg,'p','co2fxu','Upward CO2 flux',' ','kg C m-2 s-1',0) + call ncdefvar3d(SRF_OXFLUX(iogrp), & + & cmpflg,'p','fgo2','Oxygen flux',' ','mol O2 m-2 s-1',0) + call ncdefvar3d(SRF_NIFLUX(iogrp), & + & cmpflg,'p','fgn2','Nitrogen flux',' ','mol N2 m-2 s-1',0) + call ncdefvar3d(SRF_DMS(iogrp),cmpflg,'p', & + & 'dms','DMS',' ','kmol DMS m-3',0) + call ncdefvar3d(SRF_DMSPROD(iogrp),cmpflg,'p', & + & 'dmsprod','DMS production from phytoplankton production',' ', & + & 'mol DMS m-2 s-1',0) + call ncdefvar3d(SRF_DMS_BAC(iogrp),cmpflg,'p', & + & 'dms_bac','DMS bacterial consumption',' ','mol DMS m-2 s-1',0) + call ncdefvar3d(SRF_DMS_UV(iogrp),cmpflg,'p', & + & 'dms_uv','DMS photolysis reduction',' ','mol DMS m-2 s-1',0) + call ncdefvar3d(SRF_EXPORT(iogrp), & + & cmpflg,'p','epc100','Export production',' ','mol C m-2 s-1',0) + call ncdefvar3d(SRF_EXPOSI(iogrp),cmpflg,'p', & + & 'epsi100','Si export production',' ','mol Si m-2 s-1',0) + call ncdefvar3d(SRF_EXPOCA(iogrp),cmpflg,'p', & + & 'epcalc100','Ca export production',' ','mol Ca m-2 s-1',0) + call ncdefvar3d(SRF_DIC(iogrp),cmpflg,'p','srfdissic', & + & 'Surface dissolved inorganic carbon',' ','mol C m-3',0) + call ncdefvar3d(SRF_ALKALI(iogrp),cmpflg,'p','srftalk', & + & 'Surface alkalinity',' ','eq m-3',0) + call ncdefvar3d(SRF_PHOSPH(iogrp),cmpflg,'p','srfpo4', & + & 'Surface phosphorus',' ','mol P m-3',0) + call ncdefvar3d(SRF_OXYGEN(iogrp),cmpflg,'p','srfo2', & + & 'Surface oxygen',' ','mol O2 m-3',0) + call ncdefvar3d(SRF_ANO3(iogrp),cmpflg,'p','srfno3', & + & 'Surface nitrate',' ','mol N m-3',0) + call ncdefvar3d(SRF_SILICA(iogrp),cmpflg,'p','srfsi', & + & 'Surface silicate',' ','mol Si m-3',0) + call ncdefvar3d(SRF_IRON(iogrp),cmpflg,'p','srfdfe', & + & 'Surface dissolved iron',' ','mol Fe m-3',0) + call ncdefvar3d(SRF_PHYTO(iogrp),cmpflg,'p','srfphyc', & + & 'Surface phytoplankton',' ','mol P m-3',0) + call ncdefvar3d(SRF_PH(iogrp),cmpflg,'p','srfph', & + & 'Surface pH',' ','-log10([H+])',0) + call ncdefvar3d(INT_PHOSY(iogrp),cmpflg,'p','ppint', & + & 'Integrated primary production',' ','mol C m-2 s-1',0) + call ncdefvar3d(INT_NFIX(iogrp),cmpflg,'p','nfixint', & + & 'Integrated nitrogen fixation',' ','mol N m-2 s-1',0) + call ncdefvar3d(INT_DNIT(iogrp),cmpflg,'p','dnitint', & + & 'Integrated denitrification',' ','mol N m-2 s-1',0) + call ncdefvar3d(FLX_NDEP(iogrp),cmpflg,'p','ndep', & + & 'Nitrogen deposition flux',' ','mol N m-2 s-1',0) + call ncdefvar3d(FLX_OALK(iogrp),cmpflg,'p','oalkfx', & + & 'Alkalinity flux due to OA',' ','mol TA m-2 s-1',0) + call ncdefvar3d(FLX_CAR0100(iogrp),cmpflg,'p','carflx0100', & + & 'C flux at 100m',' ','mol C m-2 s-1',0) + call ncdefvar3d(FLX_CAR0500(iogrp),cmpflg,'p','carflx0500', & + & 'C flux at 500m',' ','mol C m-2 s-1',0) + call ncdefvar3d(FLX_CAR1000(iogrp),cmpflg,'p','carflx1000', & + & 'C flux at 1000m',' ','mol C m-2 s-1',0) + call ncdefvar3d(FLX_CAR2000(iogrp),cmpflg,'p','carflx2000', & + & 'C flux at 2000m',' ','mol C m-2 s-1',0) + call ncdefvar3d(FLX_CAR4000(iogrp),cmpflg,'p','carflx4000', & + & 'C flux at 4000m',' ','mol C m-2 s-1',0) + call ncdefvar3d(FLX_CAR_BOT(iogrp),cmpflg,'p','carflx_bot', & + & 'C flux to sediment',' ','mol C m-2 s-1',0) + call ncdefvar3d(FLX_BSI0100(iogrp),cmpflg,'p','bsiflx0100', & + & 'Opal flux at 100m',' ','mol Si m-2 s-1',0) + call ncdefvar3d(FLX_BSI0500(iogrp),cmpflg,'p','bsiflx0500', & + & 'Opal flux at 500m',' ','mol Si m-2 s-1',0) + call ncdefvar3d(FLX_BSI1000(iogrp),cmpflg,'p','bsiflx1000', & + & 'Opal flux at 1000m',' ','mol Si m-2 s-1',0) + call ncdefvar3d(FLX_BSI2000(iogrp),cmpflg,'p','bsiflx2000', & + & 'Opal flux at 2000m',' ','mol Si m-2 s-1',0) + call ncdefvar3d(FLX_BSI4000(iogrp),cmpflg,'p','bsiflx4000', & + & 'Opal flux at 4000m',' ','mol Si m-2 s-1',0) + call ncdefvar3d(FLX_BSI_BOT(iogrp),cmpflg,'p','bsiflx_bot', & + & 'Opal flux to sediment',' ','mol Si m-2 s-1',0) + call ncdefvar3d(FLX_CAL0100(iogrp),cmpflg,'p','calflx0100', & + & 'CaCO3 flux at 100m',' ','mol Ca m-2 s-1',0) + call ncdefvar3d(FLX_CAL0500(iogrp),cmpflg,'p','calflx0500', & + & 'CaCO3 flux at 500m',' ','mol Ca m-2 s-1',0) + call ncdefvar3d(FLX_CAL1000(iogrp),cmpflg,'p','calflx1000', & + & 'CaCO3 flux at 1000m',' ','mol Ca m-2 s-1',0) + call ncdefvar3d(FLX_CAL2000(iogrp),cmpflg,'p','calflx2000', & + & 'CaCO3 flux at 2000m',' ','mol Ca m-2 s-1',0) + call ncdefvar3d(FLX_CAL4000(iogrp),cmpflg,'p','calflx4000', & + & 'CaCO3 flux at 4000m',' ','mol Ca m-2 s-1',0) + call ncdefvar3d(FLX_CAL_BOT(iogrp),cmpflg,'p','calflx_bot', & + & '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) + 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) + endif + 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) + endif + 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) + endif + 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) + endif + 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) + endif + + call ncdefvar3d(SRF_ATMCO2(iogrp),cmpflg,'p', & + & 'atmco2','Atmospheric CO2',' ','ppm',0) + 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) + endif + 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) + endif + + ! --- define 3d layer fields + call ncdefvar3d(LYR_DP(iogrp),cmpflg,'p', & + & 'pddpo','Layer thickness',' ','m',1) + call ncdefvar3d(LYR_DIC(iogrp),cmpflg,'p', & + & 'dissic','Dissolved inorganic carbon',' ','mol C m-3',1) + call ncdefvar3d(LYR_ALKALI(iogrp),cmpflg,'p', & + & 'talk','Alkalinity',' ','eq m-3',1) + call ncdefvar3d(LYR_PHOSPH(iogrp),cmpflg,'p', & + & 'po4','Phosphorus',' ','mol P m-3',1) + call ncdefvar3d(LYR_OXYGEN(iogrp),cmpflg,'p', & + & 'o2','Oxygen',' ','mol O2 m-3',1) + call ncdefvar3d(LYR_ANO3(iogrp),cmpflg,'p', & + & 'no3','Nitrate',' ','mol N m-3',1) + call ncdefvar3d(LYR_SILICA(iogrp),cmpflg,'p', & + & 'si','Silicate',' ','mol Si m-3',1) + call ncdefvar3d(LYR_DOC(iogrp),cmpflg,'p', & + & 'dissoc','Dissolved organic carbon',' ','mol P m-3',1) + call ncdefvar3d(LYR_PHYTO(iogrp),cmpflg,'p', & + & 'phyc','Phytoplankton',' ','mol P m-3',1) + call ncdefvar3d(LYR_GRAZER(iogrp),cmpflg,'p', & + & 'zooc','Zooplankton',' ','mol P m-3',1) + call ncdefvar3d(LYR_POC(iogrp),cmpflg,'p', & + & 'detoc','Detritus',' ','mol P m-3',1) + call ncdefvar3d(LYR_CALC(iogrp),cmpflg,'p', & + & 'calc','CaCO3 shells',' ','mol C m-3',1) + call ncdefvar3d(LYR_OPAL(iogrp),cmpflg,'p', & + & 'opal','Opal shells',' ','mol Si m-3',1) + call ncdefvar3d(LYR_IRON(iogrp),cmpflg,'p', & + & 'dfe','Dissolved iron',' ','mol Fe m-3',1) + call ncdefvar3d(LYR_PHOSY(iogrp),cmpflg,'p', & + & 'pp','Primary production',' ','mol C m-3 s-1',1) + call ncdefvar3d(LYR_CO3(iogrp),cmpflg,'p', & + & 'co3','Carbonate ions',' ','mol C m-3',1) + call ncdefvar3d(LYR_PH(iogrp),cmpflg,'p', & + & 'ph','pH',' ','-log10([H+])',1) + call ncdefvar3d(LYR_OMEGAA(iogrp),cmpflg,'p', & + & 'omegaa','OmegaA',' ','1',1) + call ncdefvar3d(LYR_OMEGAC(iogrp),cmpflg,'p', & + & 'omegac','OmegaC',' ','1',1) + call ncdefvar3d(LYR_N2O(iogrp),cmpflg,'p', & + & 'n2o','N2O',' ','mol N2O m-3',1) + call ncdefvar3d(LYR_PREFO2(iogrp),cmpflg,'p', & + & 'p_o2','Preformed oxygen',' ','mol O2 m-3',1) + call ncdefvar3d(LYR_O2SAT(iogrp),cmpflg,'p', & + & 'satoxy','Saturated oxygen',' ','mol O2 m-3',1) + call ncdefvar3d(LYR_PREFPO4(iogrp),cmpflg,'p', & + & 'p_po4','Preformed phosphorus',' ','mol P m-3',1) + call ncdefvar3d(LYR_PREFALK(iogrp),cmpflg,'p', & + & 'p_talk','Preformed alkalinity',' ','eq m-3',1) + call ncdefvar3d(LYR_PREFDIC(iogrp),cmpflg,'p', & + & '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) + 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) + endif + 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) + endif + 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) + endif + 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) + endif + if (use_BROMO) then + call ncdefvar3d(LYR_BROMO(iogrp),cmpflg,'p', & + & 'bromo','Bromoform',' ','mol CHBr3 m-3',1) + endif + + ! --- define 3d level fields + call ncdefvar3d(LVL_DIC(iogrp),cmpflg,'p', & + & 'dissiclvl','Dissolved inorganic carbon',' ','mol C m-3',2) + call ncdefvar3d(LVL_ALKALI(iogrp),cmpflg,'p', & + & 'talklvl','Alkalinity',' ','eq m-3',2) + call ncdefvar3d(LVL_PHOSPH(iogrp),cmpflg,'p', & + & 'po4lvl','Phosphorus',' ','mol P m-3',2) + call ncdefvar3d(LVL_OXYGEN(iogrp),cmpflg,'p', & + & 'o2lvl','Oxygen',' ','mol O2 m-3',2) + call ncdefvar3d(LVL_ANO3(iogrp),cmpflg,'p', & + & 'no3lvl','Nitrate',' ','mol N m-3',2) + call ncdefvar3d(LVL_SILICA(iogrp),cmpflg,'p', & + & 'silvl','Silicate',' ','mol Si m-3',2) + call ncdefvar3d(LVL_DOC(iogrp),cmpflg,'p', & + & 'dissoclvl','Dissolved organic carbon',' ','mol P m-3',2) + call ncdefvar3d(LVL_PHYTO(iogrp),cmpflg,'p', & + & 'phyclvl','Phytoplankton',' ','mol P m-3',2) + call ncdefvar3d(LVL_GRAZER(iogrp),cmpflg,'p', & + & 'zooclvl','Zooplankton',' ','mol P m-3',2) + call ncdefvar3d(LVL_POC(iogrp),cmpflg,'p', & + & 'detoclvl','Detritus',' ','mol P m-3',2) + call ncdefvar3d(LVL_CALC(iogrp),cmpflg,'p', & + & 'calclvl','CaCO3 shells',' ','mol C m-3',2) + call ncdefvar3d(LVL_OPAL(iogrp),cmpflg,'p', & + & 'opallvl','Opal shells',' ','mol Si m-3',2) + call ncdefvar3d(LVL_IRON(iogrp),cmpflg,'p', & + & 'dfelvl','Dissolved iron',' ','mol Fe m-3',2) + call ncdefvar3d(LVL_PHOSY(iogrp),cmpflg,'p', & + & 'pplvl','Primary production',' ','mol C m-3 s-1',2) + call ncdefvar3d(LVL_CO3(iogrp),cmpflg,'p', & + & 'co3lvl','Carbonate ions',' ','mol C m-3',2) + call ncdefvar3d(LVL_PH(iogrp),cmpflg,'p', & + & 'phlvl','pH',' ','-log10([H+])',2) + call ncdefvar3d(LVL_OMEGAA(iogrp),cmpflg,'p', & + & 'omegaalvl','OmegaA',' ','1',2) + call ncdefvar3d(LVL_OMEGAC(iogrp),cmpflg,'p', & + & 'omegaclvl','OmegaC',' ','1',2) + call ncdefvar3d(LVL_N2O(iogrp),cmpflg,'p', & + & 'n2olvl','N2O',' ','mol N2O m-3',2) + call ncdefvar3d(LVL_PREFO2(iogrp),cmpflg,'p', & + & 'p_o2lvl','Preformed oxygen',' ','mol O2 m-3',2) + call ncdefvar3d(LVL_O2SAT(iogrp),cmpflg,'p', & + & 'satoxylvl','Saturated oxygen',' ','mol O2 m-3',2) + call ncdefvar3d(LVL_PREFPO4(iogrp),cmpflg,'p', & + & 'p_po4lvl','Preformed phosphorus',' ','mol P m-3',2) + call ncdefvar3d(LVL_PREFALK(iogrp),cmpflg,'p', & + & 'p_talklvl','Preformed alkalinity',' ','eq m-3',2) + call ncdefvar3d(LVL_PREFDIC(iogrp),cmpflg,'p', & + & '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) + 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) + endif + 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) + endif + 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) + endif + 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) + endif + if (use_BROMO) then + call ncdefvar3d(LVL_BROMO(iogrp),cmpflg,'p', & + & 'bromolvl','Bromoform',' ','mol CHBr3 m-3',2) + endif + + ! --- define sediment fields + 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 + + ! --- enddef netcdf file + call ncedef + + end subroutine hamoccvardef + +END MODULE MO_NCWRT_BGC diff --git a/hamocc/mo_netcdf_def_vardb.F90 b/hamocc/mo_netcdf_def_vardb.F90 new file mode 100644 index 00000000..38294fcc --- /dev/null +++ b/hamocc/mo_netcdf_def_vardb.F90 @@ -0,0 +1,246 @@ +! Copyright (C) 2001 S. Legutke +! Copyright (C) 2020 K. Assmann, J. Tjiputra, J. Schwinger, M. Bentsen +! +! 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. +! +! 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. +! +! 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_NETCDF_DEF_VARDB + + implicit none + private + + public :: NETCDF_DEF_VARDB + +CONTAINS + + SUBROUTINE NETCDF_DEF_VARDB & + (kcid,kshort,yshort,kdims,kcdims,kcvarid, & + kunitl,yunit,klong,ylong,pmissing,klabel,kunit) + + ! **************************************************************** + ! + ! **** *NETCDF_DEF_VAR* - define NetCDF variable. + ! + ! S.Legutke, *MPI-MaD, HH* 10.10.01 + ! + ! Modified + ! -------- + ! + ! Purpose + ! ------- + ! Interface to NETCDF routines. + ! + ! Method + ! ------- + ! + ! + !** Interface. + ! ---------- + ! + ! *CALL* *NETCDF_DEF_VARDB(kcid,kshort,yshort,kdims,kcdims,kcvarid, + ! kunitl,yunit,klong,ylong,pmissing,klabel,kunit)* + ! + ! + ! ** Interface to calling routine (parameter list): + ! ---------------------------------------------- + ! + ! *INTEGER* *kcid* - file ID. + ! *INTEGER* *kshort* - length of short name. + ! *INTEGER* *kdims* - number of dimensions. + ! *INTEGER* *kcdims* - dimensions. + ! *INTEGER* *kcvarid* - variable ID. + ! *INTEGER* *kunitl* - length of unit string. + ! *INTEGER* *klong* - length of long name. + ! *INTEGER* *klabel* - label for abort identification. + ! *INTEGER* *kunit* - stdout unit. + ! *REAL* *pmissing* - missing value. + ! *CHARACTER* *yshort* - short name. + ! *CHARACTER* *yunit* - unit string. + ! *CHARACTER* *ylong* - long name. + ! + ! + ! Externals + ! --------- + ! none. + ! + ! ************************************************************************** + use netcdf, only: nf90_double,nf90_noerr,nf90_put_att,nf90_def_var + use mod_xc, only: mnproc,xchalt + use mod_dia, only: iotype + +#ifdef PNETCDF +#include +#include +#endif + + ! Arguments + integer, intent(in) :: kcid + integer, intent(in) :: kshort + integer, intent(in) :: kdims + integer, intent(in) :: kcdims(kdims) + integer, intent(out) :: kcvarid + integer, intent(in) :: kunitl + integer, intent(in) :: klong + integer, intent(in) :: klabel + integer, intent(in) :: kunit + character(len=*), intent(in) :: yshort + character(len=*), intent(in) :: yunit + character(len=*), intent(in) :: ylong + + ! Local variables + integer :: k + real :: pmissing + character(len=24) :: ystring + integer ::ncstat +#ifdef PNETCDF + integer(kind=MPI_OFFSET_KIND) :: clen +#endif + + ystring(1:21)='NETCDF stop at label ' + + ! + ! Define variable + ! + IF(mnproc==1 .AND. IOTYPE==0) THEN + ncstat = NF90_DEF_VAR(kcid,yshort(1:kshort),NF90_DOUBLE,kcdims,kcvarid) + IF ( ncstat .NE. NF90_NOERR ) THEN + WRITE(kunit,*) 'Problems with definition of NetCDF variable:' + WRITE(kunit,*) 'kcid : ',kcid + WRITE(kunit,*) 'kshort : ',kshort + WRITE(kunit,*) 'yshort(kshort) : ',yshort(1:kshort),'---' + WRITE(kunit,*) 'kdims : ',kdims + WRITE(kunit,*) 'kcdims : ',(kcdims(k),k=1,kdims) + WRITE(kunit,*) 'kcvarid : ',kcvarid + WRITE(ystring(22:24),'(I3)') klabel + WRITE(kunit,*) ystring + CALL xchalt('(netcdf_def_vardb)') + stop '(netcdf_def_vardb)' + ENDIF + ! + ! Set unit + ! + ncstat = NF90_PUT_ATT(kcid,kcvarid,'units',yunit(1:kunitl)) + IF ( ncstat .NE. NF90_NOERR ) THEN + WRITE(kunit,*) 'Problems with definition of unit:' + WRITE(kunit,*) 'kcid : ',kcid + WRITE(kunit,*) 'kcvarid : ',kcvarid + WRITE(kunit,*) 'kunitl : ',kunitl + WRITE(kunit,*) 'yunit(kunitl) : ',yunit(1:kunitl),'---' + WRITE(ystring(22:24),'(I3)') klabel + WRITE(kunit,*) ystring + CALL xchalt('(netcdf_def_vardb)') + stop '(netcdf_def_vardb)' + ENDIF + ! + ! Set long name + ! + ncstat = NF90_PUT_ATT(kcid,kcvarid,'long_name',ylong(1:klong)) + IF ( ncstat .NE. NF90_NOERR ) THEN + WRITE(kunit,*) 'Problems with definition of long name:' + WRITE(kunit,*) 'kcid : ',kcid + WRITE(kunit,*) 'kcvarid : ',kcvarid + WRITE(kunit,*) 'klong : ',klong + WRITE(kunit,*) 'ylong(klong) : ',ylong(1:klong),'---' + WRITE(ystring(22:24),'(I3)') klabel + WRITE(kunit,*) ystring + CALL xchalt('(netcdf_def_vardb)') + stop '(netcdf_def_vardb)' + ENDIF + ! + ! Set missing value + ! + ncstat = NF90_PUT_ATT(kcid,kcvarid,'missing_value',pmissing) + IF ( ncstat .NE. NF90_NOERR ) THEN + WRITE(kunit,*) 'Problems with definition of missing value:' + WRITE(kunit,*) 'kcid : ',kcid + WRITE(kunit,*) 'kcvarid : ',kcvarid + WRITE(kunit,*) 'pmissing : ',pmissing + WRITE(ystring(22:24),'(I3)') klabel + WRITE(kunit,*) ystring + CALL xchalt('(netcdf_def_vardb)') + stop '(netcdf_def_vardb)' + ENDIF + ELSE IF(IOTYPE==1) THEN +#ifdef PNETCDF + ! + ! Define variable + ! + ncstat = nfmpi_def_var(kcid,yshort(1:kshort),nf_double,kdims,kcdims,kcvarid) + IF ( ncstat .NE. NF_NOERR ) THEN + WRITE(kunit,*) 'Problems with definition of NetCDF variable:' + WRITE(kunit,*) 'kcid : ',kcid + WRITE(kunit,*) 'kshort : ',kshort + WRITE(kunit,*) 'yshort(kshort) : ',yshort(1:kshort),'---' + WRITE(kunit,*) 'kdims : ',kdims + WRITE(kunit,*) 'kcdims : ',(kcdims(k),k=1,kdims) + WRITE(kunit,*) 'kcvarid : ',kcvarid + WRITE(ystring(22:24),'(I3)') klabel + WRITE(kunit,*) ystring + CALL xchalt('(pnetcdf_def_vardb)') + stop '(pnetcdf_def_vardb)' + ENDIF + ! + ! Set unit + ! + clen=len(trim(yunit(1:kunitl))) + ncstat = NFMPI_PUT_ATT_TEXT(kcid,kcvarid,'units',clen,yunit(1:kunitl)) + IF ( ncstat .NE. NF_NOERR ) THEN + WRITE(kunit,*) 'Problems with definition of unit:' + WRITE(kunit,*) 'kcid : ',kcid + WRITE(kunit,*) 'kcvarid : ',kcvarid + WRITE(kunit,*) 'kunitl : ',kunitl + WRITE(kunit,*) 'yunit(kunitl) : ',yunit(1:kunitl),'---' + WRITE(ystring(22:24),'(I3)') klabel + WRITE(kunit,*) ystring + CALL xchalt('(pnetcdf_def_vardb)') + stop '(pnetcdf_def_vardb)' + ENDIF + ! + ! Set long name + ! + clen=len(trim(ylong(1:klong))) + ncstat = NFMPI_PUT_ATT_TEXT(kcid,kcvarid,'long_name',clen,ylong(1:klong)) + IF ( ncstat .NE. NF_NOERR ) THEN + WRITE(kunit,*) 'Problems with definition of long name:' + WRITE(kunit,*) 'kcid : ',kcid + WRITE(kunit,*) 'kcvarid : ',kcvarid + WRITE(kunit,*) 'klong : ',klong + WRITE(kunit,*) 'ylong(klong) : ',ylong(1:klong),'---' + WRITE(ystring(22:24),'(I3)') klabel + WRITE(kunit,*) ystring + CALL xchalt('(pnetcdf_def_vardb)') + stop '(pnetcdf_def_vardb)' + ENDIF + ! + ! Set missing value + ! + clen=1 + ncstat = NFMPI_PUT_ATT_DOUBLE(kcid,kcvarid,'missing_value',NF_DOUBLE,clen,pmissing) + IF ( ncstat .NE. NF_NOERR ) THEN + WRITE(kunit,*) 'Problems with definition of missing value:' + WRITE(kunit,*) 'kcid : ',kcid + WRITE(kunit,*) 'kcvarid : ',kcvarid + WRITE(kunit,*) 'pmissing : ',pmissing + WRITE(ystring(22:24),'(I3)') klabel + WRITE(kunit,*) ystring + CALL xchalt('(pnetcdf_def_vardb)') + stop '(pnetcdf_def_vardb)' + ENDIF +#endif + ENDIF + + END SUBROUTINE NETCDF_DEF_VARDB + +END MODULE MO_NETCDF_DEF_VARDB diff --git a/hamocc/mo_ocprod.F90 b/hamocc/mo_ocprod.F90 new file mode 100644 index 00000000..455af772 --- /dev/null +++ b/hamocc/mo_ocprod.F90 @@ -0,0 +1,1452 @@ +! Copyright (C) 2001 Ernst Maier-Reimer, S. Legutke +! Copyright (C) 2020 K. Assmann, J. Tjiputra, J. Schwinger, I. Kriest, +! A. Moree, C. Heinze +! +! 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. +! +! 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. +! +! 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_OCPROD + + implicit none + private + + public :: OCPROD + +CONTAINS + + SUBROUTINE OCPROD(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) + + !****************************************************************************** + ! + ! OCPROD - biological production, remineralization and particle sinking. + ! + ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 + ! + ! Modified + ! -------- + ! S.Legutke, *MPI-MaD, HH* 2010-04-01 + ! + ! J.Schwinger, *GFI, UiB* 2013-04-22 + ! - Corrected bug in light penetration formulation + ! - Cautious code clean-up + ! + ! J.Tjiputra, *UNI-RESEARCH* 2015-11-25 + ! - Implemented natural DIC/ALK/CALC + ! + ! I.Kriest, *GEOMAR* 2016-08-11 + ! - Modified stoichiometry for denitrification (affects NO3, N2, Alk) + ! + ! J.Schwinger, *UNI-RESEARCH* 2017-08-30 + ! - Removed split of the layer that only partly falls into the + ! euphotic zone. Loops are now calculated over + ! (1) layers that are completely or partly in the euphotoc zone + ! (2) layers that do not lie within the euphotic zone. + ! - Moved the accumulation of global fields for output to routine + ! hamocc4bgc. The accumulation of local fields has been moved to + ! the end of this routine. + ! + ! A.Moree, *GFI, Bergen* 2018-04-12 + ! - new version of carbon isotope code + ! + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - moved accumulation of all output fields to seperate subroutine, + ! related code-restructuring + ! - added sediment bypass preprocessor option and related code + ! + ! J.Schwinger, *NORCE Climate, Bergen* 2020-05-29 + ! - Cleaned up parameter list + ! - Dust deposition field now passed as an argument + ! + ! Purpose + ! ------- + ! compute biological production, settling of debris, and related + ! biogeochemistry + ! + ! + ! + ! Parameter list: + ! --------------- + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. + ! *INTEGER* *kbnd* - nb of halo grid points + ! *REAL* *pdlxp* - size of scalar grid cell (1st dimension) [m]. + ! *REAL* *pdlyp* - size of scalar grid cell (2nd dimension) [m]. + ! *REAL* *pddpo* - size of scalar grid cell (3rd dimension) [m]. + ! *REAL* *omask* - land/ocean mask (1=ocean) + ! *REAL* *ptho* - potential temperature [deg C]. + ! + !****************************************************************************** + use mod_xc, only: mnproc + use mo_carbch, only: ocetra,satoxy,hi,co2star + use mo_sedmnt, only: prcaca,produs,prorca,silpro,pror13,pror14,prca13,prca14 + use mo_param_bgc, only: drempoc,dremn2o,dremopal,dremsul,dyphy,ecan,epsher,fesoly,& + gammap,gammaz,grami,grazra,pi_alpha,phytomi, & + rcalc,rcar,rdn2o1,rdn2o2,rdnit0,rdnit1,rdnit2,relaxfe,remido,riron,rnit,rnoi,ro2ut,ropal, & + spemor,wcal,wdust,wopal,wpoc,zinges,alar1,alar2,alar3,alow1,alow2,alow3,calmax,cellmass, & + cellsink,dustd1,dustd2,dustd3,dustsink,fractdim,fse,fsh,nmldmin,plower,pupper,sinkexp,stick,tmfac, & + tsfac,vsmall,zdis,wmin,wmax,wlin,rbro,bifr13,bifr14,dmsp1,dmsp2,dmsp3,dmsp4,dmsp5,dmsp6,dms_gamma, & + fbro1,fbro2,atten_f,atten_c,atten_uv,atten_w,bkopal,bkphy,bkzoo + use mo_biomod, only: bsiflx0100,bsiflx0500,bsiflx1000,bsiflx2000,bsiflx4000,bsiflx_bot, & + calflx0100,calflx0500,calflx1000,calflx2000,calflx4000,calflx_bot, & + carflx0100,carflx0500,carflx1000,carflx2000,carflx4000,carflx_bot, & + expoor,exposi,expoca,intdnit,intdms_bac,intdmsprod,intdms_uv,intphosy,int_chbr3_prod,int_chbr3_uv, & + phosy3d,abs_oce,strahl,asize3d,wmass,wnumb,eps3d,bifr13_perm,growth_co2 + use mo_param1_bgc, only: ialkali,ian2o,iano3,icalc,idet,idms,idoc,ifdust,igasnit,iiron,iopal,ioxygen,iphosph,iphy,isco212, & + 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 mo_vgrid, only: kmle + use mo_clim_swa, only: swa_clim + use mo_inventory_bgc, only: inventory_bgc + + + ! Arguments + integer, intent(in) :: kpie,kpje,kpke,kbnd + real, intent(in) :: pdlxp(kpie,kpje),pdlyp(kpie,kpje) + real, intent(in) :: pddpo(kpie,kpje,kpke) + real, intent(in) :: omask(kpie,kpje) + real, intent(in) :: ptho(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) + real, intent(in) :: pi_ph(kpie,kpje) + + ! Local varaibles + integer, parameter :: nsinkmax = 12 + integer :: i,j,k,l + integer :: is,kdonor + real :: abs_bgc(kpie,kpje,kpke) + real :: tco(nsinkmax),tcn(nsinkmax),q(nsinkmax) + 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,dms_ph + real :: dtr,dz + real :: wpocd,wcald,wopald,dagg + ! sedbypass + real :: florca,flcaca,flsil + ! cisonew + real :: phygrowth + real :: phosy13,phosy14 + real :: grazing13,grazing14 + real :: graton13,graton14 + real :: gratpoc13,gratpoc14 + real :: bacfra13,bacfra14 + real :: phymor13,phymor14 + real :: grawa13,grawa14 + real :: zoomor13,zoomor14 + real :: excdoc13,excdoc14 + real :: exud13,exud14 + real :: export13,export14 + real :: delcar13,delcar14 + real :: dtr13,dtr14 + real :: sterph13,sterph14 + real :: sterzo13,sterzo14 + real :: pocrem13,pocrem14 + real :: docrem13,docrem14 + real :: phyrem13,phyrem14 + real :: rem13,rem14 + real :: rco213,rco214,rdoc13,rdoc14,rdet13,rdet14 + real :: rphy13,rphy14,rzoo13,rzoo14 + ! sedbypass + real :: flor13,flor14,flca13,flca14 + ! AGG + real :: aggregate(kpie,kpje,kpke) + real :: dustagg(kpie,kpje,kpke) + real :: avmass, avnos, anosloss + real :: zmornos, eps, e1,e2,e3,e4,es1,es3 + real :: TopM,TopF, snow,fshear,sagg1,sagg2,sagg4 + real :: sett_agg,shear_agg,effsti,dfirst,dshagg,dsett + real :: wnos,wnosd + ! BROMO + real :: bro_beta,bro_uv + real :: abs_uv(kpie,kpje,kpke) + + ! set variables for diagnostic output to zero + expoor (:,:) = 0. + expoca (:,:) = 0. + exposi (:,:) = 0. + carflx0100(:,:) = 0. + carflx0500(:,:) = 0. + carflx1000(:,:) = 0. + carflx2000(:,:) = 0. + carflx4000(:,:) = 0. + bsiflx0100(:,:) = 0. + bsiflx0500(:,:) = 0. + bsiflx1000(:,:) = 0. + bsiflx2000(:,:) = 0. + bsiflx4000(:,:) = 0. + calflx0100(:,:) = 0. + calflx0500(:,:) = 0. + calflx1000(:,:) = 0. + calflx2000(:,:) = 0. + calflx4000(:,:) = 0. + intdnit (:,:) = 0. + intphosy (:,:) = 0. + intdmsprod(:,:) = 0. + intdms_bac(:,:) = 0. + intdms_uv (:,:) = 0. + phosy3d (:,:,:) = 0. + + if (use_BROMO) then + int_chbr3_uv (:,:) = 0. + int_chbr3_prod(:,:) = 0. + end if + if (use_AGG) then + eps3d(:,:,:) = 0. + asize3d(:,:,:) = 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) + endif + + ! Calculate swr absorption by water and phytoplankton + + abs_bgc(:,:,:) = 0. + if (use_BROMO) then + abs_uv(:,:,:) = 0. + endif + 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 + do i = 1,kpie + + if(omask(i,j) > 0.5) then + + absorption = 1. + absorption_uv = 1. + + vloop: do k = 1,kwrbioz(i,j) + + if(pddpo(i,j,k) > 0.0) then + + dz = pddpo(i,j,k) + + ! 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 + 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 + + ! Radiation intensity I_0 at the top of next layer + absorption = absorption * exp(-atten*dz) + absorption_uv = absorption_uv * exp(-atten_uv*dz) + + endif + enddo vloop + + endif ! omask > 0.5 + + enddo + enddo + !$OMP END PARALLEL DO + + + !$OMP PARALLEL DO PRIVATE(avphy,avgra,avsil,avanut,avanfe,pho,xa,xn & + !$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 & + !$OMP ,avmass,avnos,zmornos & + !$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 & + !$OMP ,bro_beta,bro_uv & + !$OMP ,i,k) + + loop1: do j = 1,kpje + do i = 1,kpie + do k = 1,kwrbioz(i,j) + + if(pddpo(i,j,k) > dp_min .and. omask(i,j) > 0.5) then + + + 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))) + phofa = pi_alpha * strahl(i,j) * abs_bgc(i,j,k) + temfa = 0.6 * 1.066**temp + !taylor: temfa= 0.6*(1. + 0.0639*ptho(i,j,k) * & + ! & (1. + 0.0639*ptho(i,j,k)/2. * (1. + 0.0639*ptho(i,j,k)/3.))) + pho = dtb * phofa * temfa / sqrt(phofa**2 + temfa**2) + + avphy = MAX(phytomi,ocetra(i,j,k,iphy)) ! 'available' phytoplankton + avgra = MAX(grami,ocetra(i,j,k,izoo)) ! 'available' zooplankton + avsil = MAX(0.,ocetra(i,j,k,isilica)) + avdic = MAX(0.,ocetra(i,j,k,isco212)) + avanut = MAX(0.,MIN(ocetra(i,j,k,iphosph), & + & rnoi*ocetra(i,j,k,iano3))) + avanfe = MAX(0.,MIN(avanut,ocetra(i,j,k,iiron)/riron)) + xa = avanfe + xn = xa/(1.+pho*avphy/(xa+bkphy)) + phosy = MAX(0.,xa-xn) + phosy = MERGE(avdic/rcar, phosy, avdic <= rcar*phosy) ! limit phosy by available DIC + ya = avphy+phosy + yn = (ya+grazra*avgra*phytomi/(avphy+bkzoo)) & + & /(1.+grazra*avgra/(avphy+bkzoo)) + grazing = MAX(0.,ya-yn) + graton = epsher*(1.-zinges)*grazing + gratpoc = (1.-epsher)*grazing + grawa = epsher*zinges*grazing + bacfra=remido*ocetra(i,j,k,idoc) + + phythresh = MAX(0.,(ocetra(i,j,k,iphy)-2.*phytomi)) + zoothresh = MAX(0.,(ocetra(i,j,k,izoo)-2.*grami)) + phymor = dyphy*phythresh + exud = gammap*phythresh + zoomor = spemor*zoothresh*zoothresh ! *10 compared to linear in tropics (tinka) + excdoc = gammaz*zoothresh ! excretion of doc by zooplankton + export = zoomor*(1.-ecan) + phymor + gratpoc ! ecan=.95, gratpoc= .2*grazing + + 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 + + ! 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 + + grazing13 = grazing*rphy13 + grazing14 = grazing*rphy14 + + graton13 = epsher*(1.-zinges)*grazing13 + graton14 = epsher*(1.-zinges)*grazing14 + + gratpoc13 = (1.-epsher)*grazing13 + gratpoc14 = (1.-epsher)*grazing14 + + grawa13 = epsher*zinges*grazing13 + grawa14 = epsher*zinges*grazing14 + + bacfra13 = remido*ocetra(i,j,k,idoc13) + bacfra14 = remido*ocetra(i,j,k,idoc14) + + phymor13 = phymor*rphy13 + phymor14 = phymor*rphy14 + + zoomor13 = zoomor*rzoo13 + zoomor14 = zoomor*rzoo14 + + excdoc13 = excdoc*rzoo13 + excdoc14 = excdoc*rzoo14 + + exud13 = exud*rphy13 + exud14 = exud*rphy14 + + export13 = zoomor13*(1.-ecan) + phymor13 + gratpoc13 + export14 = zoomor14*(1.-ecan) + phymor14 + gratpoc14 + 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) + endif + endif + + if(with_dmsph) then + dms_ph = 1. + (-log10(hi(i,j,1)) - pi_ph(i,j))*dms_gamma + else + dms_ph = 1. + endif + dmsprod = (dmsp5*delsil+dmsp4*delcar) & + & *(1.+1./(temp+dmsp1)**2)*dms_ph + dms_bac = dmsp3*abs(temp+3.)*ocetra(i,j,k,idms) & + & *(ocetra(i,j,k,idms)/(dmsp6+ocetra(i,j,k,idms))) + dms_uv = dmsp2*phofa/pi_alpha*ocetra(i,j,k,idms) + + dtr = bacfra-phosy+graton+ecan*zoomor + + ocetra(i,j,k,iphosph) = ocetra(i,j,k,iphosph)+dtr + ocetra(i,j,k,iano3) = ocetra(i,j,k,iano3)+dtr*rnit + ocetra(i,j,k,idet) = ocetra(i,j,k,idet)+export + ocetra(i,j,k,idms) = ocetra(i,j,k,idms)+dmsprod-dms_bac-dms_uv + ocetra(i,j,k,isco212) = ocetra(i,j,k,isco212)-delcar+rcar*dtr + ocetra(i,j,k,ialkali) = ocetra(i,j,k,ialkali)-2.*delcar-(rnit+1)*dtr + ocetra(i,j,k,ioxygen) = ocetra(i,j,k,ioxygen)-dtr*ro2ut + ocetra(i,j,k,iphy) = ocetra(i,j,k,iphy)+phosy-grazing-phymor-exud + 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 + 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 + endif + 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 + endif + 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.) + + 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 + endif + + 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) + !********************************************************************** + + 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 + !*********************************************************************** + + zmornos = zoomor * (1.-ecan) * zdis * 1.e+6 + ocetra(i,j,k,inos) = ocetra(i,j,k,inos)+zmornos + endif + + ! add up for total inventory and output + dz = pddpo(i,j,k) + + expoor(i,j) = expoor(i,j) +export*rcar*dz + expoca(i,j) = expoca(i,j) +delcar*dz + exposi(i,j) = exposi(i,j) +delsil*dz + 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 + + 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 + endif + + 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 + + + endif ! pddpo(i,j,k) > dp_min + enddo ! kwrbioz + enddo ! kpie + enddo loop1 ! kpje + + !$OMP END PARALLEL DO + + 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 + + !$OMP PARALLEL DO PRIVATE(phythresh,zoothresh,sterph,sterzo,remin & + !$OMP ,opalrem,aou,refra,dms_bac,pocrem,docrem,phyrem,dz & + !$OMP ,avmass,avnos,zmornos & + !$OMP ,rphy13,rphy14,rzoo13,rzoo14,rdet13,rdet14,rdoc13,rdoc14 & + !$OMP ,sterph13,sterph14,sterzo13,sterzo14,pocrem13,pocrem14 & + !$OMP ,docrem13,docrem14,phyrem13,phyrem14 & + !$OMP ,i,k) + + loop2: do j = 1,kpje + do i = 1,kpie + do k = kwrbioz(i,j)+1,kpke + if(pddpo(i,j,k) > dp_min .and. omask(i,j) > 0.5) then + + 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 + 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 + 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) + 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. + 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 + ocetra(i,j,k,idoc) = ocetra(i,j,k,idoc) - docrem + ocetra(i,j,k,iphy) = ocetra(i,j,k,iphy) - phyrem + + remin = pocrem + docrem + phyrem + + ocetra(i,j,k,iphosph) = ocetra(i,j,k,iphosph)+remin + ocetra(i,j,k,iano3) = ocetra(i,j,k,iano3)+remin*rnit + ocetra(i,j,k,isco212) = ocetra(i,j,k,isco212)+rcar*remin + ocetra(i,j,k,ialkali) = ocetra(i,j,k,ialkali)-(rnit+1)*remin + 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.) + 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 + ! so the expression dremopal*(Si(OH)4sat-Si(OH)4) would change the + ! rate only from 0 to 100% + !*********************************************************************** + opalrem = dremopal*0.1*(temp+3.)*ocetra(i,j,k,iopal) + ocetra(i,j,k,iopal) = ocetra(i,j,k,iopal)-opalrem + ocetra(i,j,k,isilica) = ocetra(i,j,k,isilica)+opalrem + + !*********************************************************************** + ! There is about 1.e4 O2 on 1 N2O molecule (Broeker&Peng) + ! refra : Tim Rixton, private communication + !*********************************************************************** + aou = satoxy(i,j,k)-ocetra(i,j,k,ioxygen) + refra = 1.+3.*(0.5+sign(0.5,aou-1.97e-4)) + dms_bac = dmsp3 * abs(temp+3.) * ocetra(i,j,k,idms) & + & * (ocetra(i,j,k,idms) / (dmsp6+ocetra(i,j,k,idms))) + ocetra(i,j,k,ian2o) = ocetra(i,j,k,ian2o)+remin*1.e-4*ro2ut*refra + ocetra(i,j,k,igasnit) = ocetra(i,j,k,igasnit)-remin*1.e-4*ro2ut*refra + ocetra(i,j,k,ioxygen) = ocetra(i,j,k,ioxygen)-remin*1.e-4*ro2ut*refra*0.5 + ocetra(i,j,k,idms) = ocetra(i,j,k,idms)-dms_bac + + dz = pddpo(i,j,k) + intdms_bac(i,j) = intdms_bac(i,j)+dms_bac*dz + + 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 + enddo + enddo loop2 + !$OMP END PARALLEL DO + + 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 + + !$OMP PARALLEL DO PRIVATE(remin,remin2o,dz & + !$OMP ,avmass,avnos & + !$OMP ,rem13,rem14 & + !$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 + 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) + + 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) + ocetra(i,j,k,iphosph) = ocetra(i,j,k,iphosph)+(remin+remin2o) + ocetra(i,j,k,iano3) = ocetra(i,j,k,iano3)-rdnit1*remin + 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 + 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 + + 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 + enddo + enddo + enddo loop3 + !$OMP END PARALLEL DO + + + 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 + + + !sulphate reduction ! introduced 11.5.2007 to improve poc-remineralisation in the + ! oxygen minimum zone in the subsurface equatorial Pacific + ! assumption of endless pool of SO4 (typical concentration are on the order of mmol/l) + ! js 02072007: for other runs than current millenium (cosmos-setup) experiments this seems + ! to cause trouble as phosphate concentrations are too high at the depth of the oxygen + ! minimum in the equatorial pacific/atlantic + ! does it make sense to check for oxygen and nitrate deficit? + + !$OMP PARALLEL DO PRIVATE(remin & + !$OMP ,avmass,avnos & + !$OMP ,rem13,rem14 & + !$OMP ,i,k) + loop4: do j = 1,kpje + do i = 1,kpie + do k = kwrbioz(i,j)+1,kpke + 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 + + if (use_AGG) then + avmass = ocetra(i,j,k,iphy)+ocetra(i,j,k,idet) + endif + remin = dremsul*ocetra(i,j,k,idet) + 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 + 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 + endif + enddo + enddo + enddo loop4 + !$OMP END PARALLEL DO + ! end 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 + + + 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 + + endif ! use_AGG + + + ! + ! implicit method for sinking of particles: + ! C(k,T+dt)=C(k,T) + (w*dt/ddpo(k))*(C(k-1,T+1)-C(k,T+1)) + ! --> + ! C(k,T+dt)=(ddpo(k)*C(k,T)+w*dt*C(k-1,T+dt))/(ddpo(k)+w*dt) + ! sedimentation=w*dt*C(ks,T+dt) + ! + !$OMP PARALLEL DO PRIVATE(kdonor,wpoc,wpocd,wcal,wcald,wopal,wopald & + !$OMP ,wnos,wnosd,dagg & + !$OMP ,i,k) + do j = 1,kpje + do i = 1,kpie + + tco(:) = 0.0 + tcn(:) = 0.0 + + if(omask(i,j) > 0.5) then + + kdonor = 1 + do k = 1,kpke + + ! Sum up total column inventory before sinking scheme + 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) + 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 (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 (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 + endif + + if( k == 1 ) then + wpocd = 0.0 + wcald = 0.0 + wopald = 0.0 + if (use_AGG) then + wnosd = 0.0 + else if (use_WLIN) then + wpoc = wmin + endif + 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 + ocetra(i,j,k,idet) = (ocetra(i,j,k ,idet)*pddpo(i,j,k) & + + ocetra(i,j,kdonor,idet)*wpocd)/ & + (pddpo(i,j,k)+wpoc) + 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) + 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 + 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) + 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) + 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 + + ! Sum up total column inventory after sinking scheme + ! flux to sediment added after kpke-loop + 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) + 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 (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 + + + ! 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 + 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 (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 + do is = 1,nsinkmax + if( tco(is) > 1.e-12 .and. tcn(is) > 1.e-12 ) q(is) = tco(is)/tcn(is) + enddo + do k = 1,kpke + 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) + 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 (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 (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 + 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 + 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 + endif + + endif ! omask > 0.5 + enddo ! loop i=1,kpie + enddo ! loop j=1,kpje + !$OMP END PARALLEL DO + + + ! Calculate mass sinking flux for carbon, opal and calcium carbonate + ! through the 100 m, 500 m, 1000 m, 2000 m, and 4000 m depth surfaces. These + ! fluxes are intentionally calculated using values at the NEW timelevel + ! to be fully consistent with the implicit sinking scheme + + !$OMP PARALLEL DO PRIVATE(i,k,wpoc,wcal,wopal) + do j = 1,kpje + do i = 1,kpie + if(omask(i,j) > 0.5) then + + ! 100 m + k = k0100(i,j) + if(k > 0) then + 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) + endif + + 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 + endif + bsiflx0100(i,j) = ocetra(i,j,k,iopal)*wopal + calflx0100(i,j) = ocetra(i,j,k,icalc)*wcal + endif + + ! 500 m + k = k0500(i,j) + if(k > 0) then + 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) + endif + + 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 + endif + bsiflx0500(i,j) = ocetra(i,j,k,iopal)*wopal + calflx0500(i,j) = ocetra(i,j,k,icalc)*wcal + endif + + ! 1000 m + k = k1000(i,j) + if(k > 0) then + 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) + endif + + 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 + endif + bsiflx1000(i,j) = ocetra(i,j,k,iopal)*wopal + calflx1000(i,j) = ocetra(i,j,k,icalc)*wcal + endif + + ! 2000 m + k = k2000(i,j) + if(k > 0) then + 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) + endif + + 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 + endif + bsiflx2000(i,j) = ocetra(i,j,k,iopal)*wopal + calflx2000(i,j) = ocetra(i,j,k,icalc)*wcal + endif + + ! 4000 m + k = k4000(i,j) + if(k > 0) then + 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) + endif + + 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 + endif + bsiflx4000(i,j) = ocetra(i,j,k,iopal)*wopal + calflx4000(i,j) = ocetra(i,j,k,icalc)*wcal + endif + + ! bottom fluxes + carflx_bot(i,j) = prorca(i,j)*rcar + bsiflx_bot(i,j) = silpro(i,j) + calflx_bot(i,j) = prcaca(i,j) + + endif ! omask > 0.5 + enddo + 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 + + 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 + + endif ! use_sedbypass + + 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 + + end subroutine ocprod + +END MODULE MO_OCPROD diff --git a/hamocc/mo_powach.F90 b/hamocc/mo_powach.F90 new file mode 100644 index 00000000..9452362a --- /dev/null +++ b/hamocc/mo_powach.F90 @@ -0,0 +1,551 @@ +! Copyright (C) 2001 Ernst Maier-Reimer, S. Legutke +! 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. +! +! 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. +! +! 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_POWACH + + implicit none + private + + public :: POWACH + +CONTAINS + + subroutine powach(kpie,kpje,kpke,kbnd,prho,omask,psao,lspin) + + !****************************************************************************** + ! + !**** *POWACH* - . + ! + ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 + ! + ! Modified + ! -------- + ! S.Legutke, *MPI-MaD, HH* 10.04.01 + ! + ! Purpose + ! ------- + ! . + ! + ! Method + ! ------- + ! . + ! + !** Interface. + ! ---------- + ! + ! *CALL* *POWACH* + ! + ! *COMMON* *PARAM1_BGC.h* - declaration of ocean/sediment tracer. + ! + !** Interface to ocean model (parameter list): + ! ----------------------------------------- + ! + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. + ! *INTEGER* *kbnd* - nb of halo grid points + ! *REAL* *prho* - seawater density [g/cm^3]. + ! *REAL* *psao* - salinity [psu]. + ! *REAL* *omask* - land/ocean mask + ! + ! Externals + ! --------- + ! none. + ! + !****************************************************************************** + 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,ipowc13,ipowc14,isssc13,isssc14,issso13,issso14,safediv + use mo_carbch, only: co3,keqb,ocetra,sedfluxo + use mo_chemcon, only: calcon + use mo_param_bgc, only: rnit,ro2ut,disso_sil,silsat,disso_poc,sed_denit,disso_caco3 + use mo_sedmnt, only: porwat,porsol,powtra,produs,prcaca,prorca,seddw,sedhpl,sedlay,silpro,pror13,pror14,prca13,prca14 + use mo_vgrid, only: kbo,bolay + use mo_powadi, only: powadi + use mo_carchm, only: carchm_solve + use mo_dipowa, only: dipowa + + ! Arguments + integer, intent(in) :: kpie,kpje,kpke,kbnd + real, intent(in) :: prho(kpie,kpje,kpke) + real, intent(in) :: omask(kpie,kpje) + real, intent(in) :: psao(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) + logical, intent(in) :: 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) + 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 + integer, parameter :: niter = 5 ! number of iterations for carchm_solve + + !****************************************************************************** + + ! Set array for saving diffusive sediment-water-column fluxes to zero + sedfluxo(:,:,:) = 0.0 + + ! A LOOP OVER J + ! RJ: This loop must go from 1 to kpje in the parallel version, + ! otherways we had to do a boundary exchange + + !$OMP PARALLEL DO & + !$OMP&PRIVATE(sedb1,sediso,solrat,powcar,aerob,anaerob, & + !$OMP& dissot,undsa,posol, & + !$OMP& umfa,denit,saln,rrho,alk,c,sit,pt, & + !$OMP& K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p, & + !$OMP& ah1,ac,cu,cb,cc,satlev, & + !$OMP& ratc13,ratc14,rato13,rato14,poso13,poso14, & + !$OMP& k,i) + + j_loop: do j = 1, kpje + + do k = 1, ks + do i = 1, kpie + solrat(i,k) = 0. + powcar(i,k) = 0. + anaerob(i,k)= 0. + aerob(i,k) = 0. + if (use_cisonew) then + anaerob13(i,k)=0. + aerob13(i,k) =0. + anaerob14(i,k)=0. + aerob14(i,k) =0. + endif + enddo + enddo + + do k = 0, ks + do i = 1, kpie + sedb1(i,k) = 0. + sediso(i,k) = 0. + enddo + enddo + + ! Calculate silicate-opal cycle and simultaneous silicate diffusion + !****************************************************************** + + ! Dissolution rate constant of opal (disso) [1/(kmol Si(OH)4/m3)*1/sec]*dtbgc + dissot=disso_sil + + ! Evaluate boundary conditions for sediment-water column exchange. + ! Current undersaturation of bottom water: sedb(i,0) and + ! Approximation for new solid sediment, as from sedimentation flux: solrat(i,1) + + do i = 1, kpie + if(omask(i,j) > 0.5) then + undsa = silsat - powtra(i,j,1,ipowasi) + sedb1(i,0) = bolay(i,j) * (silsat - ocetra(i,j,kbo(i,j),isilica)) + solrat(i,1) = ( sedlay(i,j,1,issssil) & + + silpro(i,j) / (porsol(i,j,1) * seddw(1)) ) & + * dissot / (1. + dissot * undsa) * porsol(i,j,1) / porwat(i,j,1) + endif + enddo + + ! Evaluate sediment undersaturation and degradation. + ! Current undersaturation in pore water: sedb(i,k) and + ! Approximation for new solid sediment, as from degradation: solrat(i,k) + + do k = 1, ks + do i = 1, kpie + if(omask(i,j) > 0.5) then + undsa = silsat - powtra(i,j,k,ipowasi) + sedb1(i,k) = seddw(k) * porwat(i,j,k) * (silsat - powtra(i,j,k,ipowasi)) + if ( k > 1 ) solrat(i,k) = sedlay(i,j,k,issssil) & + * dissot / (1. + dissot * undsa) * porsol(i,j,k) / porwat(i,j,k) + endif + enddo + enddo + + ! Solve for new undersaturation sediso, from current undersaturation sedb1, + ! and first guess of new solid sediment solrat. + + call powadi(j,kpie,kpje,solrat,sedb1,sediso,omask) + + ! Update water column silicate, and store the flux for budget. + ! Add sedimentation to first layer. + + do i = 1, kpie + if(omask(i,j) > 0.5) then + if(.not. lspin) then + sedfluxo(i,j,ipowasi) = & + -(silsat - sediso(i,0) - ocetra(i,j,kbo(i,j),isilica)) & + * bolay(i,j) + ocetra(i,j,kbo(i,j),isilica) = silsat - sediso(i,0) + endif + sedlay(i,j,1,issssil) = & + sedlay(i,j,1,issssil) + silpro(i,j) / (porsol(i,j,1) * seddw(1)) + endif + enddo + + + ! Calculate updated degradation rate from updated undersaturation. + ! Calculate new solid sediment. + ! Update pore water concentration from new undersaturation. + + do k = 1, ks + do i = 1, kpie + if(omask(i,j) > 0.5) then + umfa = porsol(i,j,k)/porwat(i,j,k) + solrat(i,k) = sedlay(i,j,k,issssil) * dissot / (1. + dissot * sediso(i,k)) + posol = sediso(i,k) * solrat(i,k) + sedlay(i,j,k,issssil) = sedlay(i,j,k,issssil) - posol + powtra(i,j,k,ipowasi) = silsat - sediso(i,k) + endif + enddo + enddo + + ! Calculate oxygen-POC cycle and simultaneous oxygen diffusion + !************************************************************* + + ! Degradation rate constant of POP (disso) [1/(kmol O2/m3)*1/sec]*dtbgc + dissot = disso_poc + + ! This scheme is not based on undersaturation, but on O2 itself + + ! Evaluate boundary conditions for sediment-water column exchange. + ! Current concentration of bottom water: sedb(i,0) and + ! Approximation for new solid sediment, as from sedimentation flux: solrat(i,1) + + do i = 1, kpie + if(omask(i,j) > 0.5) then + undsa = powtra(i,j,1,ipowaox) + sedb1(i,0) = bolay(i,j) * ocetra(i,j,kbo(i,j),ioxygen) + solrat(i,1) = ( sedlay(i,j,1,issso12) + prorca(i,j) & + & / (porsol(i,j,1) * seddw(1)) ) & + & * ro2ut * dissot / (1. + dissot * undsa) & + & * porsol(i,j,1) / porwat(i,j,1) + endif + enddo + + ! Evaluate sediment concentration and degradation. + ! Current concentration in pore water: sedb(i,k) and + ! Approximation for new solid sediment, as from degradation: solrat(i,k) + + do k = 1, ks + do i = 1, kpie + if(omask(i,j) > 0.5) then + undsa = powtra(i,j,k,ipowaox) + sedb1(i,k) = seddw(k) * porwat(i,j,k) * powtra(i,j,k,ipowaox) + if (k > 1) solrat(i,k) = sedlay(i,j,k,issso12) * ro2ut * dissot & + & / (1. + dissot*undsa) * porsol(i,j,k) / porwat(i,j,k) + endif + enddo + enddo + + ! Solve for new O2 concentration sediso, from current concentration sedb1, + ! and first guess of new solid sediment solrat. + + call powadi(j,kpie,kpje,solrat,sedb1,sediso,omask) + + ! Update water column oxygen, and store the diffusive flux for budget (sedfluxo, + ! positive downward). Add sedimentation to first layer. + + do i = 1, kpie + if(omask(i,j) > 0.5) then + if(.not. lspin) then + sedfluxo(i,j,ipowaox) = -(sediso(i,0) - ocetra(i,j,kbo(i,j),ioxygen)) * bolay(i,j) + ocetra(i,j,kbo(i,j),ioxygen) = sediso(i,0) + endif + sedlay(i,j,1,issso12) = sedlay(i,j,1,issso12) + prorca(i,j) / (porsol(i,j,1)*seddw(1)) + 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)) + endif + endif + enddo + + + ! Calculate updated degradation rate from updated concentration. + ! Calculate new solid sediment. + ! Update pore water concentration. + ! Store flux in array aerob, for later computation of DIC and alkalinity. + do k = 1, ks + do i = 1, kpie + if(omask(i,j) > 0.5) then + umfa = porsol(i,j,k) / porwat(i,j,k) + 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 + 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 + endif + 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) + 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 + endif + endif + enddo + enddo + + ! Calculate nitrate reduction under anaerobic conditions explicitely + !******************************************************************* + + ! Denitrification rate constant of POP (disso) [1/sec]*dtbgc + denit = sed_denit + do k = 1, ks + do i = 1, kpie + if(omask(i,j) > 0.5) then + if(powtra(i,j,k,ipowaox) < 1.e-6) then + posol = denit * MIN(0.5*powtra(i,j,k,ipowno3)/114., 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 + 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 + endif + 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 + 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 + endif + endif + endif + enddo + enddo + + ! sulphate reduction in sediments + do k = 1, ks + do i = 1, kpie + if(omask(i,j) > 0.5) then + if(powtra(i,j,k,ipowaox) < 3.e-6 .and. powtra(i,j,k,ipowno3) < 3.e-6) then + posol = denit * sedlay(i,j,k,issso12) ! remineralization of poc + 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 + 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 + endif + 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*rnit + 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 + endif + endif + endif + enddo + enddo ! end sulphate reduction + + + ! Calculate CaCO3-CO3 cycle and simultaneous CO3-undersaturation diffusion + !************************************************************************* + + + ! Compute new powcar, carbonate ion concentration in the sediment + ! from changed alkalinity (nitrate production during remineralisation) + ! and DIC gain. Iterate 5 times. This changes pH (sedhpl) of sediment. + + do k = 1, ks + do i = 1, kpie + if(omask(i,j) > 0.5) then + saln= min( 40., max( 0., psao(i,j,kbo(i,j)))) + rrho= prho(i,j,kbo(i,j)) + alk = (powtra(i,j,k,ipowaal) - (anaerob(i,k)+aerob(i,k))*16.) / rrho + c = (powtra(i,j,k,ipowaic) + (anaerob(i,k)+aerob(i,k))*122.) / rrho + sit = powtra(i,j,k,ipowasi) / rrho + pt = powtra(i,j,k,ipowaph) / rrho + ah1 = sedhpl(i,j,k) + K1 = keqb( 1,i,j) + K2 = keqb( 2,i,j) + Kb = keqb( 3,i,j) + Kw = keqb( 4,i,j) + Ks1 = keqb( 5,i,j) + Kf = keqb( 6,i,j) + Ksi = keqb( 7,i,j) + K1p = keqb( 8,i,j) + K2p = keqb( 9,i,j) + K3p = keqb(10,i,j) + + call carchm_solve(saln,c,alk,sit,pt, & + K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p, & + ah1,ac,niter) + + cu = ( 2. * c - ac ) / ( 2. + K1 / ah1 ) + cb = K1 * cu / ah1 + cc = K2 * cb / ah1 + sedhpl(i,j,k) = max( 1.e-20, ah1 ) + powcar(i,k) = cc * rrho + endif + enddo + enddo + + ! Dissolution rate constant of CaCO3 (disso) [1/(kmol CO3--/m3)*1/sec]*dtbgc + dissot = disso_caco3 + + ! Evaluate boundary conditions for sediment-water column exchange. + ! Current undersaturation of bottom water: sedb(i,0) and + ! Approximation for new solid sediment, as from sedimentation flux: solrat(i,1) + + ! CO3 saturation concentration is aksp/calcon as in CARCHM + ! (calcon defined in MO_CHEMCON with 1.028e-2; 1/calcon =~ 97.) + + do i = 1, kpie + if(omask(i,j) > 0.5) then + satlev = keqb(11,i,j) / calcon + 2.e-5 + undsa = MAX( satlev-powcar(i,1), 0. ) + sedb1(i,0) = bolay(i,j) * (satlev-co3(i,j,kbo(i,j))) + solrat(i,1) = (sedlay(i,j,1,isssc12) & + & + prcaca(i,j) / (porsol(i,j,1)*seddw(1))) & + & * dissot / (1.+dissot*undsa) * porsol(i,j,1) / porwat(i,j,1) + endif + enddo + + ! Evaluate sediment undersaturation and degradation. + ! Current undersaturation in pore water: sedb(i,k) and + ! Approximation for new solid sediment, as from degradation: solrat(i,k) + + do k = 1, ks + do i = 1, kpie + if(omask(i,j) > 0.5) then + undsa = MAX( keqb(11,i,j) / calcon - powcar(i,k), 0. ) + sedb1(i,k) = seddw(k) * porwat(i,j,k) * undsa + if (k > 1) then + solrat(i,k) = sedlay(i,j,k,isssc12) * dissot/(1.+dissot*undsa) * porsol(i,j,k)/porwat(i,j,k) + end if + if (undsa <= 0.) then + solrat(i,k) = 0. + end if + endif + enddo + enddo + + ! Solve for new undersaturation sediso, from current undersaturation sedb1, + ! and first guess of new solid sediment solrat. + + call powadi(j,kpie,kpje,solrat,sedb1,sediso,omask) + + ! There is no exchange between water and sediment with respect to co3 so far. + ! Add sedimentation to first layer. + do i = 1, kpie + 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)) + 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)) + endif + endif + enddo + + ! Calculate updated degradation rate from updated undersaturation. + ! Calculate new solid sediment. + ! No update of powcar pore water concentration from new undersaturation so far. + ! Instead, only update DIC, and, of course, alkalinity. + ! This also includes gains from aerobic and anaerobic decomposition. + + do k = 1, ks + do i = 1, kpie + if(omask(i,j) > 0.5) then + umfa = porsol(i,j,k) / porwat(i,j,k) + solrat(i,k) = sedlay(i,j,k,isssc12) * dissot / (1. + dissot * sediso(i,k)) + posol = sediso(i,k) * solrat(i,k) + 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 + endif + 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)) + 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. + endif + endif + enddo + enddo + + enddo j_loop + + !$OMP END PARALLEL DO + + call dipowa(kpie,kpje,kpke,omask,lspin) + + !ik add clay sedimentation onto sediment + !ik this is currently assumed to depend on total and corg sedimentation: + !ik f(POC) [kg C] / f(total) [kg] = 0.05 + !ik thus it is + !$OMP PARALLEL DO PRIVATE(i) + do j = 1, kpje + do i = 1, kpie + sedlay(i,j,1,issster) = sedlay(i,j,1,issster) & + & + produs(i,j) / (porsol(i,j,1) * seddw(1)) + enddo + enddo + !$OMP END PARALLEL DO + + if(.not. lspin) then + !$OMP PARALLEL DO PRIVATE(i) + do j = 1, kpje + do i = 1, kpie + silpro(i,j) = 0. + prorca(i,j) = 0. + prcaca(i,j) = 0. + if (use_cisonew) then + pror13(i,j) = 0. + pror14(i,j) = 0. + prca13(i,j) = 0. + prca14(i,j) = 0. + endif + produs(i,j) = 0. + enddo + enddo + !$OMP END PARALLEL DO + endif + + end subroutine powach + +END MODULE MO_powach diff --git a/hamocc/mo_powadi.F90 b/hamocc/mo_powadi.F90 new file mode 100644 index 00000000..a3b8b277 --- /dev/null +++ b/hamocc/mo_powadi.F90 @@ -0,0 +1,145 @@ +! Copyright (C) 2001 Ernst Maier-Reimer, S. Legutke +! 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. +! +! 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. +! +! 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_POWADI + + implicit none + private + + public :: powadi + +CONTAINS + + SUBROUTINE POWADI(j,kpie,kpje,solrat,sedb1,sediso,omask) + + !********************************************************************** + ! + !**** *POWADI* - vertical diffusion with simultaneous dissolution. + ! + ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 + ! + ! Modified + ! -------- + ! S.Legutke, *MPI-MaD, HH* 10.04.01 + ! + ! Purpose + ! ------- + ! . + ! + ! Method + ! ------- + ! implicit discretisation. + ! + !** Interface. + ! ---------- + ! + ! *CALL* *POWADI(j,solrat,sedb1,sediso)* + ! + ! Input solrat : dissolution rate + ! ===== j : zonal grid index + ! sedb1 : tracer at entry + ! + ! Output: sediso: diffused tracer at exit + ! ====== + ! + ! *PARAMETER* *PARAM1_BGC.h* - declaration of ocean/sediment tracer. + ! + ! Externals + ! --------- + ! none. + ! + !********************************************************************** + + use mo_sedmnt, only: porwah,porwat,seddw,seddzi + use mo_param_bgc, only: sedict + use mo_param1_bgc, only: ks + use mo_vgrid, only: bolay + + ! Arguments + integer, intent(in) :: j, kpie, kpje + real, dimension(kpie,ks), intent(in) :: solrat + real, dimension(kpie,0:ks), intent(inout) :: sedb1, sediso + real, dimension(kpie,kpje), intent(in) :: omask + + ! Local variables + integer :: i,k,l + real :: asu, alo + real, dimension(kpie,0:ks,3) :: tredsy + + !********************************************************************** + + do k = 1, ks + do i = 1, kpie + asu = sedict * seddzi(k) * porwah(i,j,k) + alo = 0. + if(k < ks) alo = sedict * seddzi(k+1) * porwah(i,j,k+1) + tredsy(i,k,1) = -asu + tredsy(i,k,3) = -alo + tredsy(i,k,2) = seddw(k) * porwat(i,j,k) - tredsy(i,k,1) & + - tredsy(i,k,3) + solrat(i,k) * porwat(i,j,k) * seddw(k) + enddo + enddo + + k = 0 + asu = 0. + do i = 1, kpie + alo = sedict * seddzi(1) * porwah(i,j,1) + if(omask(i,j) > 0.5) then + tredsy(i,k,1) = -asu + tredsy(i,k,3) = -alo + tredsy(i,k,2) = bolay(i,j) - tredsy(i,k,1) - tredsy(i,k,3) + else + tredsy(i,k,1) = 0 + tredsy(i,k,3) = 0 + tredsy(i,k,2) = 0 + endif + enddo + + do k = 1, ks + do i = 1, kpie + if(omask(i,j) > 0.5) then + tredsy(i,k-1,1) = tredsy(i,k,1) / tredsy(i,k-1,2) + tredsy(i,k,2) = tredsy(i,k,2) - tredsy(i,k-1,3) * tredsy(i,k,1) / tredsy(i,k-1,2) + endif + enddo + enddo + + do k = 1, ks + do i = 1, kpie + sedb1(i,k) = sedb1(i,k) - tredsy(i,k-1,1) * sedb1(i,k-1) + enddo + enddo + + k = ks + do i = 1, kpie + if(omask(i,j) > 0.5) sediso(i,k) = sedb1(i,k) / tredsy(i,k,2) + enddo + + do k = 1, ks + l = ks - k + do i = 1, kpie + if(omask(i,j) > 0.5) then + sediso(i,l) = ( sedb1(i,l) - tredsy(i,l,3) * sediso(i,l+1) ) / tredsy(i,l,2) + endif + enddo + enddo + + end subroutine powadi + +END MODULE MO_POWADI diff --git a/hamocc/mo_preftrc.F90 b/hamocc/mo_preftrc.F90 new file mode 100644 index 00000000..d61a1617 --- /dev/null +++ b/hamocc/mo_preftrc.F90 @@ -0,0 +1,80 @@ +! Copyright (C) 2020 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. +! +! 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. +! +! 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_PREFTRC + + implicit none + private + + public :: PREFTRC + +CONTAINS + + SUBROUTINE PREFTRC(kpie,kpje,omask) + + !**************************************************************** + ! + !**** *PREFTRC* - update preformed tracers in the mixed layer. + ! + ! J. Tjiputra, J.Schwinger, *BCCR, Bergen* 2015-01-23 + ! + ! Modified + ! -------- + ! J.Tjiputra, *Uni Research, Bergen* 2018-04-12 + ! - added preformed DIC tracer + ! + ! + ! Method + ! ------- + ! Preformed tracers are set to the value of their full counterparts + ! in the mixed layer. + ! + ! + !** Interface to ocean model (parameter list): + ! ----------------------------------------- + ! + ! *INTEGER* *kpie* - 1st dimension of model grid. + ! *INTEGER* *kpje* - 2nd dimension of model grid. + ! + !************************************************************************** + + use mo_carbch, only: ocetra + use mo_param1_bgc, only: ialkali,ioxygen,iphosph,iprefalk,iprefdic,iprefo2,iprefpo4,isco212 + use mo_vgrid, only: kmle + + ! Arguments + integer :: kpie,kpje + real :: omask(kpie,kpje) + + ! Local variables + integer :: i,j + + do j=1,kpje + do i=1,kpie + if (omask(i,j) .gt. 0.5 ) then + ocetra(i,j,1:kmle(i,j),iprefo2) = ocetra(i,j,1:kmle(i,j),ioxygen) + ocetra(i,j,1:kmle(i,j),iprefpo4) = ocetra(i,j,1:kmle(i,j),iphosph) + ocetra(i,j,1:kmle(i,j),iprefalk) = ocetra(i,j,1:kmle(i,j),ialkali) + ocetra(i,j,1:kmle(i,j),iprefdic) = ocetra(i,j,1:kmle(i,j),isco212) + endif + enddo + enddo + + + END SUBROUTINE PREFTRC + +END MODULE MO_PREFTRC diff --git a/hamocc/mo_profile_gd.F90 b/hamocc/mo_profile_gd.F90 new file mode 100644 index 00000000..396bef92 --- /dev/null +++ b/hamocc/mo_profile_gd.F90 @@ -0,0 +1,189 @@ +! Copyright (C) 2020 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. +! +! 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. +! +! 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_PROFILE_GD + + implicit none + private + + public :: PROFILE_GD + +CONTAINS + + SUBROUTINE PROFILE_GD(kpie,kpje,kpke,kbnd,pglon,pglat,omask) + + !******************************************************************************* + ! J.Schwinger, *Gfi, Bergen* 2011-05-19 + ! + ! Modified + ! -------- + ! J.Schwinger, *Uni Climate, BCCR* 2017-07-07 + ! - moved conversion from mumol to mol to mod_gdata_read + ! - changed linear interpolation from data-levels to model levels to propper + ! mapping of data profile to model-levels + ! + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - adaptions for reading c-isotope initial values as d13C and d14C + ! + ! Purpose + ! ------- + ! - initialise HAMOCC fields with gridded (1x1 deg) WOA and GLODAP + ! data using the module mo_Gdata_read. Note that the routine get_profile + ! returns the mean of all data profiles within a rectangular region + ! ("smoothing region") of dxy x dxy degrees extent, where dxy is an + ! adjustable parameter. + ! + ! + !******************************************************************************* + + use mod_xc, only: xchalt + use mo_carbch, only: ocetra + use mo_Gdata_read, only: set_Gdata,clean_Gdata,get_profile,nzmax,nz,zlev_bnds,fillval + use mo_control_bgc, only: io_stdo_bgc + use mo_vgrid, only: ptiestw + use mo_param1_bgc, only: ialkali,iano3,ioxygen,iphosph,isco212,isilica + use mo_param1_bgc, only: isco213,isco214 + use mo_param1_bgc, only: inatalkali,inatsco212 + use mo_control_bgc, only: use_natDIC,use_cisonew + + ! Arguments + integer, intent(in) :: kpie,kpje,kpke,kbnd + real, intent(in) :: omask(kpie,kpje) + real, intent(in) :: pglon(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) + real, intent(in) :: pglat(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) + + ! Local variables + integer :: i,j,k,l,ll,n + integer :: idx,izmax + real :: prf(nzmax),wgt(nzmax),zbnds(2,nzmax),clon,clat + real, parameter :: dxy = 5.0 ! Extent of "smoothing region" + integer, parameter :: nread_base = 6 ! Number of fields to read + integer, parameter :: nread_ndic = 2 ! Number of fields to read + integer, parameter :: nread_ciso = 2 ! Number of fields to read + integer, parameter :: maxflds = nread_base+nread_ndic+nread_ciso + integer :: nflds, no + integer :: ifld(maxflds) + character(len=3) :: vname(maxflds) + + nflds = nread_base + vname( 1:nflds) = (/ 'dic', 'alk', 'pho', 'nit','sil', 'oxy' /) + ifld( 1:nflds) = (/ isco212,ialkali,iphosph,iano3,isilica,ioxygen/) + + if (use_natDIC) then + no = nflds+1 + nflds = nflds+nread_ndic + vname(no:nflds) = (/'dic', 'alk'/) + ifld(no:nflds) = (/inatsco212,inatalkali/) + endif + + if (use_cisonew) then + no = nflds+1 + nflds = nflds+nread_ciso + vname(no:nflds) = (/'d13', 'd14'/) + ifld(no:nflds) = (/isco213,isco214/) + endif + + do n = 1, nflds ! Loop over tracer + + call set_Gdata(vname(n),dxy) + + do j=1,kpje + do i=1,kpie + + If(omask(i,j) > 0.5) THEN + + clon = pglon(i,j) + clat = pglat(i,j) + idx = ifld(n) + call get_profile(clon,clat,prf) + + ! Find depest z-level with valid data + izmax=nz + do l=2,nz + if( prf(l) < fillval*0.1 ) then + izmax = l-1 + exit + endif + enddo + ! Set data level-boundaries for this profile + zbnds = fillval + zbnds(:,1:nz) = zlev_bnds + zbnds(1,1) = 0.0 ! make sure that upper data bnd is 0 + if(zbnds(2,izmax) < ptiestw(i,j,kpke+1)) then + zbnds(2,izmax) = ptiestw(i,j,kpke+1)+10.0 ! extend lower bound of bottom layer + endif + + Do k=1,kpke + + wgt(:)=0.0 + + loop_obs: do l=1,izmax + + ! 1st case: Model layer completely within data-layer + if(zbnds(1,l) <= ptiestw(i,j,k) .and. zbnds(2,l) >= ptiestw(i,j,k+1)) then + ocetra(i,j,k,idx)=prf(l) + exit loop_obs + endif + + ! 2nd case: one (or both) data-layer boundary are within model layer + + ! a) The lower data level-boundary is lower than the upper model level-interface. + ! and the upper data level-boundary is higher than the lower model + ! level-interface => some overlap between data and model level exists. + ! Calculate the corresponding weight. + if(zbnds(2,l) > ptiestw(i,j,k) .and. zbnds(1,l) <= ptiestw(i,j,k+1)) & + wgt(l) = zbnds(2,l)-ptiestw(i,j,k) & + - max(zbnds(1,l)-ptiestw(i,j,k), 0.0) & + - max(zbnds(2,l)-ptiestw(i,j,k+1),0.0) + + ! b) The upper data level-boundary is lower than the lower model level-interface + ! => all weights have been calculated, calculate concentration and exit + if(zbnds(1,l) > ptiestw(i,j,k+1) .or. l==izmax) then + wgt(:) = wgt(:)/(ptiestw(i,j,k+1)-ptiestw(i,j,k)) + if( abs(sum(wgt(:))-1.0) > 1.0e-6 ) then + write(io_stdo_bgc,*) 'profile_gd error: inconsisten weihts' + write(io_stdo_bgc,*) 'profile_gd error: ', k,l,abs(sum(wgt(:))-1.0) + write(io_stdo_bgc,*) 'profile_gd error: ', wgt(1:izmax) + write(io_stdo_bgc,*) 'profile_gd error: ', ptiestw(i,j,k),ptiestw(i,j,k+1) + call flush(io_stdo_bgc) + call xchalt('(profile_gd)') + endif + do ll=1,l + ocetra(i,j,k,idx) = ocetra(i,j,k,idx) + prf(ll)*wgt(ll) + enddo + exit loop_obs + endif + + + enddo loop_obs + + ENDDO ! k=1,kpke + + ENDIF ! omask > 0.5 + + ENDDO + ENDDO + + call clean_Gdata() + + enddo ! Loop over fields + + !******************************************************************************** + END SUBROUTINE profile_gd + +END MODULE MO_PROFILE_GD diff --git a/hamocc/mo_read_fedep.F90 b/hamocc/mo_read_fedep.F90 index 0e7653ba..cbaff598 100644 --- a/hamocc/mo_read_fedep.F90 +++ b/hamocc/mo_read_fedep.F90 @@ -17,6 +17,7 @@ module mo_read_fedep + !****************************************************************************** ! ! MODULE mo_read_fedep - routines for reading iron deposition data @@ -56,16 +57,14 @@ module mo_read_fedep ! File name (incl. full path) for input data, set through namelist ! in hamocc_init.F character(len=512), save :: fedepfile='' + ! Array to store dust deposition flux after reading from file real, allocatable, save :: dustflx(:,:,:) - contains - !****************************************************************************** - - subroutine ini_read_fedep(kpie,kpje,omask) + !****************************************************************************** ! ! INI_FEDEP - initialise the iron deposition module. @@ -84,19 +83,23 @@ subroutine ini_read_fedep(kpie,kpje,omask) ! *REAL* *omask* - land/ocean mask (1=ocean) ! !****************************************************************************** - use netcdf, only: nf90_noerr,nf90_nowrite,nf90_close,nf90_open - use mod_xc, only: mnproc,xchalt - use mo_control_bgc, only: io_stdo_bgc + + use netcdf, only: nf90_noerr,nf90_nowrite,nf90_close,nf90_open + use mod_xc, only: mnproc,xchalt + use mo_control_bgc, only: io_stdo_bgc + use mo_read_netcdf_var, only: read_netcdf_var implicit none - integer, intent(in) :: kpie,kpje + ! Arguments + integer, intent(in) :: kpie + integer, intent(in) :: kpje real, intent(in) :: omask(kpie,kpje) + ! Local variables integer :: i,j,l integer :: ncid,ncstat,ncvarid,errstat - ! allocate field to hold iron deposition fluxes IF (mnproc.eq.1) THEN WRITE(io_stdo_bgc,*)' ' diff --git a/hamocc/mo_read_ndep.F90 b/hamocc/mo_read_ndep.F90 index 99b0bd42..6a0ab105 100644 --- a/hamocc/mo_read_ndep.F90 +++ b/hamocc/mo_read_ndep.F90 @@ -17,6 +17,7 @@ module mo_read_ndep + !****************************************************************************** ! ! S.Gao *Gfi, Bergen* 2017-08-19 @@ -65,22 +66,22 @@ module mo_read_ndep ! Read and return n-deposition data for a given month. ! !****************************************************************************** - implicit none + implicit none private - public :: ini_read_ndep,get_ndep,ndepfile - character(len=512), save :: ndepfile='' - real, allocatable, save :: ndepread(:,:) - integer, save :: startyear,endyear - logical, save :: lini = .false. - - !****************************************************************************** -contains + public :: ini_read_ndep + public :: get_ndep + character(len=512), public :: ndepfile='' + real, allocatable :: ndepread(:,:) + integer :: startyear,endyear + logical :: lini = .false. +contains subroutine ini_read_ndep(kpie,kpje) + !****************************************************************************** ! ! S. Gao *Gfi, Bergen* 19.08.2017 @@ -99,19 +100,22 @@ subroutine ini_read_ndep(kpie,kpje) ! *INTEGER* *kpje* - 2nd dimension of model grid. ! !****************************************************************************** - use mod_xc, only: mnproc,xchalt - use mo_control_bgc, only: io_stdo_bgc,do_ndep - use mod_dia, only: iotype - use mod_nctools, only: ncfopn,ncgeti,ncfcls + + use mod_xc, only: mnproc,xchalt + use mo_control_bgc, only: io_stdo_bgc,do_ndep + use mod_dia, only: iotype + use mod_nctools, only: ncfopn,ncgeti,ncfcls + use mo_read_netcdf_var, only: read_netcdf_var implicit none + ! Arguments integer, intent(in) :: kpie,kpje + ! Local variables integer :: errstat logical :: file_exists=.false. - ! Return if N deposition is turned off if (.not. do_ndep) then if (mnproc.eq.1) then @@ -166,12 +170,11 @@ subroutine ini_read_ndep(kpie,kpje) endif - - !****************************************************************************** end subroutine ini_read_ndep subroutine get_ndep(kpie,kpje,kplyear,kplmon,omask,ndep) + !****************************************************************************** ! ! S. Gao *Gfi, Bergen* 19.08.2017 @@ -190,12 +193,15 @@ subroutine get_ndep(kpie,kpje,kplyear,kplmon,omask,ndep) ! *REAL* *ndep* - N-deposition field for current year and month ! !****************************************************************************** - use mod_xc, only: mnproc - use netcdf, only: nf90_open,nf90_close,nf90_nowrite - use mo_control_bgc, only: io_stdo_bgc,do_ndep + + use mod_xc, only: mnproc + use netcdf, only: nf90_open,nf90_close,nf90_nowrite + use mo_control_bgc, only: io_stdo_bgc,do_ndep + use mo_read_netcdf_var, only: read_netcdf_var implicit none + ! Arguments integer, intent(in) :: kpie,kpje,kplyear,kplmon real, intent(in) :: omask(kpie,kpje) real, intent(out) :: ndep(kpie,kpje) @@ -204,14 +210,12 @@ subroutine get_ndep(kpie,kpje,kplyear,kplmon,omask,ndep) integer :: month_in_file,ncstat,ncid integer, save :: oldmonth=0 - ! if N-deposition is switched off set ndep to zero and return if (.not. do_ndep) then ndep(:,:) = 0.0 return endif - ! read ndep data from file if (kplmon.ne.oldmonth) then month_in_file=(max(startyear,min(endyear,kplyear))-startyear)*12+kplmon @@ -227,10 +231,6 @@ subroutine get_ndep(kpie,kpje,kplyear,kplmon,omask,ndep) ndep(:,:) = ndepread - !****************************************************************************** end subroutine get_ndep - - - !****************************************************************************** end module mo_read_ndep diff --git a/hamocc/mo_read_netcdf_var.F90 b/hamocc/mo_read_netcdf_var.F90 new file mode 100644 index 00000000..26986216 --- /dev/null +++ b/hamocc/mo_read_netcdf_var.F90 @@ -0,0 +1,174 @@ +! Copyright (C) 2020 I. Bethke, M. Bentsen +! +! 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. +! +! 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. +! +! 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_READ_NETCDF_VAR + + implicit none + private + + public :: READ_NETCDF_VAR + +CONTAINS + + SUBROUTINE READ_NETCDF_VAR(ncid,desc,arr,klev,time,typeio) + + !************************************************************************** + ! + ! Reads a variable from a NETCDF file and distributes it to all PEs + ! + ! The NETCDF File is only accessed by mnproc=1 + ! + !************************************************************************** + + use netcdf, only: nf90_noerr,nf90_inq_varid,nf90_strerror,nf90_get_var + use mod_xc, only: idm,itdm,jtdm,jdm,lp,mnproc,nbdy,xchalt,xcaput +#ifdef PNETCDF + use mod_xc, only: i0,ii,jj,j0 +#endif +#ifdef PNETCDF +#include +#include +#endif + + ! Arguments + integer, intent(in) :: ncid + character(len=*), intent(in) :: desc + integer, intent(in) :: klev + integer, intent(in) :: time + integer, intent(in) :: typeio + real, intent(out) :: arr(idm,jdm,klev) + + ! Local variables + integer :: i,j,k + integer :: ncstat + integer :: ncvarid + integer :: start(4),count(4) + real :: arr_g(itdm,jtdm) + real, allocatable :: arr_l(:,:,:) +#ifdef PNETCDF + integer (kind=MPI_OFFSET_KIND) :: istart(4),icount(4) +#endif + + ! Read NETCDF data + + IF(TYPEIO==0) THEN + + start=1 + count=0 + start(1)=1 + count(1)=itdm + start(2)=1 + count(2)=jtdm + if (klev.gt.1.or.time.gt.0) then + if (klev.gt.1.and.time.gt.0) then + start(3)=1 + count(3)=1 + start(4)=time + count(4)=1 + else if (klev.gt.1.and.time.eq.0) then + start(3)=1 + count(3)=1 + else + start(3)=time + count(3)=1 + endif + endif + allocate(arr_l(1-nbdy:idm+nbdy,1-nbdy:jdm+nbdy,1)) + + if (mnproc.eq.1) then + ncstat=nf90_inq_varid(ncid,desc,ncvarid) + if (ncstat.ne.nf90_noerr) then + write(lp,'(4a)') 'nf90_inq_varid: ',trim(desc),': ',nf90_strerror(ncstat) + call xchalt('(read_netcdf_var)') + stop '(read_netcdf_var)' + endif + endif + do k=1,klev + if (mnproc.eq.1) then + if (k.gt.1) then + start(3)=k + count(3)=1 + endif + ncstat=nf90_get_var(ncid,ncvarid,arr_g,start,count) + if (ncstat.ne.nf90_noerr) then + write(lp,'(4a)') 'nf90_get_vara_double: ',trim(desc),': ',nf90_strerror(ncstat) + call xchalt('(read_netcdf_var)') + stop '(read_netcdf_var)' + endif + endif + call xcaput(arr_g,arr_l,1) + do j=1,jdm + do i=1,idm + arr(i,j,k)=arr_l(i,j,1) + enddo + enddo + enddo + + ELSE IF(TYPEIO==1) THEN + +#ifdef PNETCDF + allocate(arr_l(ii,jj,klev)) + arr=0.0 + istart=1 + icount=0 + istart(1)=i0+1 + icount(1)=ii + istart(2)=j0+1 + icount(2)=jj + if (klev.gt.1.or.time.gt.0) then + if (klev.gt.1.and.time.gt.0) then + istart(3)=1 + icount(3)=klev + istart(4)=time + icount(4)=1 + else if (klev.gt.1.and.time.eq.0) then + istart(3)=1 + icount(3)=klev + else + istart(3)=time + icount(3)=1 + endif + endif + + ncstat=nfmpi_inq_varid(ncid,desc,ncvarid) + if (ncstat.ne.nf_noerr) then + write(lp,'(4a)') 'nfmpi_inq_varid: ',trim(desc),': ',nfmpi_strerror(ncstat) + call xchalt('(read_pnetcdf_var)') + stop '(read_pnetcdf_var)' + endif + + ncstat=nfmpi_get_vara_double_all(ncid,ncvarid,istart,icount,arr_l) + if (ncstat.ne.nf_noerr) then + write(lp,'(4a)') 'nfmpi_get_vara_double: ',trim(desc),': ',nfmpi_strerror(ncstat) + call xchalt('(read_pnetcdf_var)') + stop '(read_pnetcdf_var)' + endif + do k=1,klev + do j=1,jj + do i=1,ii + arr(i,j,k)=arr_l(i,j,k) + enddo + enddo + enddo +#endif + ELSE + call xchalt('(read_pnetcdf_var) WRONG IOTYPE') + ENDIF + + END SUBROUTINE READ_NETCDF_VAR + +END MODULE MO_READ_NETCDF_VAR diff --git a/hamocc/mo_read_oafx.F90 b/hamocc/mo_read_oafx.F90 index 2c4d585a..c7df6865 100644 --- a/hamocc/mo_read_oafx.F90 +++ b/hamocc/mo_read_oafx.F90 @@ -17,6 +17,7 @@ module mo_read_oafx + !****************************************************************************** ! ! J.Schwinger *NORCE Climate, Bergen* 2022-08-24 @@ -71,9 +72,10 @@ module mo_read_oafx ! ! !****************************************************************************** - implicit none + implicit none private + public :: ini_read_oafx,get_oafx,oalkscen,oalkfile,thrh_omegaa character(len=128), protected :: oalkscen ='' @@ -115,12 +117,10 @@ module mo_read_oafx logical, save :: lini = .false. - !****************************************************************************** contains - - subroutine ini_read_oafx(kpie,kpje,pdlxp,pdlyp,pglat,omask) + !****************************************************************************** ! ! J.Schwinger *NORCE Climate, Bergen* 2021-11-15 @@ -142,18 +142,24 @@ subroutine ini_read_oafx(kpie,kpje,pdlxp,pdlyp,pglat,omask) ! *REAL* *omask* - land/ocean mask. ! !****************************************************************************** - use mod_xc, only: xcsum,xchalt,mnproc,nbdy,ips - use mod_dia, only: iotype - use mod_nctools, only: ncfopn,ncgeti,ncfcls - use mo_control_bgc, only: io_stdo_bgc,do_oalk,bgc_namelist,get_bgc_namelist + + use mod_xc, only: xcsum,xchalt,mnproc,nbdy,ips + use mod_dia, only: iotype + use mod_nctools, only: ncfopn,ncgeti,ncfcls + use mo_control_bgc, only: io_stdo_bgc,do_oalk,bgc_namelist,get_bgc_namelist + use mo_read_netcdf_var, only: read_netcdf_var implicit none - integer, intent(in) :: kpie,kpje - real, intent(in) :: pdlxp(kpie,kpje), pdlyp(kpie,kpje) + ! Arguments + integer, intent(in) :: kpie + integer, intent(in) :: kpje + real, intent(in) :: pdlxp(kpie,kpje) + real, intent(in) :: pdlyp(kpie,kpje) real, intent(in) :: pglat(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy) real, intent(in) :: omask(kpie,kpje) + ! Local variables integer :: i,j,errstat logical :: file_exists=.false. integer :: iounit @@ -316,13 +322,16 @@ subroutine get_oafx(kpie,kpje,kplyear,kplmon,omask,oafx) ! *REAL* *oaflx* - alkalinization flux [kmol m-2 yr-1] ! !****************************************************************************** - use mod_xc, only: xchalt,mnproc - use netcdf, only: nf90_open,nf90_close,nf90_nowrite - use mo_control_bgc, only: io_stdo_bgc,do_oalk - use mod_time, only: nday_of_year + + use mod_xc, only: xchalt,mnproc + use netcdf, only: nf90_open,nf90_close,nf90_nowrite + use mo_control_bgc, only: io_stdo_bgc,do_oalk + use mod_time, only: nday_of_year + use mo_read_netcdf_var, only: read_netcdf_var implicit none + ! Arguments integer, intent(in) :: kpie,kpje,kplyear,kplmon real, intent(in) :: omask(kpie,kpje) real, intent(out) :: oafx(kpie,kpje) @@ -336,17 +345,19 @@ subroutine get_oafx(kpie,kpje,kplyear,kplmon,omask,oafx) return endif - !-------------------------------- - ! Scenarios of constant fluxes - !-------------------------------- if( trim(oalkscen)=='const' ) then + !-------------------------------- + ! Scenarios of constant fluxes + !-------------------------------- + oafx(:,:) = oalkflx(:,:) + elseif(trim(oalkscen)=='ramp' ) then + !-------------------------------- ! Scenario of ramping-up fluxes !-------------------------------- - elseif(trim(oalkscen)=='ramp' ) then if(kplyear.lt.ramp_start ) then oafx(:,:) = 0.0 @@ -357,10 +368,11 @@ subroutine get_oafx(kpie,kpje,kplyear,kplmon,omask,oafx) oafx(:,:) = oalkflx(:,:) * current_day / ((ramp_end-ramp_start)*365.) endif + elseif(trim(oalkscen)=='file' ) then + !-------------------------------- ! Scenario from OA file !-------------------------------- - elseif(trim(oalkscen)=='file' ) then ! read OA data from file if (kplmon.ne.oldmonth) then diff --git a/hamocc/mo_read_pi_ph.F90 b/hamocc/mo_read_pi_ph.F90 index 95621ebd..5d20a849 100644 --- a/hamocc/mo_read_pi_ph.F90 +++ b/hamocc/mo_read_pi_ph.F90 @@ -19,10 +19,11 @@ module mo_read_pi_ph implicit none private + public :: ini_pi_ph,get_pi_ph,pi_ph_file,pi_ph ! Path to input data, set through namelist in hamocc_init.F - character(len=256),save :: pi_ph_file = '' + character(len=256) :: pi_ph_file = '' ! Length of surface PI pH record from file ! - Current implementation only support monthly records. @@ -36,26 +37,30 @@ module mo_read_pi_ph CONTAINS - - !********************************************************************** - ! PUBLIC SUBROUTINE : INI_PI_PH - ! - ! Initialise the PI_PH field from climatology. - !********************************************************************** subroutine ini_pi_ph(kpie,kpje,omask) - use mo_control_bgc, only: io_stdo_bgc,with_dmsph - use netcdf, only: nf90_noerr,nf90_nowrite,nf90_close,nf90_open - use mod_xc, only: mnproc,xchalt + + !********************************************************************** + ! PUBLIC SUBROUTINE : INI_PI_PH + ! + ! Initialise the PI_PH field from climatology. + !********************************************************************** + + use mo_control_bgc, only: io_stdo_bgc,with_dmsph + use netcdf, only: nf90_noerr,nf90_nowrite,nf90_close,nf90_open + use mod_xc, only: mnproc,xchalt + use mo_read_netcdf_var, only: read_netcdf_var implicit none - INTEGER, INTENT(in) :: kpie,kpje - INTEGER ::i,j,l - REAL,intent(in) ::omask(kpie,kpje) + ! Arguments + integer, intent(in) :: kpie + integer, intent(in) :: kpje + real, intent(in) :: omask(kpie,kpje) - ! define the fields - REAL :: pi_ph_in(kpie,kpje,pi_ph_record) - INTEGER ncid,ncstat + ! Local variables + integer ::i,j,l + real :: pi_ph_in(kpie,kpje,pi_ph_record) ! define the fields + integer :: ncid,ncstat ! Allocate pi_ph field (required argument for hmaocc4bcm) if(.not. allocated(pi_ph)) call alloc_pi_ph(kpie,kpje) @@ -184,5 +189,4 @@ subroutine alloc_pi_ph_clim(kpie,kpje) end subroutine alloc_pi_ph_clim - end module mo_read_pi_ph diff --git a/hamocc/mo_read_sedpor.F90 b/hamocc/mo_read_sedpor.F90 index d2947a20..fbd60bce 100644 --- a/hamocc/mo_read_sedpor.F90 +++ b/hamocc/mo_read_sedpor.F90 @@ -16,6 +16,7 @@ ! along with BLOM. If not, see https://www.gnu.org/licenses/. module mo_read_sedpor + !***************************************************************************** ! Purpose ! ------- @@ -40,7 +41,6 @@ module mo_read_sedpor !***************************************************************************** implicit none - private public :: read_sedpor,sedporfile @@ -50,16 +50,19 @@ module mo_read_sedpor contains subroutine read_sedpor(kpie,kpje,ks,omask,sed_por) - use mod_xc, only: mnproc,xchalt - use mo_control_bgc, only: io_stdo_bgc,l_3Dvarsedpor - use netcdf, only: nf90_noerr,nf90_nowrite,nf90_close,nf90_open - + use mod_xc, only: mnproc,xchalt + use mo_control_bgc, only: io_stdo_bgc,l_3Dvarsedpor + use netcdf, only: nf90_noerr,nf90_nowrite,nf90_close,nf90_open + use mo_read_netcdf_var, only: read_netcdf_var implicit none - integer, intent(in) :: kpie,kpje,ks - real, intent(in) :: omask(kpie,kpje) + ! Arguments + integer, intent(in) :: kpie + integer, intent(in) :: kpje + integer, intent(in) :: ks + real, intent(in) :: omask(kpie,kpje) real, intent(inout) :: sed_por(kpie,kpje,ks) !local variables @@ -114,7 +117,6 @@ subroutine read_sedpor(kpie,kpje,ks,omask,sed_por) END IF END IF - do k=1,ks do j=1,kpje do i=1,kpie @@ -128,4 +130,5 @@ subroutine read_sedpor(kpie,kpje,ks,omask,sed_por) enddo end subroutine read_sedpor + end module mo_read_sedpor diff --git a/hamocc/restart_hamoccwt.F90 b/hamocc/mo_restart_hamoccwt.F90 similarity index 54% rename from hamocc/restart_hamoccwt.F90 rename to hamocc/mo_restart_hamoccwt.F90 index e9eebf59..cd00e024 100644 --- a/hamocc/restart_hamoccwt.F90 +++ b/hamocc/mo_restart_hamoccwt.F90 @@ -15,22 +15,32 @@ ! 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 restart_hamoccwt(rstfnm_ocn) - ! - ! write restart for HAMOCC - ! - use mod_time, only: date,nstep - use mod_xc, only: idm,jdm,kdm - use mod_tracers, only: ntrbgc,ntr,itrbgc,trc - use mo_intfcblom, only: omask +MODULE MO_restart_hamoccwt implicit none + private + + PUBLIC :: RESTART_HAMOCCWT + +CONTAINS + + SUBROUTINE RESTART_HAMOCCWT(rstfnm_ocn) + ! + ! write restart for HAMOCC + ! + use mod_time, only: date,nstep + use mod_xc, only: idm,jdm,kdm + use mod_tracers, only: ntrbgc,ntr,itrbgc,trc + use mo_intfcblom, only: omask + use mo_aufw_bgc, only: aufw_bgc + + ! Arguments + character(len=*) :: rstfnm_ocn - character(len=*) :: rstfnm_ocn + call aufw_bgc(idm,jdm,kdm,ntr,ntrbgc,itrbgc,trc, & + date%year,date%month,date%day,nstep,omask, & + rstfnm_ocn) - CALL AUFW_BGC(idm,jdm,kdm,ntr,ntrbgc,itrbgc,trc & - & ,date%year,date%month,date%day,nstep,omask & - & ,rstfnm_ocn) + END SUBROUTINE RESTART_HAMOCCWT -end subroutine restart_hamoccwt +END MODULE MO_RESTART_HAMOCCWT diff --git a/hamocc/mo_sedshi.F90 b/hamocc/mo_sedshi.F90 new file mode 100644 index 00000000..09d595df --- /dev/null +++ b/hamocc/mo_sedshi.F90 @@ -0,0 +1,320 @@ +! Copyright (C) 2001 Ernst Maier-Reimer, S. Legutke +! Copyright (C) 2003 I. Kriest +! 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. +! +! 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. +! +! 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_SEDSHI + + implicit none + private + + public :: SEDSHI + +CONTAINS + + SUBROUTINE SEDSHI(kpie,kpje,omask) + + !********************************************************************** + ! + !**** *SEDSHI* - . + ! + ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 + ! + ! Modified + ! -------- + ! S.Legutke, *MPI-MaD, HH* 10.04.01 + ! - rename ssssil(i,j,k)=sedlay(i,j,k,issssil) etc. + ! I. Kriest *MPI-Met, HH*, 27.05.03 + ! - change specific weights for opal, CaCO3, POC + ! - include upward transport + ! Purpose + ! ------- + ! . + ! + ! Method + ! ------- + ! . + ! + !** Interface. + ! ---------- + ! + ! *CALL* *SEDSHI* + ! + ! Externals + ! --------- + ! none. + ! + !********************************************************************** + + use mo_sedmnt, only: burial,calfa,clafa,oplfa,orgfa,porsol,sedlay,seddw,solfu + use mo_param_bgc, only: rcar + use mo_param1_bgc, only: isssc12,issssil,issso12,issster,ks,nsedtra, & + isssc13,isssc14,issso13,issso14 + use mo_control_bgc, only: use_cisonew + + implicit none + + ! Arguments + integer, intent(in) :: kpie + integer, intent(in) :: kpje + real, intent(in) :: omask(kpie,kpje) + + ! Local variables + integer :: i,j,k,l,iv + real :: pdlxp(kpie,kpje),pdlyp(kpie,kpje) + real :: wsed(kpie,kpje), fulsed(kpie,kpje) + real :: sedlo,uebers,seddef,spresent,buried + real :: refill,frac + + ! DOWNWARD SHIFTING + ! shift solid sediment sediment downwards, if layer is full, i.e., if + ! the volume filled by the four constituents poc, opal, caco3, clay + ! is more than porsol*seddw + ! the outflow of layer i is given by sedlay(i)*porsol(i)*seddw(i), it is + ! distributed in the layer below over a volume of porsol(i+1)*seddw(i+1) + + do k=1,ks-1 + + !$OMP PARALLEL DO PRIVATE(i,sedlo) + do j=1,kpje + do i=1,kpie + if(omask(i,j).gt.0.5) then + !ka if(bolay(i,j).gt.0.) then + sedlo = orgfa*rcar*sedlay(i,j,k,issso12) & + +calfa*sedlay(i,j,k,isssc12) & + +oplfa*sedlay(i,j,k,issssil) & + +clafa*sedlay(i,j,k,issster) + ! "full sediment has sedlo=1 + wsed(i,j)=max(0.,(sedlo-1.)/(sedlo+1.e-10)) + endif + enddo !end i-loop + enddo !end j-loop + !$OMP END PARALLEL DO + + ! filling downward (accumulation) + do iv=1,nsedtra + !$OMP PARALLEL DO PRIVATE(i,uebers) + do j=1,kpje + do i=1,kpie + if(omask(i,j).gt.0.5) then + !ka if(bolay(i,j).gt.0.) then + uebers=wsed(i,j)*sedlay(i,j,k,iv) + sedlay(i,j,k ,iv)=sedlay(i,j,k ,iv)-uebers + sedlay(i,j,k+1,iv)=sedlay(i,j,k+1,iv)+uebers & + *(seddw(k)*porsol(i,j,k))/(seddw(k+1)*porsol(i,j,k+1)) + endif + enddo !end i-loop + enddo !end j-loop + !$OMP END PARALLEL DO + enddo !end iv-loop + + enddo !end k-loop + + ! store amount lost from last sediment layer - this is a kind of + ! permanent burial in deep consolidated layer, and this stuff is + ! effectively lost from the whole ocean+sediment(+atmosphere) system. + ! Would have to be supplied by river runoff or simple addition e.g. + ! to surface layers in the long range. Can be supplied again if a + ! sediment column has a deficiency in volume. + + !$OMP PARALLEL DO PRIVATE(i,sedlo) + do j=1,kpje + do i=1,kpie + if(omask(i,j).gt.0.5) then + !ka if(bolay(i,j).gt.0.) then + sedlo = orgfa*rcar*sedlay(i,j,ks,issso12) & + +calfa*sedlay(i,j,ks,isssc12) & + +oplfa*sedlay(i,j,ks,issssil) & + +clafa*sedlay(i,j,ks,issster) + wsed(i,j)=max(0.,(sedlo-1.)/(sedlo+1.e-10)) + endif + enddo !end i-loop + enddo !end j-loop + !$OMP END PARALLEL DO + + do iv=1,nsedtra + !$OMP PARALLEL DO PRIVATE(i,uebers) + do j=1,kpje + do i=1,kpie + if(omask(i,j).gt.0.5) then + !ka if(bolay(i,j).gt.0.) then + uebers=wsed(i,j)*sedlay(i,j,k,iv) + sedlay(i,j,ks ,iv)=sedlay(i,j,ks ,iv)-uebers + burial(i,j,iv)=burial(i,j,iv)+uebers*seddw(k)*porsol(i,j,k) + endif + enddo !end i-loop + enddo !end j-loop + !$OMP END PARALLEL DO + enddo !end iv-loop + + ! now the loading nowhere excceds 1 + + ! digging from below in case of erosion + ! UPWARD SHIFTING + ! shift solid sediment sediment upwards, if total sediment volume is less + ! than required, i.e., if the volume filled by the four constituents + ! poc, opal, caco3, claycik (integrated over total sediment column) + ! is less than porsol*seddw (integrated over total sediment column) + ! first, the last box is filled from below with total required volume; + ! then, successively, the following layers are filled upwards. + ! if there is not enough solid matter to fill the column, add clay. + + !$OMP PARALLEL DO PRIVATE(i) + do j=1,kpje + do i=1,kpie + fulsed(i,j)=0. + enddo !end i-loop + enddo !end j-loop + !$OMP END PARALLEL DO + + ! determine how the total sediment column is filled + do k=1,ks + !$OMP PARALLEL DO PRIVATE(i,sedlo) + do j=1,kpje + do i=1,kpie + if(omask(i,j).gt.0.5) then + !ka if(bolay(i,j).gt.0.) then + sedlo=orgfa*rcar*sedlay(i,j,k,issso12) & + +calfa*sedlay(i,j,k,isssc12) & + +oplfa*sedlay(i,j,k,issssil) & + +clafa*sedlay(i,j,k,issster) + fulsed(i,j)=fulsed(i,j)+porsol(i,j,k)*seddw(k)*sedlo + endif + enddo !end i-loop + enddo !end j-loop + !$OMP END PARALLEL DO + enddo !end k-loop + + ! shift the sediment deficiency from the deepest (burial) + ! layer into layer ks + + !$OMP PARALLEL DO & + !$OMP&PRIVATE(i,seddef,spresent,buried,refill,frac) + do j=1,kpje + do i=1,kpie + if(omask(i,j).gt.0.5) then + !ka if(bolay(i,j).gt.0.) then + + ! deficiency to fully loaded sediment packed in sedlay(i,j,ks) + ! this is the volume required from the buried layer + + seddef=solfu(i,j)-fulsed(i,j) + + ! total volume of solid constituents in buried layer + spresent=orgfa*rcar*burial(i,j,issso12) & + +calfa*burial(i,j,isssc12) & + +oplfa*burial(i,j,issssil) & + +clafa*burial(i,j,issster) + + ! determine whether an additional amount of clay is needed in the burial + ! layer to fill the whole sediment; I assume that there is an infinite + ! supply of clay from below + burial(i,j,issster) = burial(i,j,issster) + MAX(0.,seddef-spresent)/clafa + + ! determine new volume of buried layer + buried=orgfa*rcar*burial(i,j,issso12) & + +calfa*burial(i,j,isssc12) & + +oplfa*burial(i,j,issssil) & + +clafa*burial(i,j,issster) + + ! fill the last active layer + refill=seddef/(buried+1.e-10) + frac = porsol(i,j,ks)*seddw(ks) + + sedlay(i,j,ks,issso12)=sedlay(i,j,ks,issso12) & + +refill*burial(i,j,issso12)/frac + sedlay(i,j,ks,isssc12)=sedlay(i,j,ks,isssc12) & + +refill*burial(i,j,isssc12)/frac + sedlay(i,j,ks,issssil)=sedlay(i,j,ks,issssil) & + +refill*burial(i,j,issssil)/frac + sedlay(i,j,ks,issster)=sedlay(i,j,ks,issster) & + +refill*burial(i,j,issster)/frac + + 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 + endif + + ! account for losses in buried sediment + burial(i,j,issso12) = burial(i,j,issso12) & + - refill*burial(i,j,issso12) + burial(i,j,isssc12) = burial(i,j,isssc12) & + - refill*burial(i,j,isssc12) + burial(i,j,issssil) = burial(i,j,issssil) & + - refill*burial(i,j,issssil) + burial(i,j,issster) = burial(i,j,issster) & + - refill*burial(i,j,issster) + 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) + endif + endif + enddo !end i-loop + enddo !end j-loop + !$OMP END PARALLEL DO + + ! redistribute overload of layer ks + do k=ks,2,-1 + !$OMP PARALLEL DO PRIVATE(i,sedlo) + do j=1,kpje + do i=1,kpie + if(omask(i,j).gt.0.5) then + !ka if(bolay(i,j).gt.0.) then + sedlo=orgfa*rcar*sedlay(i,j,k,issso12) & + +calfa*sedlay(i,j,k,isssc12) & + +oplfa*sedlay(i,j,k,issssil) & + +clafa*sedlay(i,j,k,issster) + wsed(i,j)=max(0.,(sedlo-1.)/(sedlo+1.e-10)) + endif + enddo !end i-loop + enddo !end j-loop + !$OMP END PARALLEL DO + + do iv=1,nsedtra + !$OMP PARALLEL DO PRIVATE(i,uebers,frac) + do j=1,kpje + do i=1,kpie + if(omask(i,j).gt.0.5) then + !ka if(bolay(i,j).gt.0.) then + uebers=sedlay(i,j,k,iv)*wsed(i,j) + frac=porsol(i,j,k)*seddw(k)/(porsol(i,j,k-1)*seddw(k-1)) + sedlay(i,j,k,iv)=sedlay(i,j,k,iv)-uebers + sedlay(i,j,k-1,iv)=sedlay(i,j,k-1,iv)+uebers*frac + endif + enddo !end i-loop + enddo !end j-loop + !$OMP END PARALLEL DO + enddo !end iv-loop + + enddo !end k-loop + + END SUBROUTINE SEDSHI + +END MODULE MO_SEDSHI diff --git a/hamocc/mo_trc_limitc.F90 b/hamocc/mo_trc_limitc.F90 new file mode 100644 index 00000000..1d82e8a2 --- /dev/null +++ b/hamocc/mo_trc_limitc.F90 @@ -0,0 +1,143 @@ +! Copyright (C) 2020 J. Schwinger, M. Bentsen +! +! 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. +! +! 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. +! +! 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_TRC_LIMITC + + implicit none + private + + public :: TRC_LIMITC + +CONTAINS + + SUBROUTINE TRC_LIMITC(nn) + + !*********************************************************************** + ! + !**** *SUBROUTINE trc_limitc* - remove negative tracer values. + ! + ! J. Schwinger *GFI, UiB initial version, 2014-06-17 + ! - + ! + ! Modified + ! -------- + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - fixed a bug related to the 2 time-level scheme + ! + ! + ! + ! Purpose + ! ------- + ! Remove negative tracer values in the first layer in a mass + ! conservative fashion (i.e. the mass deficit removed is + ! transfered to non-negative points by a multiplicative + ! correction). This is done since the virtual tracer fluxes + ! (applied in mxlayr.F directly before HAMOCC is called) can + ! cause negative tracer values in regions with low concentration + ! and strong precipitation. + ! + !*********************************************************************** + + use mod_xc, only: ii,jj,ips,ifp,isp,ilp,xcsum + use mod_grid, only: scp2 + use mod_state, only: dp + use mod_tracers, only: ntrbgc, itrbgc, trc + use mod_utility, only: util1 + + ! Arguments + integer :: nn + + ! Local variables + integer :: i,j,l,nt,kn + real :: trbudo(ntrbgc),trbudn,q + + ! --- ------------------------------------------------------------------ + ! --- - compute tracer budgets before removing negative values + ! --- ------------------------------------------------------------------ + + kn=1+nn + + do nt=1,ntrbgc + + util1(:,:)=0. + + !$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)) + util1(i,j) = util1(i,j)+trc(i,j,kn,itrbgc+nt-1)*dp(i,j,kn)*scp2(i,j) + enddo + enddo + enddo + !$OMP END PARALLEL DO + + call xcsum(trbudo(nt),util1,ips) + + enddo + + ! --- ------------------------------------------------------------------ + ! --- - remove negative tracer values in the surface layer + ! --- ------------------------------------------------------------------ + + !$OMP PARALLEL DO PRIVATE(j,l,i) + do nt=itrbgc,itrbgc+ntrbgc-1 + do j=1,jj + do l=1,isp(j) + do i=max(1,ifp(j,l)),min(ii,ilp(j,l)) + trc(i,j,kn,nt) = max(trc(i,j,kn,nt),0.0) + enddo + enddo + enddo + enddo + !$OMP END PARALLEL DO + + ! --- ------------------------------------------------------------------ + ! --- - recalculate and correct tracer budgets + ! --- ------------------------------------------------------------------ + + do nt=1,ntrbgc + + util1(:,:)=0. + + !$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)) + util1(i,j) = util1(i,j)+trc(i,j,kn,itrbgc+nt-1)*dp(i,j,kn)*scp2(i,j) + enddo + enddo + enddo + !$OMP END PARALLEL DO + + call xcsum(trbudn,util1,ips) + q = trbudo(nt)/max(1.e-14,trbudn) + + !$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)) + trc(i,j,kn,itrbgc+nt-1) = trc(i,j,kn,itrbgc+nt-1)*q + enddo + enddo + enddo + !$OMP END PARALLEL DO + + enddo + + end subroutine trc_limitc + +END MODULE MO_trc_limitc diff --git a/hamocc/mo_write_netcdf_var.F90 b/hamocc/mo_write_netcdf_var.F90 new file mode 100644 index 00000000..07c90cb2 --- /dev/null +++ b/hamocc/mo_write_netcdf_var.F90 @@ -0,0 +1,212 @@ +! Copyright (C) 2020 I. Bethke, M. Bentsen +! +! 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. +! +! 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. +! +! 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_WRITE_NETCDF_VAR + + implicit none + private + + public :: WRITE_NETCDF_VAR + +CONTAINS + + SUBROUTINE WRITE_NETCDF_VAR(ncid,desc,arr,klev,time) + !************************************************************************** + ! + ! Gathers a global variable from all PEs and writes it to a NETCDF file + ! + ! The NETCDF File is only accessed by mnproc=1 + ! + !************************************************************************** + use netcdf, only: nf90_noerr,nf90_inq_varid,nf90_strerror,nf90_put_var + use mod_xc, only: itdm,jtdm,jdm,lp,mnproc,nbdy,idm,xchalt,xcaget + use mod_dia, only: iotype +#ifdef PNETCDF + use mod_xc, only: i0,ii,jj,j0,mproc,mpe_1,nproc,xcgetrow +#endif +#ifdef PNETCDF +# include +# include +#endif + + ! Arguments + integer, intent(in) :: ncid + character(len=*), intent(in) :: desc + integer, intent(in) :: klev + integer, intent(in) :: time + real, intent(out) :: arr(idm,jdm,klev) + + ! Local variables + integer :: k,i,j + integer :: ndims + real :: arr_g(itdm,jtdm) + integer :: ncstat + integer :: ncvarid + integer, allocatable :: start(:),count(:) + real, allocatable :: arr_g1(:,:,:) + real, allocatable :: arr_l(:,:,:) +#ifdef PNETCDF + integer (kind=MPI_OFFSET_KIND), allocatable :: istart(:),icount(:) +#endif + + ! Write NETCDF data + + if (klev.eq.1.and.time.eq.0) then + ndims=2 + elseif (klev.eq.1.or.time.eq.0) then + ndims=3 + else + ndims=4 + endif + IF(IOTYPE==0) THEN + + allocate(start(ndims)) + allocate(count(ndims)) + allocate(arr_l(1-nbdy:idm+nbdy,1-nbdy:jdm+nbdy,1)) + arr_l=0.0 + start(1)=1 + count(1)=itdm + start(2)=1 + count(2)=jtdm + if (klev.gt.1.or.time.gt.0) then + if (klev.gt.1.and.time.gt.0) then + start(3)=1 + count(3)=1 + start(4)=time + count(4)=1 + else if (klev.gt.1.and.time.eq.0) then + start(3)=1 + count(3)=1 + else + start(3)=time + count(3)=1 + endif + endif + + do k=1,klev + do j=1,jdm + do i=1,idm + arr_l(i,j,1)=arr(i,j,k) + enddo + enddo + call xcaget(arr_g,arr_l,1) + if (mnproc.eq.1) then + if (k.gt.1) then + start(3)=k + count(3)=1 + endif + + ncstat=nf90_inq_varid(ncid,desc,ncvarid) + if (ncstat.ne.nf90_noerr) then + write(lp,'(4a)') 'nf90_inq_varid: ',trim(desc),': ',nf90_strerror(ncstat) + call xchalt('(write_netcdf_var)') + stop '(write_netcdf_var)' + endif + + ncstat=nf90_put_var(ncid,ncvarid,arr_g,start,count) + if (ncstat.ne.nf90_noerr) then + write(lp,'(4a)') 'nf90_put_var: ',trim(desc),': ',nf90_strerror(ncstat) + call xchalt('(write_netcdf_var)') + stop '(write_netcdf_var)' + endif + + ! ncstat=nf90_sync(ncid) + ! if (ncstat.ne.nf90_noerr) then + ! write(lp,'(4a)') 'nf90_sync: ',trim(desc),': ',nf90_strerror(ncstat) + ! call xchalt('(write_netcdf_var)') + ! stop '(write_netcdf_var)' + ! endif + endif + enddo + deallocate(start,count) + + ELSE IF(IOTYPE==1) THEN + +#ifdef PNETCDF + allocate(istart(ndims)) + allocate(icount(ndims)) + allocate(arr_l(ii,jj,klev)) + + arr_l=0.0 + if (klev.gt.1.or.time.gt.0) then + if (klev.gt.1.and.time.gt.0) then + istart(3)=1 + icount(3)=klev + istart(4)=time + icount(4)=1 + else if (klev.gt.1.and.time.eq.0) then + istart(3)=1 + icount(3)=klev + else + istart(3)=time + icount(3)=1 + endif + endif + + istart(1)=1 + istart(2)=j0+1 + + if(mproc .eq. mpe_1(nproc) ) then + icount(1)=itdm + icount(2)=jj + else + do i=1,ndims + icount(i)=0 + enddo + endif + + do k=1,klev + do j=1,jj + do i=1,ii + arr_l(i,j,k)=arr(i,j,k) + enddo + enddo + enddo + + allocate(arr_g1(itdm,jj,klev)) + arr_g1=0.0 + call xcgetrow(arr_g1, arr_l, klev) + + ncstat=nfmpi_inq_varid(ncid,desc,ncvarid) + if (ncstat.ne.nf_noerr) then + write(lp,'(4a)') 'nfmpi_inq_varid: ',trim(desc),': ',nfmpi_strerror(ncstat) + call xchalt('(write_pnetcdf_var)') + stop '(write_pnetcdf_var)' + endif + + ncstat=nfmpi_put_vara_double_all(ncid,ncvarid,istart,icount,arr_g1) + if (ncstat.ne.nf_noerr) then + write(lp,'(4a)') 'nfmpi_put_var: ',trim(desc),': ',nfmpi_strerror(ncstat) + call xchalt('(write_pnetcdf_var)') + stop '(write_pnetcdf_var)' + endif + + ! ncstat=nfmpi_sync(ncid) + ! if (ncstat.ne.nf_noerr) then + ! write(lp,'(4a)') 'nfmpi_sync: ',trim(desc),': ',nfmpi_strerror(ncstat) + ! call xchalt('(write_pnetcdf_var)') + ! stop '(write_pnetcdf_var)' + ! endif + + deallocate(istart,icount,arr_g1) +#endif + ENDIF + + END SUBROUTINE WRITE_NETCDF_VAR + +END MODULE MO_WRITE_NETCDF_VAR diff --git a/hamocc/ncout_hamocc.F90 b/hamocc/ncout_hamocc.F90 deleted file mode 100644 index e459eff2..00000000 --- a/hamocc/ncout_hamocc.F90 +++ /dev/null @@ -1,1402 +0,0 @@ -! Copyright (C) 2020 I Bethke, J. Tjiputra, J. Schwinger, A. Moree, M. -! Bentsen -! -! 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. -! -! 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. -! -! 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 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_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_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, & - 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_param_bgc, only: c14fac - - implicit none - - integer :: i,j,k,l,nt - integer :: ny,nm,nd,dayfrac,cmpflg,iogrp - integer, save :: irec(nbgcmax) - logical, save :: append2file(nbgcmax) - character(len=256), save :: fname(nbgcmax) - character(len=20) :: startdate - character(len=30) :: timeunits - real :: datenum,rnacc - - data append2file /nbgcmax*.false./ - - ! --- set time information - timeunits=' ' - startdate=' ' - write(timeunits,'(a11,i4.4,a1,i2.2,a1,i2.2,a6)') & - & 'days since ',min(1800,date0%year),'-',1,'-',1,' 00:00' - write(startdate,'(i4.4,a1,i2.2,a1,i2.2,a6)') & - & date0%year,'-',date0%month,'-',date0%day,' 00:00' - datenum=time-time0-0.5*diagfq_bgc(iogrp)/nstep_in_day - - ! --- get file name - if (.not.append2file(iogrp)) then - call diafnm(GLB_FNAMETAG(iogrp), & - & filefq_bgc(iogrp)/real(nstep_in_day), & - & filemon_bgc(iogrp),fileann_bgc(iogrp),fname(iogrp)) - append2file(iogrp)=.true. - irec(iogrp)=1 - else - irec(iogrp)=irec(iogrp)+1 - endif - if (((fileann_bgc(iogrp).and.nday_of_year.eq.1.or. & - & filemon_bgc(iogrp).and.date%day.eq.1).and. & - & mod(nstep,nstep_in_day).eq.0).or. & - & .not.(fileann_bgc(iogrp).or.filemon_bgc(iogrp)).and. & - & mod(nstep+.5,filefq_bgc(iogrp)).lt.1.) then - append2file(iogrp)=.false. - endif - - ! --- prepare output fields - if (mnproc.eq.1) then - write (lp,'(a,f6.2,a)') ' ncwrt_bgc: fields averaged over ', & - & real(nacc_bgc(iogrp)),' steps' - write(lp,*) 'irec(iogrp)',irec(iogrp) - endif - rnacc=1./real(nacc_bgc(iogrp)) - cmpflg=GLB_COMPFLAG(iogrp) - - ! --- create output file - if (GLB_NCFORMAT(iogrp).eq.1) then - call ncfopn(fname(iogrp),'w','6',irec(iogrp),iotype) - elseif (GLB_NCFORMAT(iogrp).eq.2) then - call ncfopn(fname(iogrp),'w','h',irec(iogrp),iotype) - else - call ncfopn(fname(iogrp),'w','c',irec(iogrp),iotype) - endif - - ! --- define spatial and time dimensions - if (cmpflg.ne.0) then - call ncdimc('pcomp',ip,0) - else - call ncdims('x',itdm) - call ncdims('y',jtdm) - endif - call ncdims('sigma',kdm) - call ncdims('depth',ddm) - call ncdims('ks',ks) - call ncdims('bounds',2) - call ncdims('time',0) - call hamoccvardef(iogrp,timeunits,calendar,cmpflg) - call nctime(datenum,calendar,timeunits,startdate) - - ! --- write auxillary dimension information - call ncwrt1('sigma','sigma',sigmar1) - call ncwrt1('depth','depth',depthslev) - call ncwrt1('depth_bnds','bounds depth',depthslev_bnds) - - ! --- finalize accumulation - call finlyr(jphyto(iogrp),jdp(iogrp)) - call finlyr(jgrazer(iogrp),jdp(iogrp)) - call finlyr(jdoc(iogrp),jdp(iogrp)) - call finlyr(jphosy(iogrp),jdp(iogrp)) - call finlyr(jphosph(iogrp),jdp(iogrp)) - call finlyr(joxygen(iogrp),jdp(iogrp)) - call finlyr(jiron(iogrp),jdp(iogrp)) - call finlyr(jano3(iogrp),jdp(iogrp)) - call finlyr(jalkali(iogrp),jdp(iogrp)) - call finlyr(jsilica(iogrp),jdp(iogrp)) - call finlyr(jdic(iogrp),jdp(iogrp)) - call finlyr(jpoc(iogrp),jdp(iogrp)) - call finlyr(jcalc(iogrp),jdp(iogrp)) - call finlyr(jopal(iogrp),jdp(iogrp)) - call finlyr(jco3(iogrp),jdp(iogrp)) - call finlyr(jph(iogrp),jdp(iogrp)) - call finlyr(jomegaa(iogrp),jdp(iogrp)) - call finlyr(jomegac(iogrp),jdp(iogrp)) - call finlyr(jn2o(iogrp),jdp(iogrp)) - call finlyr(jprefo2(iogrp),jdp(iogrp)) - call finlyr(jo2sat(iogrp),jdp(iogrp)) - call finlyr(jprefpo4(iogrp),jdp(iogrp)) - call finlyr(jprefalk(iogrp),jdp(iogrp)) - call finlyr(jprefdic(iogrp),jdp(iogrp)) - call finlyr(jdicsat(iogrp),jdp(iogrp)) - 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)) - endif - 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)) - endif - if (use_CFC) then - call finlyr(jcfc11(iogrp),jdp(iogrp)) - call finlyr(jcfc12(iogrp),jdp(iogrp)) - call finlyr(jsf6(iogrp),jdp(iogrp)) - endif - 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)) - endif - if (use_BROMO) then - call finlyr(jbromo(iogrp),jdp(iogrp)) - endif - - ! --- Mask sea floor in mass fluxes - call msksrf(jcarflx0100(iogrp),k0100) - call msksrf(jcarflx0500(iogrp),k0500) - call msksrf(jcarflx1000(iogrp),k1000) - call msksrf(jcarflx2000(iogrp),k2000) - call msksrf(jcarflx4000(iogrp),k4000) - call msksrf(jbsiflx0100(iogrp),k0100) - call msksrf(jbsiflx0500(iogrp),k0500) - call msksrf(jbsiflx1000(iogrp),k1000) - call msksrf(jbsiflx2000(iogrp),k2000) - call msksrf(jbsiflx4000(iogrp),k4000) - call msksrf(jcalflx0100(iogrp),k0100) - call msksrf(jcalflx0500(iogrp),k0500) - call msksrf(jcalflx1000(iogrp),k1000) - call msksrf(jcalflx2000(iogrp),k2000) - call msksrf(jcalflx4000(iogrp),k4000) - - ! --- Mask sea floor in level data - call msklvl(jlvlphyto(iogrp),depths) - call msklvl(jlvlgrazer(iogrp),depths) - call msklvl(jlvldoc(iogrp),depths) - call msklvl(jlvlphosy(iogrp),depths) - call msklvl(jlvlphosph(iogrp),depths) - call msklvl(jlvloxygen(iogrp),depths) - call msklvl(jlvliron(iogrp),depths) - call msklvl(jlvlano3(iogrp),depths) - call msklvl(jlvlalkali(iogrp),depths) - call msklvl(jlvlsilica(iogrp),depths) - call msklvl(jlvldic(iogrp),depths) - call msklvl(jlvlpoc(iogrp),depths) - call msklvl(jlvlcalc(iogrp),depths) - call msklvl(jlvlopal(iogrp),depths) - call msklvl(jlvlco3(iogrp),depths) - call msklvl(jlvlph(iogrp),depths) - call msklvl(jlvlomegaa(iogrp),depths) - call msklvl(jlvlomegac(iogrp),depths) - call msklvl(jlvln2o(iogrp),depths) - call msklvl(jlvlprefo2(iogrp),depths) - call msklvl(jlvlo2sat(iogrp),depths) - call msklvl(jlvlprefpo4(iogrp),depths) - call msklvl(jlvlprefalk(iogrp),depths) - call msklvl(jlvlprefdic(iogrp),depths) - call msklvl(jlvldicsat(iogrp),depths) - 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) - endif - 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) - endif - if (use_CFC) then - call msklvl(jlvlcfc11(iogrp),depths) - call msklvl(jlvlcfc12(iogrp),depths) - call msklvl(jlvlsf6(iogrp),depths) - endif - 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) - endif - if (use_BROMO) then - call msklvl(jlvlbromo(iogrp),depths) - endif - - ! --- 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.) - 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.) - endif - - ! --- Store 2d fields - call wrtsrf(jkwco2(iogrp), SRF_KWCO2(iogrp), rnacc, 0.,cmpflg,'kwco2') - call wrtsrf(jkwco2khm(iogrp), SRF_KWCO2KHM(iogrp), rnacc, 0.,cmpflg,'kwco2khm') - call wrtsrf(jco2kh(iogrp), SRF_CO2KH(iogrp), rnacc, 0.,cmpflg,'co2kh') - call wrtsrf(jco2khm(iogrp), SRF_CO2KHM(iogrp), rnacc, 0.,cmpflg,'co2khm') - call wrtsrf(jpco2(iogrp), SRF_PCO2(iogrp), rnacc, 0.,cmpflg,'pco2') - call wrtsrf(jpco2m(iogrp), SRF_PCO2M(iogrp), rnacc, 0.,cmpflg,'pco2m') - call wrtsrf(jdmsflux(iogrp), SRF_DMSFLUX(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'dmsflux') - call wrtsrf(jco2fxd(iogrp), SRF_CO2FXD(iogrp), rnacc*12./dtbgc,0.,cmpflg,'co2fxd') - call wrtsrf(jco2fxu(iogrp), SRF_CO2FXU(iogrp), rnacc*12./dtbgc,0.,cmpflg,'co2fxu') - call wrtsrf(joxflux(iogrp), SRF_OXFLUX(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'fgo2') - call wrtsrf(jniflux(iogrp), SRF_NIFLUX(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'fgn2') - call wrtsrf(jn2ofx(iogrp), SRF_N2OFX(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'n2oflux') - call wrtsrf(jdms(iogrp), SRF_DMS(iogrp), rnacc, 0.,cmpflg,'dms') - call wrtsrf(jdmsprod(iogrp), SRF_DMSPROD(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'dmsprod') - call wrtsrf(jdms_bac(iogrp), SRF_DMS_BAC(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'dms_bac') - call wrtsrf(jdms_uv(iogrp), SRF_DMS_UV(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'dms_uv') - call wrtsrf(jexport(iogrp), SRF_EXPORT(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'epc100') - call wrtsrf(jexposi(iogrp), SRF_EXPOSI(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'epsi100') - call wrtsrf(jexpoca(iogrp), SRF_EXPOCA(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'epcalc100') - call wrtsrf(jsrfdic(iogrp), SRF_DIC(iogrp), rnacc*1e3, 0.,cmpflg,'srfdissic') - call wrtsrf(jsrfalkali(iogrp), SRF_ALKALI(iogrp), rnacc*1e3, 0.,cmpflg,'srftalk') - call wrtsrf(jsrfphosph(iogrp), SRF_PHOSPH(iogrp), rnacc*1e3, 0.,cmpflg,'srfpo4') - call wrtsrf(jsrfoxygen(iogrp), SRF_OXYGEN(iogrp), rnacc*1e3, 0.,cmpflg,'srfo2') - call wrtsrf(jsrfano3(iogrp), SRF_ANO3(iogrp), rnacc*1e3, 0.,cmpflg,'srfno3') - call wrtsrf(jsrfsilica(iogrp), SRF_SILICA(iogrp), rnacc*1e3, 0.,cmpflg,'srfsi') - call wrtsrf(jsrfiron(iogrp), SRF_IRON(iogrp), rnacc*1e3, 0.,cmpflg,'srfdfe') - call wrtsrf(jsrfphyto(iogrp), SRF_PHYTO(iogrp), rnacc*1e3, 0.,cmpflg,'srfphyc') - call wrtsrf(jsrfph(iogrp), SRF_PH(iogrp), -1., 0.,cmpflg,'srfph') - call wrtsrf(jintphosy(iogrp), INT_PHOSY(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'ppint') - call wrtsrf(jintnfix(iogrp), INT_NFIX(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'nfixint') - call wrtsrf(jintdnit(iogrp), INT_DNIT(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'dnitint') - call wrtsrf(jndepfx(iogrp), FLX_NDEP(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'ndep') - call wrtsrf(joalkfx(iogrp), FLX_OALK(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'oalkfx') - call wrtsrf(jcarflx0100(iogrp), FLX_CAR0100(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'carflx0100') - call wrtsrf(jcarflx0500(iogrp), FLX_CAR0500(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'carflx0500') - call wrtsrf(jcarflx1000(iogrp), FLX_CAR1000(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'carflx1000') - call wrtsrf(jcarflx2000(iogrp), FLX_CAR2000(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'carflx2000') - call wrtsrf(jcarflx4000(iogrp), FLX_CAR4000(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'carflx4000') - call wrtsrf(jcarflx_bot(iogrp), FLX_CAR_BOT(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'carflx_bot') - call wrtsrf(jbsiflx0100(iogrp), FLX_BSI0100(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'bsiflx0100') - call wrtsrf(jbsiflx0500(iogrp), FLX_BSI0500(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'bsiflx0500') - call wrtsrf(jbsiflx1000(iogrp), FLX_BSI1000(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'bsiflx1000') - call wrtsrf(jbsiflx2000(iogrp), FLX_BSI2000(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'bsiflx2000') - call wrtsrf(jbsiflx4000(iogrp), FLX_BSI4000(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'bsiflx4000') - call wrtsrf(jbsiflx_bot(iogrp), FLX_BSI_BOT(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'bsiflx_bot') - call wrtsrf(jcalflx0100(iogrp), FLX_CAL0100(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'calflx0100') - call wrtsrf(jcalflx0500(iogrp), FLX_CAL0500(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'calflx0500') - call wrtsrf(jcalflx1000(iogrp), FLX_CAL1000(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'calflx1000') - 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') - 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') - endif - 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') - endif - 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') - endif - 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') - endif - 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') - endif - call wrtsrf(jatmco2(iogrp), SRF_ATMCO2(iogrp), rnacc, 0.,cmpflg,'atmco2') - 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') - endif - 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') - endif - - ! --- Store 3d layer fields - call wrtlyr(jdp(iogrp), LYR_DP(iogrp), rnacc, 0.,cmpflg,'pddpo') - call wrtlyr(jdic(iogrp), LYR_DIC(iogrp), 1e3, 0.,cmpflg,'dissic') - call wrtlyr(jalkali(iogrp), LYR_ALKALI(iogrp), 1e3, 0.,cmpflg,'talk') - call wrtlyr(jphosph(iogrp), LYR_PHOSPH(iogrp), 1e3, 0.,cmpflg,'po4') - call wrtlyr(joxygen(iogrp), LYR_OXYGEN(iogrp), 1e3, 0.,cmpflg,'o2') - call wrtlyr(jano3(iogrp), LYR_ANO3(iogrp), 1e3, 0.,cmpflg,'no3') - call wrtlyr(jsilica(iogrp), LYR_SILICA(iogrp), 1e3, 0.,cmpflg,'si') - call wrtlyr(jdoc(iogrp), LYR_DOC(iogrp), 1e3, 0.,cmpflg,'dissoc') - call wrtlyr(jphyto(iogrp), LYR_PHYTO(iogrp), 1e3, 0.,cmpflg,'phyc') - call wrtlyr(jgrazer(iogrp), LYR_GRAZER(iogrp), 1e3, 0.,cmpflg,'zooc') - call wrtlyr(jpoc(iogrp), LYR_POC(iogrp), 1e3, 0.,cmpflg,'detoc') - call wrtlyr(jcalc(iogrp), LYR_CALC(iogrp), 1e3, 0.,cmpflg,'calc') - call wrtlyr(jopal(iogrp), LYR_OPAL(iogrp), 1e3, 0.,cmpflg,'opal') - call wrtlyr(jiron(iogrp), LYR_IRON(iogrp), 1e3, 0.,cmpflg,'dfe') - call wrtlyr(jphosy(iogrp), LYR_PHOSY(iogrp), 1e3/dtbgc, 0.,cmpflg,'pp') - call wrtlyr(jco3(iogrp), LYR_CO3(iogrp), 1e3, 0.,cmpflg,'co3') - call wrtlyr(jph(iogrp), LYR_PH(iogrp), -1., 0.,cmpflg,'ph') - call wrtlyr(jomegaa(iogrp), LYR_OMEGAA(iogrp), 1., 0.,cmpflg,'omegaa') - call wrtlyr(jomegac(iogrp), LYR_OMEGAC(iogrp), 1., 0.,cmpflg,'omegac') - call wrtlyr(jn2o(iogrp), LYR_N2O(iogrp), 1e3, 0.,cmpflg,'n2o') - call wrtlyr(jprefo2(iogrp), LYR_PREFO2(iogrp), 1e3, 0.,cmpflg,'p_o2') - call wrtlyr(jo2sat(iogrp), LYR_O2SAT(iogrp), 1e3, 0.,cmpflg,'satoxy') - call wrtlyr(jprefpo4(iogrp), LYR_PREFPO4(iogrp), 1e3, 0.,cmpflg,'p_po4') - 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') - 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') - endif - 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') - endif - 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') - endif - 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') - endif - if (use_BROMO) then - call wrtlyr(jbromo(iogrp), LYR_BROMO(iogrp), 1e3, 0.,cmpflg,'bromo') - endif - - ! --- Store 3d level fields - call wrtlvl(jlvldic(iogrp), LVL_DIC(iogrp), rnacc*1e3, 0.,cmpflg,'dissiclvl') - call wrtlvl(jlvlalkali(iogrp), LVL_ALKALI(iogrp), rnacc*1e3, 0.,cmpflg,'talklvl') - call wrtlvl(jlvlphosph(iogrp), LVL_PHOSPH(iogrp), rnacc*1e3, 0.,cmpflg,'po4lvl') - call wrtlvl(jlvloxygen(iogrp), LVL_OXYGEN(iogrp), rnacc*1e3, 0.,cmpflg,'o2lvl') - call wrtlvl(jlvlano3(iogrp), LVL_ANO3(iogrp), rnacc*1e3, 0.,cmpflg,'no3lvl') - call wrtlvl(jlvlsilica(iogrp), LVL_SILICA(iogrp), rnacc*1e3, 0.,cmpflg,'silvl') - call wrtlvl(jlvldoc(iogrp), LVL_DOC(iogrp), rnacc*1e3, 0.,cmpflg,'dissoclvl') - call wrtlvl(jlvlphyto(iogrp), LVL_PHYTO(iogrp), rnacc*1e3, 0.,cmpflg,'phyclvl') - call wrtlvl(jlvlgrazer(iogrp), LVL_GRAZER(iogrp), rnacc*1e3, 0.,cmpflg,'zooclvl') - call wrtlvl(jlvlpoc(iogrp), LVL_POC(iogrp), rnacc*1e3, 0.,cmpflg,'detoclvl') - call wrtlvl(jlvlcalc(iogrp), LVL_CALC(iogrp), rnacc*1e3, 0.,cmpflg,'calclvl') - call wrtlvl(jlvlopal(iogrp), LVL_OPAL(iogrp), rnacc*1e3, 0.,cmpflg,'opallvl') - call wrtlvl(jlvliron(iogrp), LVL_IRON(iogrp), rnacc*1e3, 0.,cmpflg,'dfelvl') - call wrtlvl(jlvlphosy(iogrp), LVL_PHOSY(iogrp), rnacc*1e3/dtbgc,0.,cmpflg,'pplvl') - call wrtlvl(jlvlco3(iogrp), LVL_CO3(iogrp), rnacc*1e3, 0.,cmpflg,'co3lvl') - call wrtlvl(jlvlph(iogrp), LVL_PH(iogrp), -1., 0.,cmpflg,'phlvl') - call wrtlvl(jlvlomegaa(iogrp), LVL_OMEGAA(iogrp), rnacc, 0.,cmpflg,'omegaalvl') - call wrtlvl(jlvlomegac(iogrp), LVL_OMEGAC(iogrp), rnacc, 0.,cmpflg,'omegaclvl') - call wrtlvl(jlvln2o(iogrp), LVL_N2O(iogrp), rnacc*1e3, 0.,cmpflg,'n2olvl') - call wrtlvl(jlvlprefo2(iogrp), LVL_PREFO2(iogrp), rnacc*1e3, 0.,cmpflg,'p_o2lvl') - call wrtlvl(jlvlo2sat(iogrp), LVL_O2SAT(iogrp), rnacc*1e3, 0.,cmpflg,'satoxylvl') - call wrtlvl(jlvlprefpo4(iogrp), LVL_PREFPO4(iogrp), rnacc*1e3, 0.,cmpflg,'p_po4lvl') - 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') - 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') - endif - 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') - endif - 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') - endif - 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') - endif - if (use_BROMO) then - call wrtlvl(jlvlbromo(iogrp), LVL_BROMO(iogrp), rnacc*1e3, 0.,cmpflg,'bromolvl') - endif - - ! --- Store sediment fields - 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 - - ! --- close netcdf file - call ncfcls - - ! --- Initialise fields - call inisrf(jkwco2(iogrp),0.) - call inisrf(jkwco2khm(iogrp),0.) - call inisrf(jco2kh(iogrp),0.) - call inisrf(jco2khm(iogrp),0.) - call inisrf(jpco2(iogrp),0.) - call inisrf(jpco2m(iogrp),0.) - call inisrf(jdmsflux(iogrp),0.) - call inisrf(jco2fxd(iogrp),0.) - call inisrf(jco2fxu(iogrp),0.) - call inisrf(joxflux(iogrp),0.) - call inisrf(jniflux(iogrp),0.) - call inisrf(jn2ofx(iogrp),0.) - call inisrf(jdms(iogrp),0.) - call inisrf(jdmsprod(iogrp),0.) - call inisrf(jdms_bac(iogrp),0.) - call inisrf(jdms_uv(iogrp),0.) - call inisrf(jexport(iogrp),0.) - call inisrf(jexposi(iogrp),0.) - call inisrf(jexpoca(iogrp),0.) - call inisrf(jsrfdic(iogrp),0.) - call inisrf(jsrfalkali(iogrp),0.) - call inisrf(jsrfphosph(iogrp),0.) - call inisrf(jsrfoxygen(iogrp),0.) - call inisrf(jsrfano3(iogrp),0.) - call inisrf(jsrfsilica(iogrp),0.) - call inisrf(jsrfiron(iogrp),0.) - call inisrf(jsrfphyto(iogrp),0.) - call inisrf(jsrfph(iogrp),0.) - call inisrf(jintphosy(iogrp),0.) - call inisrf(jintnfix(iogrp),0.) - call inisrf(jintdnit(iogrp),0.) - call inisrf(jndepfx(iogrp),0.) - call inisrf(joalkfx(iogrp),0.) - call inisrf(jcarflx0100(iogrp),0.) - call inisrf(jcarflx0500(iogrp),0.) - call inisrf(jcarflx1000(iogrp),0.) - call inisrf(jcarflx2000(iogrp),0.) - call inisrf(jcarflx4000(iogrp),0.) - call inisrf(jcarflx_bot(iogrp),0.) - call inisrf(jbsiflx0100(iogrp),0.) - call inisrf(jbsiflx0500(iogrp),0.) - call inisrf(jbsiflx1000(iogrp),0.) - call inisrf(jbsiflx2000(iogrp),0.) - call inisrf(jbsiflx4000(iogrp),0.) - call inisrf(jbsiflx_bot(iogrp),0.) - call inisrf(jcalflx0100(iogrp),0.) - call inisrf(jcalflx0500(iogrp),0.) - call inisrf(jcalflx1000(iogrp),0.) - call inisrf(jcalflx2000(iogrp),0.) - call inisrf(jcalflx4000(iogrp),0.) - call inisrf(jcalflx_bot(iogrp),0.) - 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.) - endif - if (use_cisonew) then - call inisrf(jco213fxd(iogrp),0.) - call inisrf(jco213fxu(iogrp),0.) - call inisrf(jco214fxd(iogrp),0.) - call inisrf(jco214fxu(iogrp),0.) - endif - if (use_CFC) then - call inisrf(jcfc11fx(iogrp),0.) - call inisrf(jcfc12fx(iogrp),0.) - call inisrf(jsf6fx(iogrp),0.) - endif - 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.) - endif - 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.) - endif - - - call inisrf(jatmco2(iogrp),0.) - if (use_BOXATM) then - call inisrf(jatmo2(iogrp),0.) - call inisrf(jatmn2(iogrp),0.) - endif - if (use_cisonew) then - call inisrf(jatmc13(iogrp),0.) - call inisrf(jatmc14(iogrp),0.) - endif - - call inilyr(jdp(iogrp),0.) - call inilyr(jdic(iogrp),0.) - call inilyr(jalkali(iogrp),0.) - call inilyr(jphosy(iogrp),0.) - call inilyr(jphosph(iogrp),0.) - call inilyr(joxygen(iogrp),0.) - call inilyr(jano3(iogrp),0.) - call inilyr(jsilica(iogrp),0.) - call inilyr(jdoc(iogrp),0.) - call inilyr(jphyto(iogrp),0.) - call inilyr(jgrazer(iogrp),0.) - call inilyr(jpoc(iogrp),0.) - call inilyr(jcalc(iogrp),0.) - call inilyr(jopal(iogrp),0.) - call inilyr(jiron(iogrp),0.) - call inilyr(jco3(iogrp),0.) - call inilyr(jph(iogrp),0.) - call inilyr(jomegaa(iogrp),0.) - call inilyr(jomegac(iogrp),0.) - call inilyr(jn2o(iogrp),0.) - call inilyr(jprefo2(iogrp),0.) - call inilyr(jo2sat(iogrp),0.) - call inilyr(jprefpo4(iogrp),0.) - call inilyr(jprefalk(iogrp),0.) - call inilyr(jprefdic(iogrp),0.) - call inilyr(jdicsat(iogrp),0.) - 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.) - endif - 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.) - endif - if (use_CFC) then - call inilyr(jcfc11(iogrp),0.) - call inilyr(jcfc12(iogrp),0.) - call inilyr(jsf6(iogrp),0.) - endif - 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.) - endif - if (use_BROMO) then - call inilyr(jbromo(iogrp),0.) - endif - - call inilvl(jlvldic(iogrp),0.) - call inilvl(jlvlalkali(iogrp),0.) - call inilvl(jlvlphosy(iogrp),0.) - call inilvl(jlvlphosph(iogrp),0.) - call inilvl(jlvloxygen(iogrp),0.) - call inilvl(jlvlano3(iogrp),0.) - call inilvl(jlvlsilica(iogrp),0.) - call inilvl(jlvldoc(iogrp),0.) - call inilvl(jlvlphyto(iogrp),0.) - call inilvl(jlvlgrazer(iogrp),0.) - call inilvl(jlvlpoc(iogrp),0.) - call inilvl(jlvlcalc(iogrp),0.) - call inilvl(jlvlopal(iogrp),0.) - call inilvl(jlvliron(iogrp),0.) - call inilvl(jlvlco3(iogrp),0.) - call inilvl(jlvlph(iogrp),0.) - call inilvl(jlvlomegaa(iogrp),0.) - call inilvl(jlvlomegac(iogrp),0.) - call inilvl(jlvln2o(iogrp),0.) - call inilvl(jlvlprefo2(iogrp),0.) - call inilvl(jlvlo2sat(iogrp),0.) - call inilvl(jlvlprefpo4(iogrp),0.) - call inilvl(jlvlprefalk(iogrp),0.) - call inilvl(jlvlprefdic(iogrp),0.) - call inilvl(jlvldicsat(iogrp),0.) - 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.) - endif - 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.) - endif - if (use_CFC) then - call inilvl(jlvlcfc11(iogrp),0.) - call inilvl(jlvlcfc12(iogrp),0.) - call inilvl(jlvlsf6(iogrp),0.) - endif - 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.) - endif - if (use_BROMO) then - call inilvl(jlvlbromo(iogrp),0.) - endif - - 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 - - nacc_bgc(iogrp)=0 - -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, & - 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 - - implicit none - - integer iogrp,cmpflg - character timeunits*30,calendar*19 - call ncdefvar('time','time',ndouble,0) - call ncattr('long_name','time') - call ncattr('units',timeunits) - call ncattr('calendar',calendar) - call ncdefvar('sigma','sigma',ndouble,8) - call ncattr('long_name','Potential density') - call ncattr('standard_name','sea_water_sigma_theta') - call ncattr('units','kg m-3') - call ncattr('positive','down') - call ncdefvar('depth','depth',ndouble,8) - call ncattr('long_name','z level') - call ncattr('units','m') - call ncattr('positive','down') - call ncattr('bounds','depth_bnds') - call ncdefvar('depth_bnds','bounds depth',ndouble,8) - call ncdefvar3d(SRF_KWCO2(iogrp),cmpflg,'p', & - & 'kwco2','CO2 piston velocity',' ','m s-1',0) - call ncdefvar3d(SRF_KWCO2KHM(iogrp),cmpflg,'p', & - & 'kwco2khm','CO2 piston velocity times solubility (moist air)',' ', & - & 'm s-1 mol kg-1 muatm-1',0) - call ncdefvar3d(SRF_CO2KH(iogrp),cmpflg,'p', & - & 'co2kh','CO2 solubility (dry air)',' ','mol kg-1 atm-1',0) - call ncdefvar3d(SRF_CO2KHM(iogrp),cmpflg,'p', & - & 'co2khm','CO2 solubility (moist air)',' ','mol kg-1 atm-1',0) - call ncdefvar3d(SRF_PCO2(iogrp),cmpflg,'p', & - & 'pco2','Surface PCO2',' ','uatm',0) - call ncdefvar3d(SRF_PCO2M(iogrp),cmpflg,'p', & - & 'pco2m','Surface PCO2 (moist air)',' ','uatm',0) - call ncdefvar3d(SRF_DMSFLUX(iogrp), & - & cmpflg,'p','dmsflux','DMS flux',' ','mol DMS m-2 s-1',0) - call ncdefvar3d(SRF_CO2FXD(iogrp), & - & cmpflg,'p','co2fxd','Downward CO2 flux',' ','kg C m-2 s-1',0) - call ncdefvar3d(SRF_CO2FXU(iogrp), & - & cmpflg,'p','co2fxu','Upward CO2 flux',' ','kg C m-2 s-1',0) - call ncdefvar3d(SRF_OXFLUX(iogrp), & - & cmpflg,'p','fgo2','Oxygen flux',' ','mol O2 m-2 s-1',0) - call ncdefvar3d(SRF_NIFLUX(iogrp), & - & cmpflg,'p','fgn2','Nitrogen flux',' ','mol N2 m-2 s-1',0) - call ncdefvar3d(SRF_DMS(iogrp),cmpflg,'p', & - & 'dms','DMS',' ','kmol DMS m-3',0) - call ncdefvar3d(SRF_DMSPROD(iogrp),cmpflg,'p', & - & 'dmsprod','DMS production from phytoplankton production',' ', & - & 'mol DMS m-2 s-1',0) - call ncdefvar3d(SRF_DMS_BAC(iogrp),cmpflg,'p', & - & 'dms_bac','DMS bacterial consumption',' ','mol DMS m-2 s-1',0) - call ncdefvar3d(SRF_DMS_UV(iogrp),cmpflg,'p', & - & 'dms_uv','DMS photolysis reduction',' ','mol DMS m-2 s-1',0) - call ncdefvar3d(SRF_EXPORT(iogrp), & - & cmpflg,'p','epc100','Export production',' ','mol C m-2 s-1',0) - call ncdefvar3d(SRF_EXPOSI(iogrp),cmpflg,'p', & - & 'epsi100','Si export production',' ','mol Si m-2 s-1',0) - call ncdefvar3d(SRF_EXPOCA(iogrp),cmpflg,'p', & - & 'epcalc100','Ca export production',' ','mol Ca m-2 s-1',0) - call ncdefvar3d(SRF_DIC(iogrp),cmpflg,'p','srfdissic', & - & 'Surface dissolved inorganic carbon',' ','mol C m-3',0) - call ncdefvar3d(SRF_ALKALI(iogrp),cmpflg,'p','srftalk', & - & 'Surface alkalinity',' ','eq m-3',0) - call ncdefvar3d(SRF_PHOSPH(iogrp),cmpflg,'p','srfpo4', & - & 'Surface phosphorus',' ','mol P m-3',0) - call ncdefvar3d(SRF_OXYGEN(iogrp),cmpflg,'p','srfo2', & - & 'Surface oxygen',' ','mol O2 m-3',0) - call ncdefvar3d(SRF_ANO3(iogrp),cmpflg,'p','srfno3', & - & 'Surface nitrate',' ','mol N m-3',0) - call ncdefvar3d(SRF_SILICA(iogrp),cmpflg,'p','srfsi', & - & 'Surface silicate',' ','mol Si m-3',0) - call ncdefvar3d(SRF_IRON(iogrp),cmpflg,'p','srfdfe', & - & 'Surface dissolved iron',' ','mol Fe m-3',0) - call ncdefvar3d(SRF_PHYTO(iogrp),cmpflg,'p','srfphyc', & - & 'Surface phytoplankton',' ','mol P m-3',0) - call ncdefvar3d(SRF_PH(iogrp),cmpflg,'p','srfph', & - & 'Surface pH',' ','-log10([H+])',0) - call ncdefvar3d(INT_PHOSY(iogrp),cmpflg,'p','ppint', & - & 'Integrated primary production',' ','mol C m-2 s-1',0) - call ncdefvar3d(INT_NFIX(iogrp),cmpflg,'p','nfixint', & - & 'Integrated nitrogen fixation',' ','mol N m-2 s-1',0) - call ncdefvar3d(INT_DNIT(iogrp),cmpflg,'p','dnitint', & - & 'Integrated denitrification',' ','mol N m-2 s-1',0) - call ncdefvar3d(FLX_NDEP(iogrp),cmpflg,'p','ndep', & - & 'Nitrogen deposition flux',' ','mol N m-2 s-1',0) - call ncdefvar3d(FLX_OALK(iogrp),cmpflg,'p','oalkfx', & - & 'Alkalinity flux due to OA',' ','mol TA m-2 s-1',0) - call ncdefvar3d(FLX_CAR0100(iogrp),cmpflg,'p','carflx0100', & - & 'C flux at 100m',' ','mol C m-2 s-1',0) - call ncdefvar3d(FLX_CAR0500(iogrp),cmpflg,'p','carflx0500', & - & 'C flux at 500m',' ','mol C m-2 s-1',0) - call ncdefvar3d(FLX_CAR1000(iogrp),cmpflg,'p','carflx1000', & - & 'C flux at 1000m',' ','mol C m-2 s-1',0) - call ncdefvar3d(FLX_CAR2000(iogrp),cmpflg,'p','carflx2000', & - & 'C flux at 2000m',' ','mol C m-2 s-1',0) - call ncdefvar3d(FLX_CAR4000(iogrp),cmpflg,'p','carflx4000', & - & 'C flux at 4000m',' ','mol C m-2 s-1',0) - call ncdefvar3d(FLX_CAR_BOT(iogrp),cmpflg,'p','carflx_bot', & - & 'C flux to sediment',' ','mol C m-2 s-1',0) - call ncdefvar3d(FLX_BSI0100(iogrp),cmpflg,'p','bsiflx0100', & - & 'Opal flux at 100m',' ','mol Si m-2 s-1',0) - call ncdefvar3d(FLX_BSI0500(iogrp),cmpflg,'p','bsiflx0500', & - & 'Opal flux at 500m',' ','mol Si m-2 s-1',0) - call ncdefvar3d(FLX_BSI1000(iogrp),cmpflg,'p','bsiflx1000', & - & 'Opal flux at 1000m',' ','mol Si m-2 s-1',0) - call ncdefvar3d(FLX_BSI2000(iogrp),cmpflg,'p','bsiflx2000', & - & 'Opal flux at 2000m',' ','mol Si m-2 s-1',0) - call ncdefvar3d(FLX_BSI4000(iogrp),cmpflg,'p','bsiflx4000', & - & 'Opal flux at 4000m',' ','mol Si m-2 s-1',0) - call ncdefvar3d(FLX_BSI_BOT(iogrp),cmpflg,'p','bsiflx_bot', & - & 'Opal flux to sediment',' ','mol Si m-2 s-1',0) - call ncdefvar3d(FLX_CAL0100(iogrp),cmpflg,'p','calflx0100', & - & 'CaCO3 flux at 100m',' ','mol Ca m-2 s-1',0) - call ncdefvar3d(FLX_CAL0500(iogrp),cmpflg,'p','calflx0500', & - & 'CaCO3 flux at 500m',' ','mol Ca m-2 s-1',0) - call ncdefvar3d(FLX_CAL1000(iogrp),cmpflg,'p','calflx1000', & - & 'CaCO3 flux at 1000m',' ','mol Ca m-2 s-1',0) - call ncdefvar3d(FLX_CAL2000(iogrp),cmpflg,'p','calflx2000', & - & 'CaCO3 flux at 2000m',' ','mol Ca m-2 s-1',0) - call ncdefvar3d(FLX_CAL4000(iogrp),cmpflg,'p','calflx4000', & - & 'CaCO3 flux at 4000m',' ','mol Ca m-2 s-1',0) - call ncdefvar3d(FLX_CAL_BOT(iogrp),cmpflg,'p','calflx_bot', & - & '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) - 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) - endif - 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) - endif - 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) - endif - 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) - endif - 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) - endif - - call ncdefvar3d(SRF_ATMCO2(iogrp),cmpflg,'p', & - & 'atmco2','Atmospheric CO2',' ','ppm',0) - 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) - endif - 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) - endif - - ! --- define 3d layer fields - call ncdefvar3d(LYR_DP(iogrp),cmpflg,'p', & - & 'pddpo','Layer thickness',' ','m',1) - call ncdefvar3d(LYR_DIC(iogrp),cmpflg,'p', & - & 'dissic','Dissolved inorganic carbon',' ','mol C m-3',1) - call ncdefvar3d(LYR_ALKALI(iogrp),cmpflg,'p', & - & 'talk','Alkalinity',' ','eq m-3',1) - call ncdefvar3d(LYR_PHOSPH(iogrp),cmpflg,'p', & - & 'po4','Phosphorus',' ','mol P m-3',1) - call ncdefvar3d(LYR_OXYGEN(iogrp),cmpflg,'p', & - & 'o2','Oxygen',' ','mol O2 m-3',1) - call ncdefvar3d(LYR_ANO3(iogrp),cmpflg,'p', & - & 'no3','Nitrate',' ','mol N m-3',1) - call ncdefvar3d(LYR_SILICA(iogrp),cmpflg,'p', & - & 'si','Silicate',' ','mol Si m-3',1) - call ncdefvar3d(LYR_DOC(iogrp),cmpflg,'p', & - & 'dissoc','Dissolved organic carbon',' ','mol P m-3',1) - call ncdefvar3d(LYR_PHYTO(iogrp),cmpflg,'p', & - & 'phyc','Phytoplankton',' ','mol P m-3',1) - call ncdefvar3d(LYR_GRAZER(iogrp),cmpflg,'p', & - & 'zooc','Zooplankton',' ','mol P m-3',1) - call ncdefvar3d(LYR_POC(iogrp),cmpflg,'p', & - & 'detoc','Detritus',' ','mol P m-3',1) - call ncdefvar3d(LYR_CALC(iogrp),cmpflg,'p', & - & 'calc','CaCO3 shells',' ','mol C m-3',1) - call ncdefvar3d(LYR_OPAL(iogrp),cmpflg,'p', & - & 'opal','Opal shells',' ','mol Si m-3',1) - call ncdefvar3d(LYR_IRON(iogrp),cmpflg,'p', & - & 'dfe','Dissolved iron',' ','mol Fe m-3',1) - call ncdefvar3d(LYR_PHOSY(iogrp),cmpflg,'p', & - & 'pp','Primary production',' ','mol C m-3 s-1',1) - call ncdefvar3d(LYR_CO3(iogrp),cmpflg,'p', & - & 'co3','Carbonate ions',' ','mol C m-3',1) - call ncdefvar3d(LYR_PH(iogrp),cmpflg,'p', & - & 'ph','pH',' ','-log10([H+])',1) - call ncdefvar3d(LYR_OMEGAA(iogrp),cmpflg,'p', & - & 'omegaa','OmegaA',' ','1',1) - call ncdefvar3d(LYR_OMEGAC(iogrp),cmpflg,'p', & - & 'omegac','OmegaC',' ','1',1) - call ncdefvar3d(LYR_N2O(iogrp),cmpflg,'p', & - & 'n2o','N2O',' ','mol N2O m-3',1) - call ncdefvar3d(LYR_PREFO2(iogrp),cmpflg,'p', & - & 'p_o2','Preformed oxygen',' ','mol O2 m-3',1) - call ncdefvar3d(LYR_O2SAT(iogrp),cmpflg,'p', & - & 'satoxy','Saturated oxygen',' ','mol O2 m-3',1) - call ncdefvar3d(LYR_PREFPO4(iogrp),cmpflg,'p', & - & 'p_po4','Preformed phosphorus',' ','mol P m-3',1) - call ncdefvar3d(LYR_PREFALK(iogrp),cmpflg,'p', & - & 'p_talk','Preformed alkalinity',' ','eq m-3',1) - call ncdefvar3d(LYR_PREFDIC(iogrp),cmpflg,'p', & - & '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) - 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) - endif - 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) - endif - 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) - endif - 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) - endif - if (use_BROMO) then - call ncdefvar3d(LYR_BROMO(iogrp),cmpflg,'p', & - & 'bromo','Bromoform',' ','mol CHBr3 m-3',1) - endif - - ! --- define 3d level fields - call ncdefvar3d(LVL_DIC(iogrp),cmpflg,'p', & - & 'dissiclvl','Dissolved inorganic carbon',' ','mol C m-3',2) - call ncdefvar3d(LVL_ALKALI(iogrp),cmpflg,'p', & - & 'talklvl','Alkalinity',' ','eq m-3',2) - call ncdefvar3d(LVL_PHOSPH(iogrp),cmpflg,'p', & - & 'po4lvl','Phosphorus',' ','mol P m-3',2) - call ncdefvar3d(LVL_OXYGEN(iogrp),cmpflg,'p', & - & 'o2lvl','Oxygen',' ','mol O2 m-3',2) - call ncdefvar3d(LVL_ANO3(iogrp),cmpflg,'p', & - & 'no3lvl','Nitrate',' ','mol N m-3',2) - call ncdefvar3d(LVL_SILICA(iogrp),cmpflg,'p', & - & 'silvl','Silicate',' ','mol Si m-3',2) - call ncdefvar3d(LVL_DOC(iogrp),cmpflg,'p', & - & 'dissoclvl','Dissolved organic carbon',' ','mol P m-3',2) - call ncdefvar3d(LVL_PHYTO(iogrp),cmpflg,'p', & - & 'phyclvl','Phytoplankton',' ','mol P m-3',2) - call ncdefvar3d(LVL_GRAZER(iogrp),cmpflg,'p', & - & 'zooclvl','Zooplankton',' ','mol P m-3',2) - call ncdefvar3d(LVL_POC(iogrp),cmpflg,'p', & - & 'detoclvl','Detritus',' ','mol P m-3',2) - call ncdefvar3d(LVL_CALC(iogrp),cmpflg,'p', & - & 'calclvl','CaCO3 shells',' ','mol C m-3',2) - call ncdefvar3d(LVL_OPAL(iogrp),cmpflg,'p', & - & 'opallvl','Opal shells',' ','mol Si m-3',2) - call ncdefvar3d(LVL_IRON(iogrp),cmpflg,'p', & - & 'dfelvl','Dissolved iron',' ','mol Fe m-3',2) - call ncdefvar3d(LVL_PHOSY(iogrp),cmpflg,'p', & - & 'pplvl','Primary production',' ','mol C m-3 s-1',2) - call ncdefvar3d(LVL_CO3(iogrp),cmpflg,'p', & - & 'co3lvl','Carbonate ions',' ','mol C m-3',2) - call ncdefvar3d(LVL_PH(iogrp),cmpflg,'p', & - & 'phlvl','pH',' ','-log10([H+])',2) - call ncdefvar3d(LVL_OMEGAA(iogrp),cmpflg,'p', & - & 'omegaalvl','OmegaA',' ','1',2) - call ncdefvar3d(LVL_OMEGAC(iogrp),cmpflg,'p', & - & 'omegaclvl','OmegaC',' ','1',2) - call ncdefvar3d(LVL_N2O(iogrp),cmpflg,'p', & - & 'n2olvl','N2O',' ','mol N2O m-3',2) - call ncdefvar3d(LVL_PREFO2(iogrp),cmpflg,'p', & - & 'p_o2lvl','Preformed oxygen',' ','mol O2 m-3',2) - call ncdefvar3d(LVL_O2SAT(iogrp),cmpflg,'p', & - & 'satoxylvl','Saturated oxygen',' ','mol O2 m-3',2) - call ncdefvar3d(LVL_PREFPO4(iogrp),cmpflg,'p', & - & 'p_po4lvl','Preformed phosphorus',' ','mol P m-3',2) - call ncdefvar3d(LVL_PREFALK(iogrp),cmpflg,'p', & - & 'p_talklvl','Preformed alkalinity',' ','eq m-3',2) - call ncdefvar3d(LVL_PREFDIC(iogrp),cmpflg,'p', & - & '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) - 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) - endif - 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) - endif - 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) - endif - 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) - endif - if (use_BROMO) then - call ncdefvar3d(LVL_BROMO(iogrp),cmpflg,'p', & - & 'bromolvl','Bromoform',' ','mol CHBr3 m-3',2) - endif - - ! --- define sediment fields - 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 - - ! --- enddef netcdf file - call ncedef -end subroutine hamoccvardef diff --git a/hamocc/netcdf_def_vardb.F90 b/hamocc/netcdf_def_vardb.F90 deleted file mode 100644 index 13c50967..00000000 --- a/hamocc/netcdf_def_vardb.F90 +++ /dev/null @@ -1,241 +0,0 @@ -! Copyright (C) 2001 S. Legutke -! Copyright (C) 2020 K. Assmann, J. Tjiputra, J. Schwinger, M. Bentsen -! -! 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. -! -! 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. -! -! 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 NETCDF_DEF_VARDB & - & (kcid,kshort,yshort,kdims,kcdims,kcvarid, & - & kunitl,yunit,klong,ylong,pmissing,klabel,kunit) - ! **************************************************************** - ! - ! **** *NETCDF_DEF_VAR* - define NetCDF variable. - ! - ! S.Legutke, *MPI-MaD, HH* 10.10.01 - ! - ! Modified - ! -------- - ! - ! Purpose - ! ------- - ! Interface to NETCDF routines. - ! - ! Method - ! ------- - ! - ! - !** Interface. - ! ---------- - ! - ! *CALL* *NETCDF_DEF_VARDB(kcid,kshort,yshort,kdims,kcdims,kcvarid, - ! kunitl,yunit,klong,ylong,pmissing,klabel,kunit)* - ! - ! - ! ** Interface to calling routine (parameter list): - ! ---------------------------------------------- - ! - ! *INTEGER* *kcid* - file ID. - ! *INTEGER* *kshort* - length of short name. - ! *INTEGER* *kdims* - number of dimensions. - ! *INTEGER* *kcdims* - dimensions. - ! *INTEGER* *kcvarid* - variable ID. - ! *INTEGER* *kunitl* - length of unit string. - ! *INTEGER* *klong* - length of long name. - ! *INTEGER* *klabel* - label for abort identification. - ! *INTEGER* *kunit* - stdout unit. - ! *REAL* *pmissing* - missing value. - ! *CHARACTER* *yshort* - short name. - ! *CHARACTER* *yunit* - unit string. - ! *CHARACTER* *ylong* - long name. - ! - ! - ! Externals - ! --------- - ! none. - ! - ! ************************************************************************** - use netcdf, only: nf90_double,nf90_noerr,nf90_put_att,nf90_def_var - use mod_xc, only: mnproc,xchalt - use mod_dia, only:iotype - implicit none -#ifdef PNETCDF -#include -#include -#endif - - INTEGER ncstat - - INTEGER kcid,kcvarid,kdims,kcdims(kdims) & - & ,kunitl,klong,kshort,klabel,kunit,k - - REAL pmissing - - CHARACTER*(*) yshort, yunit, ylong - - CHARACTER*24 ystring -#ifdef PNETCDF - integer(kind=MPI_OFFSET_KIND) clen -#endif - ystring(1:21)='NETCDF stop at label ' - - - ! - ! Define variable - ! - IF(mnproc==1 .AND. IOTYPE==0) THEN - ncstat = & - &NF90_DEF_VAR(kcid,yshort(1:kshort),NF90_DOUBLE,kcdims,kcvarid) - IF ( ncstat .NE. NF90_NOERR ) THEN - WRITE(kunit,*) 'Problems with definition of NetCDF variable:' - WRITE(kunit,*) 'kcid : ',kcid - WRITE(kunit,*) 'kshort : ',kshort - WRITE(kunit,*) 'yshort(kshort) : ',yshort(1:kshort),'---' - WRITE(kunit,*) 'kdims : ',kdims - WRITE(kunit,*) 'kcdims : ',(kcdims(k),k=1,kdims) - WRITE(kunit,*) 'kcvarid : ',kcvarid - WRITE(ystring(22:24),'(I3)') klabel - WRITE(kunit,*) ystring - CALL xchalt('(netcdf_def_vardb)') - stop '(netcdf_def_vardb)' - ENDIF - ! - ! Set unit - ! - ncstat = & - &NF90_PUT_ATT(kcid,kcvarid,'units',yunit(1:kunitl)) - IF ( ncstat .NE. NF90_NOERR ) THEN - WRITE(kunit,*) 'Problems with definition of unit:' - WRITE(kunit,*) 'kcid : ',kcid - WRITE(kunit,*) 'kcvarid : ',kcvarid - WRITE(kunit,*) 'kunitl : ',kunitl - WRITE(kunit,*) 'yunit(kunitl) : ',yunit(1:kunitl),'---' - WRITE(ystring(22:24),'(I3)') klabel - WRITE(kunit,*) ystring - CALL xchalt('(netcdf_def_vardb)') - stop '(netcdf_def_vardb)' - ENDIF - - ! - ! Set long name - ! - ncstat = & - &NF90_PUT_ATT(kcid,kcvarid,'long_name',ylong(1:klong)) - IF ( ncstat .NE. NF90_NOERR ) THEN - WRITE(kunit,*) 'Problems with definition of long name:' - WRITE(kunit,*) 'kcid : ',kcid - WRITE(kunit,*) 'kcvarid : ',kcvarid - WRITE(kunit,*) 'klong : ',klong - WRITE(kunit,*) 'ylong(klong) : ',ylong(1:klong),'---' - WRITE(ystring(22:24),'(I3)') klabel - WRITE(kunit,*) ystring - CALL xchalt('(netcdf_def_vardb)') - stop '(netcdf_def_vardb)' - ENDIF - - ! - ! Set missing value - ! - - ncstat = NF90_PUT_ATT & - &(kcid,kcvarid,'missing_value',pmissing) - IF ( ncstat .NE. NF90_NOERR ) THEN - WRITE(kunit,*) 'Problems with definition of missing value:' - WRITE(kunit,*) 'kcid : ',kcid - WRITE(kunit,*) 'kcvarid : ',kcvarid - WRITE(kunit,*) 'pmissing : ',pmissing - WRITE(ystring(22:24),'(I3)') klabel - WRITE(kunit,*) ystring - CALL xchalt('(netcdf_def_vardb)') - stop '(netcdf_def_vardb)' - ENDIF - ELSE IF(IOTYPE==1) THEN -#ifdef PNETCDF - ! - ! Define variable - ! - ncstat = nfmpi_def_var(kcid,yshort(1:kshort),nf_double,kdims, & - & kcdims,kcvarid) - - IF ( ncstat .NE. NF_NOERR ) THEN - WRITE(kunit,*) 'Problems with definition of NetCDF variable:' - WRITE(kunit,*) 'kcid : ',kcid - WRITE(kunit,*) 'kshort : ',kshort - WRITE(kunit,*) 'yshort(kshort) : ',yshort(1:kshort),'---' - WRITE(kunit,*) 'kdims : ',kdims - WRITE(kunit,*) 'kcdims : ',(kcdims(k),k=1,kdims) - WRITE(kunit,*) 'kcvarid : ',kcvarid - WRITE(ystring(22:24),'(I3)') klabel - WRITE(kunit,*) ystring - CALL xchalt('(pnetcdf_def_vardb)') - stop '(pnetcdf_def_vardb)' - ENDIF - ! - ! Set unit - ! - clen=len(trim(yunit(1:kunitl))) - ncstat = & - &NFMPI_PUT_ATT_TEXT(kcid,kcvarid,'units',clen,yunit(1:kunitl)) - IF ( ncstat .NE. NF_NOERR ) THEN - WRITE(kunit,*) 'Problems with definition of unit:' - WRITE(kunit,*) 'kcid : ',kcid - WRITE(kunit,*) 'kcvarid : ',kcvarid - WRITE(kunit,*) 'kunitl : ',kunitl - WRITE(kunit,*) 'yunit(kunitl) : ',yunit(1:kunitl),'---' - WRITE(ystring(22:24),'(I3)') klabel - WRITE(kunit,*) ystring - CALL xchalt('(pnetcdf_def_vardb)') - stop '(pnetcdf_def_vardb)' - ENDIF - - ! - ! Set long name - ! - clen=len(trim(ylong(1:klong))) - ncstat = & - &NFMPI_PUT_ATT_TEXT(kcid,kcvarid,'long_name',clen,ylong(1:klong)) - IF ( ncstat .NE. NF_NOERR ) THEN - WRITE(kunit,*) 'Problems with definition of long name:' - WRITE(kunit,*) 'kcid : ',kcid - WRITE(kunit,*) 'kcvarid : ',kcvarid - WRITE(kunit,*) 'klong : ',klong - WRITE(kunit,*) 'ylong(klong) : ',ylong(1:klong),'---' - WRITE(ystring(22:24),'(I3)') klabel - WRITE(kunit,*) ystring - CALL xchalt('(pnetcdf_def_vardb)') - stop '(pnetcdf_def_vardb)' - ENDIF - - ! - ! Set missing value - ! - clen=1 - ncstat = NFMPI_PUT_ATT_DOUBLE & - &(kcid,kcvarid,'missing_value',NF_DOUBLE,clen,pmissing) - IF ( ncstat .NE. NF_NOERR ) THEN - WRITE(kunit,*) 'Problems with definition of missing value:' - WRITE(kunit,*) 'kcid : ',kcid - WRITE(kunit,*) 'kcvarid : ',kcvarid - WRITE(kunit,*) 'pmissing : ',pmissing - WRITE(ystring(22:24),'(I3)') klabel - WRITE(kunit,*) ystring - CALL xchalt('(pnetcdf_def_vardb)') - stop '(pnetcdf_def_vardb)' - ENDIF - -#endif - ENDIF - RETURN -END SUBROUTINE NETCDF_DEF_VARDB diff --git a/hamocc/ocprod.F90 b/hamocc/ocprod.F90 deleted file mode 100644 index ec53af51..00000000 --- a/hamocc/ocprod.F90 +++ /dev/null @@ -1,1439 +0,0 @@ -! Copyright (C) 2001 Ernst Maier-Reimer, S. Legutke -! Copyright (C) 2020 K. Assmann, J. Tjiputra, J. Schwinger, I. Kriest, -! A. Moree, C. Heinze -! -! 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. -! -! 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. -! -! 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 ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) - !****************************************************************************** - ! - ! OCPROD - biological production, remineralization and particle sinking. - ! - ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 - ! - ! Modified - ! -------- - ! S.Legutke, *MPI-MaD, HH* 2010-04-01 - ! - ! J.Schwinger, *GFI, UiB* 2013-04-22 - ! - Corrected bug in light penetration formulation - ! - Cautious code clean-up - ! - ! J.Tjiputra, *UNI-RESEARCH* 2015-11-25 - ! - Implemented natural DIC/ALK/CALC - ! - ! I.Kriest, *GEOMAR* 2016-08-11 - ! - Modified stoichiometry for denitrification (affects NO3, N2, Alk) - ! - ! J.Schwinger, *UNI-RESEARCH* 2017-08-30 - ! - Removed split of the layer that only partly falls into the - ! euphotic zone. Loops are now calculated over - ! (1) layers that are completely or partly in the euphotoc zone - ! (2) layers that do not lie within the euphotic zone. - ! - Moved the accumulation of global fields for output to routine - ! hamocc4bgc. The accumulation of local fields has been moved to - ! the end of this routine. - ! - ! A.Moree, *GFI, Bergen* 2018-04-12 - ! - new version of carbon isotope code - ! - ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 - ! - moved accumulation of all output fields to seperate subroutine, - ! related code-restructuring - ! - added sediment bypass preprocessor option and related code - ! - ! J.Schwinger, *NORCE Climate, Bergen* 2020-05-29 - ! - Cleaned up parameter list - ! - Dust deposition field now passed as an argument - ! - ! Purpose - ! ------- - ! compute biological production, settling of debris, and related - ! biogeochemistry - ! - ! - ! - ! Parameter list: - ! --------------- - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. - ! *INTEGER* *kbnd* - nb of halo grid points - ! *REAL* *pdlxp* - size of scalar grid cell (1st dimension) [m]. - ! *REAL* *pdlyp* - size of scalar grid cell (2nd dimension) [m]. - ! *REAL* *pddpo* - size of scalar grid cell (3rd dimension) [m]. - ! *REAL* *omask* - land/ocean mask (1=ocean) - ! *REAL* *ptho* - potential temperature [deg C]. - ! - !****************************************************************************** - use mod_xc, only: mnproc - use mo_carbch, only: ocetra,satoxy,hi,co2star - use mo_sedmnt, only: prcaca,produs,prorca,silpro,pror13,pror14,prca13,prca14 - use mo_param_bgc, only: drempoc,dremn2o,dremopal,dremsul,dyphy,ecan,epsher,fesoly,gammap,gammaz,grami,grazra,pi_alpha,phytomi, & - rcalc,rcar,rdn2o1,rdn2o2,rdnit0,rdnit1,rdnit2,relaxfe,remido,riron,rnit,rnoi,ro2ut,ropal, & - spemor,wcal,wdust,wopal,wpoc,zinges,alar1,alar2,alar3,alow1,alow2,alow3,calmax,cellmass, & - cellsink,dustd1,dustd2,dustd3,dustsink,fractdim,fse,fsh,nmldmin,plower,pupper,sinkexp,stick,tmfac, & - tsfac,vsmall,zdis,wmin,wmax,wlin,rbro,bifr13,bifr14,dmsp1,dmsp2,dmsp3,dmsp4,dmsp5,dmsp6,dms_gamma, & - fbro1,fbro2,atten_f,atten_c,atten_uv,atten_w,bkopal,bkphy,bkzoo - use mo_biomod, only: bsiflx0100,bsiflx0500,bsiflx1000,bsiflx2000,bsiflx4000,bsiflx_bot, & - calflx0100,calflx0500,calflx1000,calflx2000,calflx4000,calflx_bot, & - carflx0100,carflx0500,carflx1000,carflx2000,carflx4000,carflx_bot, & - expoor,exposi,expoca,intdnit,intdms_bac,intdmsprod,intdms_uv,intphosy,int_chbr3_prod,int_chbr3_uv, & - phosy3d,abs_oce,strahl,asize3d,wmass,wnumb,eps3d,bifr13_perm,growth_co2 - use mo_param1_bgc, only: ialkali,ian2o,iano3,icalc,idet,idms,idoc,ifdust,igasnit,iiron,iopal,ioxygen,iphosph,iphy,isco212, & - 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 mo_vgrid, only: kmle - use mo_clim_swa, only: swa_clim - - implicit none - - integer, intent(in) :: kpie,kpje,kpke,kbnd - real, intent(in) :: pdlxp(kpie,kpje),pdlyp(kpie,kpje) - real, intent(in) :: pddpo(kpie,kpje,kpke) - real, intent(in) :: omask(kpie,kpje) - real, intent(in) :: ptho(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) - real, intent(in) :: pi_ph(kpie,kpje) - - ! Local varaibles - integer, parameter :: nsinkmax = 12 - integer :: i,j,k,l - integer :: is,kdonor - real :: abs_bgc(kpie,kpje,kpke) - real :: tco(nsinkmax),tcn(nsinkmax),q(nsinkmax) - 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,dms_ph - real :: dtr,dz - real :: wpocd,wcald,wopald,dagg - ! sedbypass - real :: florca,flcaca,flsil - ! cisonew - real :: phygrowth - real :: phosy13,phosy14 - real :: grazing13,grazing14 - real :: graton13,graton14 - real :: gratpoc13,gratpoc14 - real :: bacfra13,bacfra14 - real :: phymor13,phymor14 - real :: grawa13,grawa14 - real :: zoomor13,zoomor14 - real :: excdoc13,excdoc14 - real :: exud13,exud14 - real :: export13,export14 - real :: delcar13,delcar14 - real :: dtr13,dtr14 - real :: sterph13,sterph14 - real :: sterzo13,sterzo14 - real :: pocrem13,pocrem14 - real :: docrem13,docrem14 - real :: phyrem13,phyrem14 - real :: rem13,rem14 - real :: rco213,rco214,rdoc13,rdoc14,rdet13,rdet14 - real :: rphy13,rphy14,rzoo13,rzoo14 - ! sedbypass - real :: flor13,flor14,flca13,flca14 - ! AGG - real :: aggregate(kpie,kpje,kpke) - real :: dustagg(kpie,kpje,kpke) - real :: avmass, avnos, anosloss - real :: zmornos, eps, e1,e2,e3,e4,es1,es3 - real :: TopM,TopF, snow,fshear,sagg1,sagg2,sagg4 - real :: sett_agg,shear_agg,effsti,dfirst,dshagg,dsett - real :: wnos,wnosd - ! BROMO - real :: bro_beta,bro_uv - real :: abs_uv(kpie,kpje,kpke) - - ! set variables for diagnostic output to zero - expoor (:,:) = 0. - expoca (:,:) = 0. - exposi (:,:) = 0. - carflx0100(:,:) = 0. - carflx0500(:,:) = 0. - carflx1000(:,:) = 0. - carflx2000(:,:) = 0. - carflx4000(:,:) = 0. - bsiflx0100(:,:) = 0. - bsiflx0500(:,:) = 0. - bsiflx1000(:,:) = 0. - bsiflx2000(:,:) = 0. - bsiflx4000(:,:) = 0. - calflx0100(:,:) = 0. - calflx0500(:,:) = 0. - calflx1000(:,:) = 0. - calflx2000(:,:) = 0. - calflx4000(:,:) = 0. - intdnit (:,:) = 0. - intphosy (:,:) = 0. - intdmsprod(:,:) = 0. - intdms_bac(:,:) = 0. - intdms_uv (:,:) = 0. - phosy3d (:,:,:) = 0. - - if (use_BROMO) then - int_chbr3_uv (:,:) = 0. - int_chbr3_prod(:,:) = 0. - end if - if (use_AGG) then - eps3d(:,:,:) = 0. - asize3d(:,:,:) = 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) - endif - - ! Calculate swr absorption by water and phytoplankton - - abs_bgc(:,:,:) = 0. - if (use_BROMO) then - abs_uv(:,:,:) = 0. - endif - 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 - do i = 1,kpie - - if(omask(i,j) > 0.5) then - - absorption = 1. - absorption_uv = 1. - - vloop: do k = 1,kwrbioz(i,j) - - if(pddpo(i,j,k) > 0.0) then - - dz = pddpo(i,j,k) - - ! 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 - 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 - - ! Radiation intensity I_0 at the top of next layer - absorption = absorption * exp(-atten*dz) - absorption_uv = absorption_uv * exp(-atten_uv*dz) - - endif - enddo vloop - - endif ! omask > 0.5 - - enddo - enddo - !$OMP END PARALLEL DO - - - !$OMP PARALLEL DO PRIVATE(avphy,avgra,avsil,avanut,avanfe,pho,xa,xn & - !$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 & - !$OMP ,avmass,avnos,zmornos & - !$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 & - !$OMP ,bro_beta,bro_uv & - !$OMP ,i,k) - - loop1: do j = 1,kpje - do i = 1,kpie - do k = 1,kwrbioz(i,j) - - if(pddpo(i,j,k) > dp_min .and. omask(i,j) > 0.5) then - - - 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))) - phofa = pi_alpha * strahl(i,j) * abs_bgc(i,j,k) - temfa = 0.6 * 1.066**temp - !taylor: temfa= 0.6*(1. + 0.0639*ptho(i,j,k) * & - ! & (1. + 0.0639*ptho(i,j,k)/2. * (1. + 0.0639*ptho(i,j,k)/3.))) - pho = dtb * phofa * temfa / sqrt(phofa**2 + temfa**2) - - avphy = MAX(phytomi,ocetra(i,j,k,iphy)) ! 'available' phytoplankton - avgra = MAX(grami,ocetra(i,j,k,izoo)) ! 'available' zooplankton - avsil = MAX(0.,ocetra(i,j,k,isilica)) - avdic = MAX(0.,ocetra(i,j,k,isco212)) - avanut = MAX(0.,MIN(ocetra(i,j,k,iphosph), & - & rnoi*ocetra(i,j,k,iano3))) - avanfe = MAX(0.,MIN(avanut,ocetra(i,j,k,iiron)/riron)) - xa = avanfe - xn = xa/(1.+pho*avphy/(xa+bkphy)) - phosy = MAX(0.,xa-xn) - phosy = MERGE(avdic/rcar, phosy, avdic <= rcar*phosy) ! limit phosy by available DIC - ya = avphy+phosy - yn = (ya+grazra*avgra*phytomi/(avphy+bkzoo)) & - & /(1.+grazra*avgra/(avphy+bkzoo)) - grazing = MAX(0.,ya-yn) - graton = epsher*(1.-zinges)*grazing - gratpoc = (1.-epsher)*grazing - grawa = epsher*zinges*grazing - bacfra=remido*ocetra(i,j,k,idoc) - - phythresh = MAX(0.,(ocetra(i,j,k,iphy)-2.*phytomi)) - zoothresh = MAX(0.,(ocetra(i,j,k,izoo)-2.*grami)) - phymor = dyphy*phythresh - exud = gammap*phythresh - zoomor = spemor*zoothresh*zoothresh ! *10 compared to linear in tropics (tinka) - excdoc = gammaz*zoothresh ! excretion of doc by zooplankton - export = zoomor*(1.-ecan) + phymor + gratpoc ! ecan=.95, gratpoc= .2*grazing - - 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 - - ! 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 - - grazing13 = grazing*rphy13 - grazing14 = grazing*rphy14 - - graton13 = epsher*(1.-zinges)*grazing13 - graton14 = epsher*(1.-zinges)*grazing14 - - gratpoc13 = (1.-epsher)*grazing13 - gratpoc14 = (1.-epsher)*grazing14 - - grawa13 = epsher*zinges*grazing13 - grawa14 = epsher*zinges*grazing14 - - bacfra13 = remido*ocetra(i,j,k,idoc13) - bacfra14 = remido*ocetra(i,j,k,idoc14) - - phymor13 = phymor*rphy13 - phymor14 = phymor*rphy14 - - zoomor13 = zoomor*rzoo13 - zoomor14 = zoomor*rzoo14 - - excdoc13 = excdoc*rzoo13 - excdoc14 = excdoc*rzoo14 - - exud13 = exud*rphy13 - exud14 = exud*rphy14 - - export13 = zoomor13*(1.-ecan) + phymor13 + gratpoc13 - export14 = zoomor14*(1.-ecan) + phymor14 + gratpoc14 - 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) - endif - endif - - if(with_dmsph) then - dms_ph = 1. + (-log10(hi(i,j,1)) - pi_ph(i,j))*dms_gamma - else - dms_ph = 1. - endif - dmsprod = (dmsp5*delsil+dmsp4*delcar) & - & *(1.+1./(temp+dmsp1)**2)*dms_ph - dms_bac = dmsp3*abs(temp+3.)*ocetra(i,j,k,idms) & - & *(ocetra(i,j,k,idms)/(dmsp6+ocetra(i,j,k,idms))) - dms_uv = dmsp2*phofa/pi_alpha*ocetra(i,j,k,idms) - - dtr = bacfra-phosy+graton+ecan*zoomor - - ocetra(i,j,k,iphosph) = ocetra(i,j,k,iphosph)+dtr - ocetra(i,j,k,iano3) = ocetra(i,j,k,iano3)+dtr*rnit - ocetra(i,j,k,idet) = ocetra(i,j,k,idet)+export - ocetra(i,j,k,idms) = ocetra(i,j,k,idms)+dmsprod-dms_bac-dms_uv - ocetra(i,j,k,isco212) = ocetra(i,j,k,isco212)-delcar+rcar*dtr - ocetra(i,j,k,ialkali) = ocetra(i,j,k,ialkali)-2.*delcar-(rnit+1)*dtr - ocetra(i,j,k,ioxygen) = ocetra(i,j,k,ioxygen)-dtr*ro2ut - ocetra(i,j,k,iphy) = ocetra(i,j,k,iphy)+phosy-grazing-phymor-exud - 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 - 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 - endif - 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 - endif - 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.) - - 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 - endif - - 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) - !********************************************************************** - - 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 - !*********************************************************************** - - zmornos = zoomor * (1.-ecan) * zdis * 1.e+6 - ocetra(i,j,k,inos) = ocetra(i,j,k,inos)+zmornos - endif - - ! add up for total inventory and output - dz = pddpo(i,j,k) - - expoor(i,j) = expoor(i,j) +export*rcar*dz - expoca(i,j) = expoca(i,j) +delcar*dz - exposi(i,j) = exposi(i,j) +delsil*dz - 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 - - 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 - endif - - 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 - - - endif ! pddpo(i,j,k) > dp_min - enddo ! kwrbioz - enddo ! kpie - enddo loop1 ! kpje - - !$OMP END PARALLEL DO - - 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 - - !$OMP PARALLEL DO PRIVATE(phythresh,zoothresh,sterph,sterzo,remin & - !$OMP ,opalrem,aou,refra,dms_bac,pocrem,docrem,phyrem,dz & - !$OMP ,avmass,avnos,zmornos & - !$OMP ,rphy13,rphy14,rzoo13,rzoo14,rdet13,rdet14,rdoc13,rdoc14 & - !$OMP ,sterph13,sterph14,sterzo13,sterzo14,pocrem13,pocrem14 & - !$OMP ,docrem13,docrem14,phyrem13,phyrem14 & - !$OMP ,i,k) - - loop2: do j = 1,kpje - do i = 1,kpie - do k = kwrbioz(i,j)+1,kpke - if(pddpo(i,j,k) > dp_min .and. omask(i,j) > 0.5) then - - 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 - 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 - 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) - 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. - 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 - ocetra(i,j,k,idoc) = ocetra(i,j,k,idoc) - docrem - ocetra(i,j,k,iphy) = ocetra(i,j,k,iphy) - phyrem - - remin = pocrem + docrem + phyrem - - ocetra(i,j,k,iphosph) = ocetra(i,j,k,iphosph)+remin - ocetra(i,j,k,iano3) = ocetra(i,j,k,iano3)+remin*rnit - ocetra(i,j,k,isco212) = ocetra(i,j,k,isco212)+rcar*remin - ocetra(i,j,k,ialkali) = ocetra(i,j,k,ialkali)-(rnit+1)*remin - 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.) - 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 - ! so the expression dremopal*(Si(OH)4sat-Si(OH)4) would change the - ! rate only from 0 to 100% - !*********************************************************************** - opalrem = dremopal*0.1*(temp+3.)*ocetra(i,j,k,iopal) - ocetra(i,j,k,iopal) = ocetra(i,j,k,iopal)-opalrem - ocetra(i,j,k,isilica) = ocetra(i,j,k,isilica)+opalrem - - !*********************************************************************** - ! There is about 1.e4 O2 on 1 N2O molecule (Broeker&Peng) - ! refra : Tim Rixton, private communication - !*********************************************************************** - aou = satoxy(i,j,k)-ocetra(i,j,k,ioxygen) - refra = 1.+3.*(0.5+sign(0.5,aou-1.97e-4)) - dms_bac = dmsp3 * abs(temp+3.) * ocetra(i,j,k,idms) & - & * (ocetra(i,j,k,idms) / (dmsp6+ocetra(i,j,k,idms))) - ocetra(i,j,k,ian2o) = ocetra(i,j,k,ian2o)+remin*1.e-4*ro2ut*refra - ocetra(i,j,k,igasnit) = ocetra(i,j,k,igasnit)-remin*1.e-4*ro2ut*refra - ocetra(i,j,k,ioxygen) = ocetra(i,j,k,ioxygen)-remin*1.e-4*ro2ut*refra*0.5 - ocetra(i,j,k,idms) = ocetra(i,j,k,idms)-dms_bac - - dz = pddpo(i,j,k) - intdms_bac(i,j) = intdms_bac(i,j)+dms_bac*dz - - 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 - enddo - enddo loop2 - !$OMP END PARALLEL DO - - 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 - - !$OMP PARALLEL DO PRIVATE(remin,remin2o,dz & - !$OMP ,avmass,avnos & - !$OMP ,rem13,rem14 & - !$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 - 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) - - 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) - ocetra(i,j,k,iphosph) = ocetra(i,j,k,iphosph)+(remin+remin2o) - ocetra(i,j,k,iano3) = ocetra(i,j,k,iano3)-rdnit1*remin - 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 - 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 - - 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 - enddo - enddo - enddo loop3 - !$OMP END PARALLEL DO - - - 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 - - - !sulphate reduction ! introduced 11.5.2007 to improve poc-remineralisation in the - ! oxygen minimum zone in the subsurface equatorial Pacific - ! assumption of endless pool of SO4 (typical concentration are on the order of mmol/l) - ! js 02072007: for other runs than current millenium (cosmos-setup) experiments this seems - ! to cause trouble as phosphate concentrations are too high at the depth of the oxygen - ! minimum in the equatorial pacific/atlantic - ! does it make sense to check for oxygen and nitrate deficit? - - !$OMP PARALLEL DO PRIVATE(remin & - !$OMP ,avmass,avnos & - !$OMP ,rem13,rem14 & - !$OMP ,i,k) - loop4: do j = 1,kpje - do i = 1,kpie - do k = kwrbioz(i,j)+1,kpke - 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 - - if (use_AGG) then - avmass = ocetra(i,j,k,iphy)+ocetra(i,j,k,idet) - endif - remin = dremsul*ocetra(i,j,k,idet) - 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 - 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 - endif - enddo - enddo - enddo loop4 - !$OMP END PARALLEL DO - ! end 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 - - - 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 - - endif ! use_AGG - - - ! - ! implicit method for sinking of particles: - ! C(k,T+dt)=C(k,T) + (w*dt/ddpo(k))*(C(k-1,T+1)-C(k,T+1)) - ! --> - ! C(k,T+dt)=(ddpo(k)*C(k,T)+w*dt*C(k-1,T+dt))/(ddpo(k)+w*dt) - ! sedimentation=w*dt*C(ks,T+dt) - ! - !$OMP PARALLEL DO PRIVATE(kdonor,wpoc,wpocd,wcal,wcald,wopal,wopald & - !$OMP ,wnos,wnosd,dagg & - !$OMP ,i,k) - do j = 1,kpje - do i = 1,kpie - - tco(:) = 0.0 - tcn(:) = 0.0 - - if(omask(i,j) > 0.5) then - - kdonor = 1 - do k = 1,kpke - - ! Sum up total column inventory before sinking scheme - 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) - 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 (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 (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 - endif - - if( k == 1 ) then - wpocd = 0.0 - wcald = 0.0 - wopald = 0.0 - if (use_AGG) then - wnosd = 0.0 - else if (use_WLIN) then - wpoc = wmin - endif - 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 - ocetra(i,j,k,idet) = (ocetra(i,j,k ,idet)*pddpo(i,j,k) & - + ocetra(i,j,kdonor,idet)*wpocd)/ & - (pddpo(i,j,k)+wpoc) - 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) - 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 - 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) - 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) - 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 - - ! Sum up total column inventory after sinking scheme - ! flux to sediment added after kpke-loop - 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) - 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 (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 - - - ! 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 - 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 (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 - do is = 1,nsinkmax - if( tco(is) > 1.e-12 .and. tcn(is) > 1.e-12 ) q(is) = tco(is)/tcn(is) - enddo - do k = 1,kpke - 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) - 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 (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 (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 - 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 - 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 - endif - - endif ! omask > 0.5 - enddo ! loop i=1,kpie - enddo ! loop j=1,kpje - !$OMP END PARALLEL DO - - - ! Calculate mass sinking flux for carbon, opal and calcium carbonate - ! through the 100 m, 500 m, 1000 m, 2000 m, and 4000 m depth surfaces. These - ! fluxes are intentionally calculated using values at the NEW timelevel - ! to be fully consistent with the implicit sinking scheme - - !$OMP PARALLEL DO PRIVATE(i,k,wpoc,wcal,wopal) - do j = 1,kpje - do i = 1,kpie - if(omask(i,j) > 0.5) then - - ! 100 m - k = k0100(i,j) - if(k > 0) then - 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) - endif - - 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 - endif - bsiflx0100(i,j) = ocetra(i,j,k,iopal)*wopal - calflx0100(i,j) = ocetra(i,j,k,icalc)*wcal - endif - - ! 500 m - k = k0500(i,j) - if(k > 0) then - 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) - endif - - 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 - endif - bsiflx0500(i,j) = ocetra(i,j,k,iopal)*wopal - calflx0500(i,j) = ocetra(i,j,k,icalc)*wcal - endif - - ! 1000 m - k = k1000(i,j) - if(k > 0) then - 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) - endif - - 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 - endif - bsiflx1000(i,j) = ocetra(i,j,k,iopal)*wopal - calflx1000(i,j) = ocetra(i,j,k,icalc)*wcal - endif - - ! 2000 m - k = k2000(i,j) - if(k > 0) then - 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) - endif - - 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 - endif - bsiflx2000(i,j) = ocetra(i,j,k,iopal)*wopal - calflx2000(i,j) = ocetra(i,j,k,icalc)*wcal - endif - - ! 4000 m - k = k4000(i,j) - if(k > 0) then - 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) - endif - - 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 - endif - bsiflx4000(i,j) = ocetra(i,j,k,iopal)*wopal - calflx4000(i,j) = ocetra(i,j,k,icalc)*wcal - endif - - ! bottom fluxes - carflx_bot(i,j) = prorca(i,j)*rcar - bsiflx_bot(i,j) = silpro(i,j) - calflx_bot(i,j) = prcaca(i,j) - - endif ! omask > 0.5 - enddo - 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 - - 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 - - endif ! use_sedbypass - - 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 - -end subroutine ocprod diff --git a/hamocc/powach.F90 b/hamocc/powach.F90 deleted file mode 100644 index 3e9cc2f5..00000000 --- a/hamocc/powach.F90 +++ /dev/null @@ -1,550 +0,0 @@ -! Copyright (C) 2001 Ernst Maier-Reimer, S. Legutke -! 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. -! -! 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. -! -! 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 powach(kpie,kpje,kpke,kbnd,prho,omask,psao,lspin) - !****************************************************************************** - ! - !**** *POWACH* - . - ! - ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 - ! - ! Modified - ! -------- - ! S.Legutke, *MPI-MaD, HH* 10.04.01 - ! - ! Purpose - ! ------- - ! . - ! - ! Method - ! ------- - ! . - ! - !** Interface. - ! ---------- - ! - ! *CALL* *POWACH* - ! - ! *COMMON* *PARAM1_BGC.h* - declaration of ocean/sediment tracer. - ! - !** Interface to ocean model (parameter list): - ! ----------------------------------------- - ! - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. - ! *INTEGER* *kbnd* - nb of halo grid points - ! *REAL* *prho* - seawater density [g/cm^3]. - ! *REAL* *psao* - salinity [psu]. - ! *REAL* *omask* - land/ocean mask - ! - ! Externals - ! --------- - ! none. - ! - !****************************************************************************** - 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,ipowc13,ipowc14,isssc13,isssc14,issso13,issso14,safediv - use mo_carbch, only: co3,keqb,ocetra,sedfluxo - use mo_chemcon, only: calcon - use mo_param_bgc, only: rnit,ro2ut,disso_sil,silsat,disso_poc,sed_denit,disso_caco3 - use mo_sedmnt, only: porwat,porsol,powtra,produs,prcaca,prorca,seddw,sedhpl,sedlay,silpro,pror13,pror14,prca13,prca14 - use mo_vgrid, only: kbo,bolay - - implicit none - - integer, intent(in) :: kpie,kpje,kpke,kbnd - real, intent(in) :: prho(kpie,kpje,kpke) - real, intent(in) :: omask(kpie,kpje) - real, intent(in) :: psao(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) - logical, intent(in) :: 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) - 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 - integer, parameter :: niter = 5 ! number of iterations for carchm_solve - - !****************************************************************************** - - ! Set array for saving diffusive sediment-water-column fluxes to zero - sedfluxo(:,:,:) = 0.0 - - ! A LOOP OVER J - ! RJ: This loop must go from 1 to kpje in the parallel version, - ! otherways we had to do a boundary exchange - - - !$OMP PARALLEL DO & - !$OMP&PRIVATE(sedb1,sediso,solrat,powcar,aerob,anaerob, & - !$OMP& dissot,undsa,posol, & - !$OMP& umfa,denit,saln,rrho,alk,c,sit,pt, & - !$OMP& K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p, & - !$OMP& ah1,ac,cu,cb,cc,satlev, & - !$OMP& ratc13,ratc14,rato13,rato14,poso13,poso14, & - !$OMP& k,i) - - j_loop: do j = 1, kpje - - do k = 1, ks - do i = 1, kpie - solrat(i,k) = 0. - powcar(i,k) = 0. - anaerob(i,k)= 0. - aerob(i,k) = 0. - if (use_cisonew) then - anaerob13(i,k)=0. - aerob13(i,k) =0. - anaerob14(i,k)=0. - aerob14(i,k) =0. - endif - enddo - enddo - - do k = 0, ks - do i = 1, kpie - sedb1(i,k) = 0. - sediso(i,k) = 0. - enddo - enddo - - - ! Calculate silicate-opal cycle and simultaneous silicate diffusion - !****************************************************************** - - ! Dissolution rate constant of opal (disso) [1/(kmol Si(OH)4/m3)*1/sec]*dtbgc - dissot=disso_sil - - ! Evaluate boundary conditions for sediment-water column exchange. - ! Current undersaturation of bottom water: sedb(i,0) and - ! Approximation for new solid sediment, as from sedimentation flux: solrat(i,1) - - do i = 1, kpie - if(omask(i,j) > 0.5) then - undsa = silsat - powtra(i,j,1,ipowasi) - sedb1(i,0) = bolay(i,j) * (silsat - ocetra(i,j,kbo(i,j),isilica)) - solrat(i,1) = ( sedlay(i,j,1,issssil) & - & + silpro(i,j) / (porsol(i,j,1) * seddw(1)) ) & - & * dissot / (1. + dissot * undsa) * porsol(i,j,1) / porwat(i,j,1) - endif - enddo - - - ! Evaluate sediment undersaturation and degradation. - ! Current undersaturation in pore water: sedb(i,k) and - ! Approximation for new solid sediment, as from degradation: solrat(i,k) - - do k = 1, ks - do i = 1, kpie - if(omask(i,j) > 0.5) then - undsa = silsat - powtra(i,j,k,ipowasi) - sedb1(i,k) = seddw(k) * porwat(i,j,k) * (silsat - powtra(i,j,k,ipowasi)) - if ( k > 1 ) solrat(i,k) = sedlay(i,j,k,issssil) & - & * dissot / (1. + dissot * undsa) * porsol(i,j,k) / porwat(i,j,k) - endif - enddo - enddo - - ! Solve for new undersaturation sediso, from current undersaturation sedb1, - ! and first guess of new solid sediment solrat. - - call powadi(j,kpie,kpje,solrat,sedb1,sediso,omask) - - ! Update water column silicate, and store the flux for budget. - ! Add sedimentation to first layer. - - do i = 1, kpie - if(omask(i,j) > 0.5) then - if(.not. lspin) then - sedfluxo(i,j,ipowasi) = & - & -(silsat - sediso(i,0) - ocetra(i,j,kbo(i,j),isilica)) & - & * bolay(i,j) - ocetra(i,j,kbo(i,j),isilica) = silsat - sediso(i,0) - endif - sedlay(i,j,1,issssil) = & - & sedlay(i,j,1,issssil) + silpro(i,j) / (porsol(i,j,1) * seddw(1)) - endif - enddo - - - ! Calculate updated degradation rate from updated undersaturation. - ! Calculate new solid sediment. - ! Update pore water concentration from new undersaturation. - - do k = 1, ks - do i = 1, kpie - if(omask(i,j) > 0.5) then - umfa = porsol(i,j,k)/porwat(i,j,k) - solrat(i,k) = sedlay(i,j,k,issssil) * dissot & - & / (1. + dissot * sediso(i,k)) - posol = sediso(i,k) * solrat(i,k) - sedlay(i,j,k,issssil) = sedlay(i,j,k,issssil) - posol - powtra(i,j,k,ipowasi) = silsat - sediso(i,k) - endif - enddo - enddo - - ! Calculate oxygen-POC cycle and simultaneous oxygen diffusion - !************************************************************* - - ! Degradation rate constant of POP (disso) [1/(kmol O2/m3)*1/sec]*dtbgc - dissot = disso_poc - - ! This scheme is not based on undersaturation, but on O2 itself - - ! Evaluate boundary conditions for sediment-water column exchange. - ! Current concentration of bottom water: sedb(i,0) and - ! Approximation for new solid sediment, as from sedimentation flux: solrat(i,1) - - do i = 1, kpie - if(omask(i,j) > 0.5) then - undsa = powtra(i,j,1,ipowaox) - sedb1(i,0) = bolay(i,j) * ocetra(i,j,kbo(i,j),ioxygen) - solrat(i,1) = ( sedlay(i,j,1,issso12) + prorca(i,j) & - & / (porsol(i,j,1) * seddw(1)) ) & - & * ro2ut * dissot / (1. + dissot * undsa) & - & * porsol(i,j,1) / porwat(i,j,1) - endif - enddo - - ! Evaluate sediment concentration and degradation. - ! Current concentration in pore water: sedb(i,k) and - ! Approximation for new solid sediment, as from degradation: solrat(i,k) - - do k = 1, ks - do i = 1, kpie - if(omask(i,j) > 0.5) then - undsa = powtra(i,j,k,ipowaox) - sedb1(i,k) = seddw(k) * porwat(i,j,k) * powtra(i,j,k,ipowaox) - if (k > 1) solrat(i,k) = sedlay(i,j,k,issso12) * ro2ut * dissot & - & / (1. + dissot*undsa) * porsol(i,j,k) / porwat(i,j,k) - endif - enddo - enddo - - ! Solve for new O2 concentration sediso, from current concentration sedb1, - ! and first guess of new solid sediment solrat. - - call powadi(j,kpie,kpje,solrat,sedb1,sediso,omask) - - ! Update water column oxygen, and store the diffusive flux for budget (sedfluxo, - ! positive downward). Add sedimentation to first layer. - - do i = 1, kpie - if(omask(i,j) > 0.5) then - if(.not. lspin) then - sedfluxo(i,j,ipowaox) = & - & -(sediso(i,0) - ocetra(i,j,kbo(i,j),ioxygen)) & - & * bolay(i,j) - ocetra(i,j,kbo(i,j),ioxygen) = sediso(i,0) - endif - sedlay(i,j,1,issso12) = & - & sedlay(i,j,1,issso12) + prorca(i,j) / (porsol(i,j,1)*seddw(1)) - 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)) - endif - endif - enddo - - - ! Calculate updated degradation rate from updated concentration. - ! Calculate new solid sediment. - ! Update pore water concentration. - ! Store flux in array aerob, for later computation of DIC and alkalinity. - do k = 1, ks - do i = 1, kpie - if(omask(i,j) > 0.5) then - umfa = porsol(i,j,k) / porwat(i,j,k) - 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 - 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 - endif - 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) - 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 - endif - endif - enddo - enddo - - ! Calculate nitrate reduction under anaerobic conditions explicitely - !******************************************************************* - - ! Denitrification rate constant of POP (disso) [1/sec]*dtbgc - denit = sed_denit - do k = 1, ks - do i = 1, kpie - if(omask(i,j) > 0.5) then - if(powtra(i,j,k,ipowaox) < 1.e-6) then - posol = denit * MIN(0.5*powtra(i,j,k,ipowno3)/114., & - & 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 - 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 - endif - 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 - 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 - endif - endif - endif - enddo - enddo - - - ! sulphate reduction in sediments - do k = 1, ks - do i = 1, kpie - if(omask(i,j) > 0.5) then - if(powtra(i,j,k,ipowaox) < 3.e-6 .and. powtra(i,j,k,ipowno3) < 3.e-6) then - posol = denit * sedlay(i,j,k,issso12) ! remineralization of poc - 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 - 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 - endif - 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*rnit - 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 - endif - endif - endif - enddo - enddo ! end sulphate reduction - - - ! Calculate CaCO3-CO3 cycle and simultaneous CO3-undersaturation diffusion - !************************************************************************* - - - ! Compute new powcar, carbonate ion concentration in the sediment - ! from changed alkalinity (nitrate production during remineralisation) - ! and DIC gain. Iterate 5 times. This changes pH (sedhpl) of sediment. - - do k = 1, ks - do i = 1, kpie - if(omask(i,j) > 0.5) then - saln= min( 40., max( 0., psao(i,j,kbo(i,j)))) - rrho= prho(i,j,kbo(i,j)) - alk = (powtra(i,j,k,ipowaal) - (anaerob(i,k)+aerob(i,k))*16.) / rrho - c = (powtra(i,j,k,ipowaic) + (anaerob(i,k)+aerob(i,k))*122.) / rrho - sit = powtra(i,j,k,ipowasi) / rrho - pt = powtra(i,j,k,ipowaph) / rrho - ah1 = sedhpl(i,j,k) - K1 = keqb( 1,i,j) - K2 = keqb( 2,i,j) - Kb = keqb( 3,i,j) - Kw = keqb( 4,i,j) - Ks1 = keqb( 5,i,j) - Kf = keqb( 6,i,j) - Ksi = keqb( 7,i,j) - K1p = keqb( 8,i,j) - K2p = keqb( 9,i,j) - K3p = keqb(10,i,j) - - call carchm_solve(saln,c,alk,sit,pt, & - & K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p, & - & ah1,ac,niter) - - cu = ( 2. * c - ac ) / ( 2. + K1 / ah1 ) - cb = K1 * cu / ah1 - cc = K2 * cb / ah1 - sedhpl(i,j,k) = max( 1.e-20, ah1 ) - powcar(i,k) = cc * rrho - endif - enddo - enddo - - - ! Dissolution rate constant of CaCO3 (disso) [1/(kmol CO3--/m3)*1/sec]*dtbgc - dissot = disso_caco3 - - ! Evaluate boundary conditions for sediment-water column exchange. - ! Current undersaturation of bottom water: sedb(i,0) and - ! Approximation for new solid sediment, as from sedimentation flux: solrat(i,1) - - ! CO3 saturation concentration is aksp/calcon as in CARCHM - ! (calcon defined in MO_CHEMCON with 1.028e-2; 1/calcon =~ 97.) - - do i = 1, kpie - if(omask(i,j) > 0.5) then - satlev = keqb(11,i,j) / calcon + 2.e-5 - undsa = MAX( satlev-powcar(i,1), 0. ) - sedb1(i,0) = bolay(i,j) * (satlev-co3(i,j,kbo(i,j))) - solrat(i,1) = (sedlay(i,j,1,isssc12) & - & + prcaca(i,j) / (porsol(i,j,1)*seddw(1))) & - & * dissot / (1.+dissot*undsa) * porsol(i,j,1) / porwat(i,j,1) - endif - enddo - - ! Evaluate sediment undersaturation and degradation. - ! Current undersaturation in pore water: sedb(i,k) and - ! Approximation for new solid sediment, as from degradation: solrat(i,k) - - do k = 1, ks - do i = 1, kpie - if(omask(i,j) > 0.5) then - undsa = MAX( keqb(11,i,j) / calcon - powcar(i,k), 0. ) - sedb1(i,k) = seddw(k) * porwat(i,j,k) * undsa - if (k > 1) solrat(i,k) = sedlay(i,j,k,isssc12) & - & * dissot/(1.+dissot*undsa) * porsol(i,j,k)/porwat(i,j,k) - if (undsa <= 0.) solrat(i,k) = 0. - endif - enddo - enddo - - ! Solve for new undersaturation sediso, from current undersaturation sedb1, - ! and first guess of new solid sediment solrat. - - call powadi(j,kpie,kpje,solrat,sedb1,sediso,omask) - - ! There is no exchange between water and sediment with respect to co3 so far. - ! Add sedimentation to first layer. - do i = 1, kpie - 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)) - 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)) - endif - endif - enddo - - ! Calculate updated degradation rate from updated undersaturation. - ! Calculate new solid sediment. - ! No update of powcar pore water concentration from new undersaturation so far. - ! Instead, only update DIC, and, of course, alkalinity. - ! This also includes gains from aerobic and anaerobic decomposition. - - do k = 1, ks - do i = 1, kpie - if(omask(i,j) > 0.5) then - umfa = porsol(i,j,k) / porwat(i,j,k) - solrat(i,k) = sedlay(i,j,k,isssc12) & - & * dissot / (1. + dissot * sediso(i,k)) - posol = sediso(i,k) * solrat(i,k) - 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 - endif - 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)) - 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. - endif - endif - enddo - enddo - - enddo j_loop - - !$OMP END PARALLEL DO - - call dipowa(kpie,kpje,kpke,omask,lspin) - - - !ik add clay sedimentation onto sediment - !ik this is currently assumed to depend on total and corg sedimentation: - !ik f(POC) [kg C] / f(total) [kg] = 0.05 - !ik thus it is - !$OMP PARALLEL DO PRIVATE(i) - do j = 1, kpje - do i = 1, kpie - sedlay(i,j,1,issster) = sedlay(i,j,1,issster) & - & + produs(i,j) / (porsol(i,j,1) * seddw(1)) - enddo - enddo - !$OMP END PARALLEL DO - - - if(.not. lspin) then - !$OMP PARALLEL DO PRIVATE(i) - do j = 1, kpje - do i = 1, kpie - silpro(i,j) = 0. - prorca(i,j) = 0. - prcaca(i,j) = 0. - if (use_cisonew) then - pror13(i,j) = 0. - pror14(i,j) = 0. - prca13(i,j) = 0. - prca14(i,j) = 0. - endif - produs(i,j) = 0. - enddo - enddo - !$OMP END PARALLEL DO - endif - -end subroutine powach diff --git a/hamocc/powadi.F90 b/hamocc/powadi.F90 deleted file mode 100644 index 46ccf03a..00000000 --- a/hamocc/powadi.F90 +++ /dev/null @@ -1,136 +0,0 @@ -! Copyright (C) 2001 Ernst Maier-Reimer, S. Legutke -! 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. -! -! 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. -! -! 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 powadi(j,kpie,kpje,solrat,sedb1,sediso,omask) - !********************************************************************** - ! - !**** *POWADI* - vertical diffusion with simultaneous dissolution. - ! - ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 - ! - ! Modified - ! -------- - ! S.Legutke, *MPI-MaD, HH* 10.04.01 - ! - ! Purpose - ! ------- - ! . - ! - ! Method - ! ------- - ! implicit discretisation. - ! - !** Interface. - ! ---------- - ! - ! *CALL* *POWADI(j,solrat,sedb1,sediso)* - ! - ! Input solrat : dissolution rate - ! ===== j : zonal grid index - ! sedb1 : tracer at entry - ! - ! Output: sediso: diffused tracer at exit - ! ====== - ! - ! *PARAMETER* *PARAM1_BGC.h* - declaration of ocean/sediment tracer. - ! - ! Externals - ! --------- - ! none. - ! - !********************************************************************** - - use mo_sedmnt, only: porwah,porwat,seddw,seddzi - use mo_param_bgc, only: sedict - use mo_param1_bgc, only: ks - use mo_vgrid, only: bolay - - implicit none - - integer, intent(in) :: j, kpie, kpje - real, dimension(kpie,ks), intent(in) :: solrat - real, dimension(kpie,0:ks), intent(inout) :: sedb1, sediso - real, dimension(kpie,kpje), intent(in) :: omask - - ! Local variables - integer :: i,k,l - real :: asu, alo - real, dimension(kpie,0:ks,3) :: tredsy - - !********************************************************************** - - do k = 1, ks - do i = 1, kpie - asu = sedict * seddzi(k) * porwah(i,j,k) - alo = 0. - if(k < ks) alo = sedict * seddzi(k+1) * porwah(i,j,k+1) - tredsy(i,k,1) = -asu - tredsy(i,k,3) = -alo - tredsy(i,k,2) = seddw(k) * porwat(i,j,k) - tredsy(i,k,1) & - & - tredsy(i,k,3) + solrat(i,k) * porwat(i,j,k) * seddw(k) - enddo - enddo - - k = 0 - asu = 0. - do i = 1, kpie - alo = sedict * seddzi(1) * porwah(i,j,1) - if(omask(i,j) > 0.5) then - tredsy(i,k,1) = -asu - tredsy(i,k,3) = -alo - tredsy(i,k,2) = bolay(i,j) - tredsy(i,k,1) - tredsy(i,k,3) - else - tredsy(i,k,1) = 0 - tredsy(i,k,3) = 0 - tredsy(i,k,2) = 0 - endif - enddo - - do k = 1, ks - do i = 1, kpie - if(omask(i,j) > 0.5) then - tredsy(i,k-1,1) = tredsy(i,k,1) / tredsy(i,k-1,2) - tredsy(i,k,2) = tredsy(i,k,2) & - & - tredsy(i,k-1,3) * tredsy(i,k,1) / tredsy(i,k-1,2) - endif - enddo - enddo - - do k = 1, ks - do i = 1, kpie - sedb1(i,k) = sedb1(i,k) - tredsy(i,k-1,1) * sedb1(i,k-1) - enddo - enddo - - k = ks - do i = 1, kpie - if(omask(i,j) > 0.5) sediso(i,k) = sedb1(i,k) / tredsy(i,k,2) - enddo - - do k = 1, ks - l = ks - k - do i = 1, kpie - if(omask(i,j) > 0.5) then - sediso(i,l) = ( sedb1(i,l) - tredsy(i,l,3) * sediso(i,l+1) ) & - & / tredsy(i,l,2) - endif - enddo - enddo - -end subroutine powadi diff --git a/hamocc/preftrc.F90 b/hamocc/preftrc.F90 deleted file mode 100644 index a0f4e29a..00000000 --- a/hamocc/preftrc.F90 +++ /dev/null @@ -1,69 +0,0 @@ -! Copyright (C) 2020 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. -! -! 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. -! -! 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 PREFTRC(kpie,kpje,omask) - !**************************************************************** - ! - !**** *PREFTRC* - update preformed tracers in the mixed layer. - ! - ! J. Tjiputra, J.Schwinger, *BCCR, Bergen* 2015-01-23 - ! - ! Modified - ! -------- - ! J.Tjiputra, *Uni Research, Bergen* 2018-04-12 - ! - added preformed DIC tracer - ! - ! - ! Method - ! ------- - ! Preformed tracers are set to the value of their full counterparts - ! in the mixed layer. - ! - ! - !** Interface to ocean model (parameter list): - ! ----------------------------------------- - ! - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! - !************************************************************************** - - use mo_carbch, only: ocetra - use mo_param1_bgc, only: ialkali,ioxygen,iphosph,iprefalk,iprefdic,iprefo2,iprefpo4,isco212 - use mo_vgrid, only: kmle - - implicit none - - INTEGER :: kpie,kpje - REAL :: omask(kpie,kpje) - - INTEGER :: i,j - - do j=1,kpje - do i=1,kpie - if (omask(i,j) .gt. 0.5 ) then - ocetra(i,j,1:kmle(i,j),iprefo2) = ocetra(i,j,1:kmle(i,j),ioxygen) - ocetra(i,j,1:kmle(i,j),iprefpo4) = ocetra(i,j,1:kmle(i,j),iphosph) - ocetra(i,j,1:kmle(i,j),iprefalk) = ocetra(i,j,1:kmle(i,j),ialkali) - ocetra(i,j,1:kmle(i,j),iprefdic) = ocetra(i,j,1:kmle(i,j),isco212) - endif - enddo - enddo - - -END SUBROUTINE PREFTRC diff --git a/hamocc/profile_gd.F90 b/hamocc/profile_gd.F90 deleted file mode 100644 index 0b4bfd24..00000000 --- a/hamocc/profile_gd.F90 +++ /dev/null @@ -1,188 +0,0 @@ -! Copyright (C) 2020 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. -! -! 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. -! -! 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 profile_gd(kpie,kpje,kpke,kbnd,pglon,pglat,omask) - !******************************************************************************* - ! J.Schwinger, *Gfi, Bergen* 2011-05-19 - ! - ! Modified - ! -------- - ! J.Schwinger, *Uni Climate, BCCR* 2017-07-07 - ! - moved conversion from mumol to mol to mod_gdata_read - ! - changed linear interpolation from data-levels to model levels to propper - ! mapping of data profile to model-levels - ! - ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 - ! - adaptions for reading c-isotope initial values as d13C and d14C - ! - ! Purpose - ! ------- - ! - initialise HAMOCC fields with gridded (1x1 deg) WOA and GLODAP - ! data using the module mo_Gdata_read. Note that the routine get_profile - ! returns the mean of all data profiles within a rectangular region - ! ("smoothing region") of dxy x dxy degrees extent, where dxy is an - ! adjustable parameter. - ! - ! - !******************************************************************************* - - use mod_xc, only: xchalt - use mo_carbch, only: ocetra - use mo_Gdata_read, only: set_Gdata,clean_Gdata,get_profile,nzmax,nz,zlev_bnds,fillval - use mo_control_bgc, only: io_stdo_bgc - use mo_vgrid, only: ptiestw - use mo_param1_bgc, only: ialkali,iano3,ioxygen,iphosph,isco212,isilica - ! 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 - real, intent(in) :: omask(kpie,kpje) - real, intent(in) :: pglon(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - real, intent(in) :: pglat(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - - ! Local variables - integer :: i,j,k,l,ll,n - integer :: idx,izmax - real :: prf(nzmax),wgt(nzmax),zbnds(2,nzmax),clon,clat - - ! Extent of "smoothing region" - real, parameter :: dxy = 5.0 - - ! Number of fields to read - integer, parameter :: nread_base = 6 - integer, parameter :: nread_ndic = 2 - integer, parameter :: nread_ciso = 2 - integer, parameter :: maxflds = nread_base+nread_ndic+nread_ciso - - integer :: nflds, no - integer :: ifld(maxflds) - character(len=3) :: vname(maxflds) - - nflds = nread_base - vname( 1:nflds) = (/ 'dic', 'alk', 'pho', 'nit','sil', 'oxy' /) - ifld( 1:nflds) = (/ isco212,ialkali,iphosph,iano3,isilica,ioxygen/) - - if (use_natDIC) then - no = nflds+1 - nflds = nflds+nread_ndic - vname(no:nflds) = (/'dic', 'alk'/) - ifld(no:nflds) = (/inatsco212,inatalkali/) - endif - - if (use_cisonew) then - no = nflds+1 - nflds = nflds+nread_ciso - vname(no:nflds) = (/'d13', 'd14'/) - ifld(no:nflds) = (/isco213,isco214/) - endif - - - do n = 1, nflds ! Loop over tracer - - call set_Gdata(vname(n),dxy) - - do j=1,kpje - do i=1,kpie - - If(omask(i,j) > 0.5) THEN - - clon = pglon(i,j) - clat = pglat(i,j) - idx = ifld(n) - call get_profile(clon,clat,prf) - - ! Find depest z-level with valid data - izmax=nz - do l=2,nz - if( prf(l) < fillval*0.1 ) then - izmax = l-1 - exit - endif - enddo - ! Set data level-boundaries for this profile - zbnds = fillval - zbnds(:,1:nz) = zlev_bnds - zbnds(1,1) = 0.0 ! make sure that upper data bnd is 0 - if(zbnds(2,izmax) < ptiestw(i,j,kpke+1)) then - zbnds(2,izmax) = ptiestw(i,j,kpke+1)+10.0 ! extend lower bound of bottom layer - endif - - Do k=1,kpke - - wgt(:)=0.0 - - loop_obs: do l=1,izmax - - ! 1st case: Model layer completely within data-layer - if(zbnds(1,l) <= ptiestw(i,j,k) .and. zbnds(2,l) >= ptiestw(i,j,k+1)) then - ocetra(i,j,k,idx)=prf(l) - exit loop_obs - endif - - ! 2nd case: one (or both) data-layer boundary are within model layer - - ! a) The lower data level-boundary is lower than the upper model level-interface. - ! and the upper data level-boundary is higher than the lower model - ! level-interface => some overlap between data and model level exists. - ! Calculate the corresponding weight. - if(zbnds(2,l) > ptiestw(i,j,k) .and. zbnds(1,l) <= ptiestw(i,j,k+1)) & - wgt(l) = zbnds(2,l)-ptiestw(i,j,k) & - - max(zbnds(1,l)-ptiestw(i,j,k), 0.0) & - - max(zbnds(2,l)-ptiestw(i,j,k+1),0.0) - - ! b) The upper data level-boundary is lower than the lower model level-interface - ! => all weights have been calculated, calculate concentration and exit - if(zbnds(1,l) > ptiestw(i,j,k+1) .or. l==izmax) then - wgt(:) = wgt(:)/(ptiestw(i,j,k+1)-ptiestw(i,j,k)) - if( abs(sum(wgt(:))-1.0) > 1.0e-6 ) then - write(io_stdo_bgc,*) 'profile_gd error: inconsisten weihts' - write(io_stdo_bgc,*) 'profile_gd error: ', k,l,abs(sum(wgt(:))-1.0) - write(io_stdo_bgc,*) 'profile_gd error: ', wgt(1:izmax) - write(io_stdo_bgc,*) 'profile_gd error: ', ptiestw(i,j,k),ptiestw(i,j,k+1) - call flush(io_stdo_bgc) - call xchalt('(profile_gd)') - endif - do ll=1,l - ocetra(i,j,k,idx) = ocetra(i,j,k,idx) + prf(ll)*wgt(ll) - enddo - exit loop_obs - endif - - - enddo loop_obs - - ENDDO ! k=1,kpke - - ENDIF ! omask > 0.5 - - ENDDO - ENDDO - - call clean_Gdata() - - enddo ! Loop over fields - - RETURN - - !******************************************************************************** -END subroutine profile_gd diff --git a/hamocc/read_netcdf_var.F90 b/hamocc/read_netcdf_var.F90 deleted file mode 100644 index 630fab94..00000000 --- a/hamocc/read_netcdf_var.F90 +++ /dev/null @@ -1,155 +0,0 @@ -! Copyright (C) 2020 I. Bethke, M. Bentsen -! -! 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. -! -! 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. -! -! 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 READ_NETCDF_VAR(ncid,desc,arr,klev,time,typeio) - !************************************************************************** - ! - ! Reads a variable from a NETCDF file and distributes it to all PEs - ! - ! The NETCDF File is only accessed by mnproc=1 - ! - !************************************************************************** - use netcdf, only: nf90_noerr,nf90_inq_varid,nf90_strerror,nf90_get_var - use mod_xc, only: idm,itdm,jtdm,jdm,lp,mnproc,nbdy,xchalt,xcaput -#ifdef PNETCDF - use mod_xc, only: i0,ii,jj,j0 -#endif - implicit none -#ifdef PNETCDF -#include -#include -#endif - integer ncid, klev, time, ndims - character (len=*) desc - real arr(idm,jdm,klev),arr_g(itdm,jtdm) - - real, allocatable :: arr_l(:,:,:) - - integer ncstat,ncvarid,i,j,k,typeio - integer :: start(4),count(4) -#ifdef PNETCDF - integer (kind=MPI_OFFSET_KIND) :: istart(4),icount(4) -#endif - - ! Read NETCDF data - - IF(TYPEIO==0) THEN - start=1 - count=0 - start(1)=1 - count(1)=itdm - start(2)=1 - count(2)=jtdm - if (klev.gt.1.or.time.gt.0) then - if (klev.gt.1.and.time.gt.0) then - start(3)=1 - count(3)=1 - start(4)=time - count(4)=1 - else if (klev.gt.1.and.time.eq.0) then - start(3)=1 - count(3)=1 - else - start(3)=time - count(3)=1 - endif - endif - allocate(arr_l(1-nbdy:idm+nbdy,1-nbdy:jdm+nbdy,1)) - - if (mnproc.eq.1) then - ncstat=nf90_inq_varid(ncid,desc,ncvarid) - if (ncstat.ne.nf90_noerr) then - write(lp,'(4a)') 'nf90_inq_varid: ',trim(desc),': ', & - & nf90_strerror(ncstat) - call xchalt('(read_netcdf_var)') - stop '(read_netcdf_var)' - endif - endif - do k=1,klev - if (mnproc.eq.1) then - if (k.gt.1) then - start(3)=k - count(3)=1 - endif - ncstat=nf90_get_var(ncid,ncvarid,arr_g,start,count) - if (ncstat.ne.nf90_noerr) then - write(lp,'(4a)') 'nf90_get_vara_double: ',trim(desc),': ', & - & nf90_strerror(ncstat) - call xchalt('(read_netcdf_var)') - stop '(read_netcdf_var)' - endif - endif - call xcaput(arr_g,arr_l,1) - do j=1,jdm - do i=1,idm - arr(i,j,k)=arr_l(i,j,1) - enddo - enddo - enddo - ELSE IF(TYPEIO==1) THEN -#ifdef PNETCDF - allocate(arr_l(ii,jj,klev)) - arr=0.0 - istart=1 - icount=0 - istart(1)=i0+1 - icount(1)=ii - istart(2)=j0+1 - icount(2)=jj - if (klev.gt.1.or.time.gt.0) then - if (klev.gt.1.and.time.gt.0) then - istart(3)=1 - icount(3)=klev - istart(4)=time - icount(4)=1 - else if (klev.gt.1.and.time.eq.0) then - istart(3)=1 - icount(3)=klev - else - istart(3)=time - icount(3)=1 - endif - endif - - ncstat=nfmpi_inq_varid(ncid,desc,ncvarid) - if (ncstat.ne.nf_noerr) then - write(lp,'(4a)') 'nfmpi_inq_varid: ',trim(desc),': ', & - & nfmpi_strerror(ncstat) - call xchalt('(read_pnetcdf_var)') - stop '(read_pnetcdf_var)' - endif - - ncstat=nfmpi_get_vara_double_all(ncid,ncvarid,istart,icount,arr_l) - if (ncstat.ne.nf_noerr) then - write(lp,'(4a)') 'nfmpi_get_vara_double: ',trim(desc),': ', & - & nfmpi_strerror(ncstat) - call xchalt('(read_pnetcdf_var)') - stop '(read_pnetcdf_var)' - endif - do k=1,klev - do j=1,jj - do i=1,ii - arr(i,j,k)=arr_l(i,j,k) - enddo - enddo - enddo -#endif - ELSE - call xchalt('(read_pnetcdf_var) WRONG IOTYPE') - ENDIF -END SUBROUTINE READ_NETCDF_VAR diff --git a/hamocc/sedshi.F90 b/hamocc/sedshi.F90 deleted file mode 100644 index 71365024..00000000 --- a/hamocc/sedshi.F90 +++ /dev/null @@ -1,304 +0,0 @@ -! Copyright (C) 2001 Ernst Maier-Reimer, S. Legutke -! Copyright (C) 2003 I. Kriest -! 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. -! -! 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. -! -! 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 SEDSHI(kpie,kpje,omask) - !********************************************************************** - ! - !**** *SEDSHI* - . - ! - ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 - ! - ! Modified - ! -------- - ! S.Legutke, *MPI-MaD, HH* 10.04.01 - ! - rename ssssil(i,j,k)=sedlay(i,j,k,issssil) etc. - ! I. Kriest *MPI-Met, HH*, 27.05.03 - ! - change specific weights for opal, CaCO3, POC - ! - include upward transport - ! Purpose - ! ------- - ! . - ! - ! Method - ! ------- - ! . - ! - !** Interface. - ! ---------- - ! - ! *CALL* *SEDSHI* - ! - ! Externals - ! --------- - ! none. - ! - !********************************************************************** - - use mo_sedmnt, only: burial,calfa,clafa,oplfa,orgfa,porsol,sedlay,seddw,solfu - use mo_param_bgc, only: rcar - 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 - REAL :: pdlxp(kpie,kpje),pdlyp(kpie,kpje),omask(kpie,kpje) - REAL :: wsed(kpie,kpje), fulsed(kpie,kpje) - REAL :: sedlo,uebers,seddef,spresent,buried - REAL :: refill,frac - - ! DOWNWARD SHIFTING - ! shift solid sediment sediment downwards, if layer is full, i.e., if - ! the volume filled by the four constituents poc, opal, caco3, clay - ! is more than porsol*seddw - ! the outflow of layer i is given by sedlay(i)*porsol(i)*seddw(i), it is - ! distributed in the layer below over a volume of porsol(i+1)*seddw(i+1) - - do k=1,ks-1 - - !$OMP PARALLEL DO PRIVATE(i,sedlo) - do j=1,kpje - do i=1,kpie - if(omask(i,j).gt.0.5) then - !ka if(bolay(i,j).gt.0.) then - sedlo = orgfa*rcar*sedlay(i,j,k,issso12) & - & +calfa*sedlay(i,j,k,isssc12) & - & +oplfa*sedlay(i,j,k,issssil) & - & +clafa*sedlay(i,j,k,issster) - ! "full sediment has sedlo=1 - wsed(i,j)=max(0.,(sedlo-1.)/(sedlo+1.e-10)) - endif - enddo !end i-loop - enddo !end j-loop - !$OMP END PARALLEL DO - - ! filling downward (accumulation) - do iv=1,nsedtra - !$OMP PARALLEL DO PRIVATE(i,uebers) - do j=1,kpje - do i=1,kpie - if(omask(i,j).gt.0.5) then - !ka if(bolay(i,j).gt.0.) then - uebers=wsed(i,j)*sedlay(i,j,k,iv) - sedlay(i,j,k ,iv)=sedlay(i,j,k ,iv)-uebers - sedlay(i,j,k+1,iv)=sedlay(i,j,k+1,iv)+uebers & - & *(seddw(k)*porsol(i,j,k))/(seddw(k+1)*porsol(i,j,k+1)) - endif - enddo !end i-loop - enddo !end j-loop - !$OMP END PARALLEL DO - enddo !end iv-loop - - enddo !end k-loop - - - ! store amount lost from last sediment layer - this is a kind of - ! permanent burial in deep consolidated layer, and this stuff is - ! effectively lost from the whole ocean+sediment(+atmosphere) system. - ! Would have to be supplied by river runoff or simple addition e.g. - ! to surface layers in the long range. Can be supplied again if a - ! sediment column has a deficiency in volume. - - !$OMP PARALLEL DO PRIVATE(i,sedlo) - do j=1,kpje - do i=1,kpie - if(omask(i,j).gt.0.5) then - !ka if(bolay(i,j).gt.0.) then - sedlo = orgfa*rcar*sedlay(i,j,ks,issso12) & - & +calfa*sedlay(i,j,ks,isssc12) & - & +oplfa*sedlay(i,j,ks,issssil) & - & +clafa*sedlay(i,j,ks,issster) - wsed(i,j)=max(0.,(sedlo-1.)/(sedlo+1.e-10)) - endif - enddo !end i-loop - enddo !end j-loop - !$OMP END PARALLEL DO - - do iv=1,nsedtra - !$OMP PARALLEL DO PRIVATE(i,uebers) - do j=1,kpje - do i=1,kpie - if(omask(i,j).gt.0.5) then - !ka if(bolay(i,j).gt.0.) then - uebers=wsed(i,j)*sedlay(i,j,k,iv) - sedlay(i,j,ks ,iv)=sedlay(i,j,ks ,iv)-uebers - burial(i,j,iv)=burial(i,j,iv)+uebers*seddw(k)*porsol(i,j,k) - endif - enddo !end i-loop - enddo !end j-loop - !$OMP END PARALLEL DO - enddo !end iv-loop - - ! now the loading nowhere excceds 1 - - ! digging from below in case of erosion - ! UPWARD SHIFTING - ! shift solid sediment sediment upwards, if total sediment volume is less - ! than required, i.e., if the volume filled by the four constituents - ! poc, opal, caco3, claycik (integrated over total sediment column) - ! is less than porsol*seddw (integrated over total sediment column) - ! first, the last box is filled from below with total required volume; - ! then, successively, the following layers are filled upwards. - ! if there is not enough solid matter to fill the column, add clay. - - !$OMP PARALLEL DO PRIVATE(i) - do j=1,kpje - do i=1,kpie - fulsed(i,j)=0. - enddo !end i-loop - enddo !end j-loop - !$OMP END PARALLEL DO - - ! determine how the total sediment column is filled - do k=1,ks - !$OMP PARALLEL DO PRIVATE(i,sedlo) - do j=1,kpje - do i=1,kpie - if(omask(i,j).gt.0.5) then - !ka if(bolay(i,j).gt.0.) then - sedlo=orgfa*rcar*sedlay(i,j,k,issso12) & - & +calfa*sedlay(i,j,k,isssc12) & - & +oplfa*sedlay(i,j,k,issssil) & - & +clafa*sedlay(i,j,k,issster) - fulsed(i,j)=fulsed(i,j)+porsol(i,j,k)*seddw(k)*sedlo - endif - enddo !end i-loop - enddo !end j-loop - !$OMP END PARALLEL DO - enddo !end k-loop - - ! shift the sediment deficiency from the deepest (burial) - ! layer into layer ks - !$OMP PARALLEL DO & - !$OMP&PRIVATE(i,seddef,spresent,buried,refill,frac) - do j=1,kpje - do i=1,kpie - if(omask(i,j).gt.0.5) then - !ka if(bolay(i,j).gt.0.) then - - ! deficiency to fully loaded sediment packed in sedlay(i,j,ks) - ! this is the volume required from the buried layer - - seddef=solfu(i,j)-fulsed(i,j) - - ! total volume of solid constituents in buried layer - spresent=orgfa*rcar*burial(i,j,issso12) & - & +calfa*burial(i,j,isssc12) & - & +oplfa*burial(i,j,issssil) & - & +clafa*burial(i,j,issster) - - ! determine whether an additional amount of clay is needed in the burial - ! layer to fill the whole sediment; I assume that there is an infinite - ! supply of clay from below - burial(i,j,issster) = burial(i,j,issster) & - & + MAX(0.,seddef-spresent)/clafa - - ! determine new volume of buried layer - buried=orgfa*rcar*burial(i,j,issso12) & - & +calfa*burial(i,j,isssc12) & - & +oplfa*burial(i,j,issssil) & - & +clafa*burial(i,j,issster) - - ! fill the last active layer - refill=seddef/(buried+1.e-10) - frac = porsol(i,j,ks)*seddw(ks) - - sedlay(i,j,ks,issso12)=sedlay(i,j,ks,issso12) & - & +refill*burial(i,j,issso12)/frac - sedlay(i,j,ks,isssc12)=sedlay(i,j,ks,isssc12) & - & +refill*burial(i,j,isssc12)/frac - sedlay(i,j,ks,issssil)=sedlay(i,j,ks,issssil) & - & +refill*burial(i,j,issssil)/frac - sedlay(i,j,ks,issster)=sedlay(i,j,ks,issster) & - & +refill*burial(i,j,issster)/frac - - 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 - endif - - ! account for losses in buried sediment - burial(i,j,issso12) = burial(i,j,issso12) & - & - refill*burial(i,j,issso12) - burial(i,j,isssc12) = burial(i,j,isssc12) & - & - refill*burial(i,j,isssc12) - burial(i,j,issssil) = burial(i,j,issssil) & - & - refill*burial(i,j,issssil) - burial(i,j,issster) = burial(i,j,issster) & - & - refill*burial(i,j,issster) - 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) - endif - endif - enddo !end i-loop - enddo !end j-loop - !$OMP END PARALLEL DO - - ! redistribute overload of layer ks - do k=ks,2,-1 - !$OMP PARALLEL DO PRIVATE(i,sedlo) - do j=1,kpje - do i=1,kpie - if(omask(i,j).gt.0.5) then - !ka if(bolay(i,j).gt.0.) then - sedlo=orgfa*rcar*sedlay(i,j,k,issso12) & - & +calfa*sedlay(i,j,k,isssc12) & - & +oplfa*sedlay(i,j,k,issssil) & - & +clafa*sedlay(i,j,k,issster) - wsed(i,j)=max(0.,(sedlo-1.)/(sedlo+1.e-10)) - endif - enddo !end i-loop - enddo !end j-loop - !$OMP END PARALLEL DO - - do iv=1,nsedtra - !$OMP PARALLEL DO PRIVATE(i,uebers,frac) - do j=1,kpje - do i=1,kpie - if(omask(i,j).gt.0.5) then - !ka if(bolay(i,j).gt.0.) then - uebers=sedlay(i,j,k,iv)*wsed(i,j) - frac=porsol(i,j,k)*seddw(k)/(porsol(i,j,k-1)*seddw(k-1)) - sedlay(i,j,k,iv)=sedlay(i,j,k,iv)-uebers - sedlay(i,j,k-1,iv)=sedlay(i,j,k-1,iv)+uebers*frac - endif - enddo !end i-loop - enddo !end j-loop - !$OMP END PARALLEL DO - enddo !end iv-loop - - enddo !end k-loop - - RETURN -END SUBROUTINE SEDSHI diff --git a/hamocc/trc_limitc.F90 b/hamocc/trc_limitc.F90 deleted file mode 100644 index ed268dcb..00000000 --- a/hamocc/trc_limitc.F90 +++ /dev/null @@ -1,130 +0,0 @@ -! Copyright (C) 2020 J. Schwinger, M. Bentsen -! -! 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. -! -! 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. -! -! 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 trc_limitc(nn) - !*********************************************************************** - ! - !**** *SUBROUTINE trc_limitc* - remove negative tracer values. - ! - ! J. Schwinger *GFI, UiB initial version, 2014-06-17 - ! - - ! - ! Modified - ! -------- - ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 - ! - fixed a bug related to the 2 time-level scheme - ! - ! - ! - ! Purpose - ! ------- - ! Remove negative tracer values in the first layer in a mass - ! conservative fashion (i.e. the mass deficit removed is - ! transfered to non-negative points by a multiplicative - ! correction). This is done since the virtual tracer fluxes - ! (applied in mxlayr.F directly before HAMOCC is called) can - ! cause negative tracer values in regions with low concentration - ! and strong precipitation. - ! - !*********************************************************************** - use mod_xc, only: ii,jj,ips,ifp,isp,ilp,xcsum - use mod_grid, only: scp2 - use mod_state, only: dp - use mod_tracers, only: ntrbgc, itrbgc, trc - use mod_utility, only: util1 - - implicit none - - integer :: nn - integer :: i,j,l,nt,kn - real :: trbudo(ntrbgc),trbudn,q - - ! --- ------------------------------------------------------------------ - ! --- - compute tracer budgets before removing negative values - ! --- ------------------------------------------------------------------ - - kn=1+nn - - do nt=1,ntrbgc - - util1(:,:)=0. - - !$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)) - util1(i,j) = util1(i,j)+trc(i,j,kn,itrbgc+nt-1)*dp(i,j,kn)*scp2(i,j) - enddo - enddo - enddo - !$OMP END PARALLEL DO - - call xcsum(trbudo(nt),util1,ips) - - enddo - - ! --- ------------------------------------------------------------------ - ! --- - remove negative tracer values in the surface layer - ! --- ------------------------------------------------------------------ - - !$OMP PARALLEL DO PRIVATE(j,l,i) - do nt=itrbgc,itrbgc+ntrbgc-1 - do j=1,jj - do l=1,isp(j) - do i=max(1,ifp(j,l)),min(ii,ilp(j,l)) - trc(i,j,kn,nt) = max(trc(i,j,kn,nt),0.0) - enddo - enddo - enddo - enddo - !$OMP END PARALLEL DO - - ! --- ------------------------------------------------------------------ - ! --- - recalculate and correct tracer budgets - ! --- ------------------------------------------------------------------ - - do nt=1,ntrbgc - - util1(:,:)=0. - - !$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)) - util1(i,j) = util1(i,j)+trc(i,j,kn,itrbgc+nt-1)*dp(i,j,kn)*scp2(i,j) - enddo - enddo - enddo - !$OMP END PARALLEL DO - - call xcsum(trbudn,util1,ips) - q = trbudo(nt)/max(1.e-14,trbudn) - - !$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)) - trc(i,j,kn,itrbgc+nt-1) = trc(i,j,kn,itrbgc+nt-1)*q - enddo - enddo - enddo - !$OMP END PARALLEL DO - - enddo - -end subroutine trc_limitc diff --git a/hamocc/write_netcdf_var.F90 b/hamocc/write_netcdf_var.F90 deleted file mode 100644 index bf6eeeae..00000000 --- a/hamocc/write_netcdf_var.F90 +++ /dev/null @@ -1,189 +0,0 @@ -! Copyright (C) 2020 I. Bethke, M. Bentsen -! -! 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. -! -! 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. -! -! 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 WRITE_NETCDF_VAR(ncid,desc,arr,klev,time) - !************************************************************************** - ! - ! Gathers a global variable from all PEs and writes it to a NETCDF file - ! - ! The NETCDF File is only accessed by mnproc=1 - ! - !************************************************************************** - use netcdf, only: nf90_noerr,nf90_inq_varid,nf90_strerror,nf90_put_var - use mod_xc, only: itdm,jtdm,jdm,lp,mnproc,nbdy,idm,xchalt,xcaget - use mod_dia, only: iotype -#ifdef PNETCDF - use mod_xc, only: i0,ii,jj,j0,mproc,mpe_1,nproc,xcgetrow -#endif - implicit none -#ifdef PNETCDF -# include -# include -#endif - integer ncid, klev, time, ndims - character (len=*) desc - real arr(idm,jdm,klev) - - real arr_g(itdm,jtdm) - real , allocatable :: arr_g1(:,:,:),arr_l(:,:,:) - integer ncstat,ncvarid,k,i,j - integer, allocatable :: start(:),count(:) -#ifdef PNETCDF - integer (kind=MPI_OFFSET_KIND), allocatable :: istart(:),icount(:) -#endif - ! Write NETCDF data - - if (klev.eq.1.and.time.eq.0) then - ndims=2 - elseif (klev.eq.1.or.time.eq.0) then - ndims=3 - else - ndims=4 - endif - IF(IOTYPE==0) THEN - allocate(start(ndims)) - allocate(count(ndims)) - allocate(arr_l(1-nbdy:idm+nbdy,1-nbdy:jdm+nbdy,1)) - arr_l=0.0 - start(1)=1 - count(1)=itdm - start(2)=1 - count(2)=jtdm - if (klev.gt.1.or.time.gt.0) then - if (klev.gt.1.and.time.gt.0) then - start(3)=1 - count(3)=1 - start(4)=time - count(4)=1 - else if (klev.gt.1.and.time.eq.0) then - start(3)=1 - count(3)=1 - else - start(3)=time - count(3)=1 - endif - endif - - do k=1,klev - do j=1,jdm - do i=1,idm - arr_l(i,j,1)=arr(i,j,k) - enddo - enddo - call xcaget(arr_g,arr_l,1) - if (mnproc.eq.1) then - if (k.gt.1) then - start(3)=k - count(3)=1 - endif - ncstat=nf90_inq_varid(ncid,desc,ncvarid) - if (ncstat.ne.nf90_noerr) then - write(lp,'(4a)') 'nf90_inq_varid: ',trim(desc),': ', & - & nf90_strerror(ncstat) - call xchalt('(write_netcdf_var)') - stop '(write_netcdf_var)' - endif - ncstat=nf90_put_var(ncid,ncvarid,arr_g,start,count) - if (ncstat.ne.nf90_noerr) then - write(lp,'(4a)') 'nf90_put_var: ',trim(desc),': ', & - & nf90_strerror(ncstat) - call xchalt('(write_netcdf_var)') - stop '(write_netcdf_var)' - endif - ! ncstat=nf90_sync(ncid) - ! if (ncstat.ne.nf90_noerr) then - ! write(lp,'(4a)') 'nf90_sync: ',trim(desc),': ', & - ! & nf90_strerror(ncstat) - ! call xchalt('(write_netcdf_var)') - ! stop '(write_netcdf_var)' - ! endif - endif - enddo - deallocate(start,count) - ELSE IF(IOTYPE==1) THEN -#ifdef PNETCDF - allocate(istart(ndims)) - allocate(icount(ndims)) - allocate(arr_l(ii,jj,klev)) - arr_l=0.0 - if (klev.gt.1.or.time.gt.0) then - if (klev.gt.1.and.time.gt.0) then - istart(3)=1 - icount(3)=klev - istart(4)=time - icount(4)=1 - else if (klev.gt.1.and.time.eq.0) then - istart(3)=1 - icount(3)=klev - else - istart(3)=time - icount(3)=1 - endif - endif - - istart(1)=1 - istart(2)=j0+1 - - if(mproc .eq. mpe_1(nproc) ) then - icount(1)=itdm - icount(2)=jj - else - do i=1,ndims - icount(i)=0 - enddo - endif - - do k=1,klev - do j=1,jj - do i=1,ii - arr_l(i,j,k)=arr(i,j,k) - enddo - enddo - enddo - allocate(arr_g1(itdm,jj,klev)) - arr_g1=0.0 - call xcgetrow(arr_g1, arr_l, klev) - - ncstat=nfmpi_inq_varid(ncid,desc,ncvarid) - if (ncstat.ne.nf_noerr) then - write(lp,'(4a)') 'nfmpi_inq_varid: ',trim(desc),': ', & - & nfmpi_strerror(ncstat) - call xchalt('(write_pnetcdf_var)') - stop '(write_pnetcdf_var)' - endif - ncstat=nfmpi_put_vara_double_all(ncid,ncvarid,istart, & - & icount,arr_g1) - if (ncstat.ne.nf_noerr) then - write(lp,'(4a)') 'nfmpi_put_var: ',trim(desc),': ', & - & nfmpi_strerror(ncstat) - call xchalt('(write_pnetcdf_var)') - stop '(write_pnetcdf_var)' - endif - ! ncstat=nfmpi_sync(ncid) - ! if (ncstat.ne.nf_noerr) then - ! write(lp,'(4a)') 'nfmpi_sync: ',trim(desc),': ', & - ! & nfmpi_strerror(ncstat) - ! call xchalt('(write_pnetcdf_var)') - ! stop '(write_pnetcdf_var)' - ! endif - - deallocate(istart,icount,arr_g1) -#endif - ENDIF - -END SUBROUTINE WRITE_NETCDF_VAR diff --git a/trc/initrc.F b/trc/initrc.F90 similarity index 70% rename from trc/initrc.F rename to trc/initrc.F90 index f6b9ec84..90d464fb 100644 --- a/trc/initrc.F +++ b/trc/initrc.F90 @@ -17,22 +17,24 @@ ! along with BLOM. If not, see . ! ------------------------------------------------------------------------------ - subroutine initrc -c -c --- ------------------------------------------------------------------ -c --- initialization of tracers -c --- ------------------------------------------------------------------ -c - implicit none -c - call ocntrc_init -c +subroutine initrc + ! + ! --- ------------------------------------------------------------------ + ! --- initialization of tracers + ! --- ------------------------------------------------------------------ + ! + use mo_hamocc_init, only: hamocc_init + + implicit none + ! + call ocntrc_init + ! #ifdef HAMOCC - call hamocc_init(0,'c') + call hamocc_init(0,'c') #endif #ifdef IDLAGE - call idlage_init + call idlage_init #endif -c - return - end + ! + return +end subroutine initrc diff --git a/trc/restart_trcrd.F90 b/trc/restart_trcrd.F90 index bbe636fe..2f2183ad 100644 --- a/trc/restart_trcrd.F90 +++ b/trc/restart_trcrd.F90 @@ -25,6 +25,7 @@ subroutine restart_trcrd(rstfnm_ocn) ! use mod_config, only: expcnf use mod_xc + use mo_hamocc_init, only: hamocc_init implicit none diff --git a/trc/restart_trcwt.F90 b/trc/restart_trcwt.F90 index 8438caca..4027d6a9 100644 --- a/trc/restart_trcwt.F90 +++ b/trc/restart_trcwt.F90 @@ -25,6 +25,7 @@ subroutine restart_trcwt(rstfnm_ocn) ! use mod_config, only: expcnf use mod_xc + use mo_restart_hamoccwt, only : restart_hamoccwt implicit none diff --git a/trc/updtrc.F b/trc/updtrc.F90 similarity index 66% rename from trc/updtrc.F rename to trc/updtrc.F90 index 597a0ecf..30e3d60f 100644 --- a/trc/updtrc.F +++ b/trc/updtrc.F90 @@ -17,24 +17,25 @@ ! along with BLOM. If not, see . ! ------------------------------------------------------------------------------ - subroutine updtrc(m,n,mm,nn,k1m,k1n) -c -c --- ------------------------------------------------------------------ -c --- update tracers due to non-passive processes -c --- ------------------------------------------------------------------ -c - use mod_xc -c - implicit none -c - integer m,n,mm,nn,k1m,k1n -c +subroutine updtrc(m,n,mm,nn,k1m,k1n) + ! + ! --- ------------------------------------------------------------------ + ! --- update tracers due to non-passive processes + ! --- ------------------------------------------------------------------ + ! + use mod_xc + use mo_hamocc_step + ! + implicit none + ! + integer m,n,mm,nn,k1m,k1n + ! #ifdef HAMOCC - call hamocc_step(m,n,mm,nn,k1m,k1n) + call hamocc_step(m,n,mm,nn,k1m,k1n) #endif #ifdef IDLAGE - call idlage_step(m,n,mm,nn,k1m,k1n) + call idlage_step(m,n,mm,nn,k1m,k1n) #endif -c - return - end + ! + return +end subroutine updtrc From 7d7e2a5b6a7551625b56f8cd1b1f52889ab3f63e Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 7 Nov 2023 16:28:28 +0100 Subject: [PATCH 5/5] second stage of refactorization --- hamocc/meson.build | 2 +- hamocc/mo_Gdata_read.F90 | 281 ++++------ hamocc/mo_accfields.F90 | 40 +- hamocc/mo_apply_fedep.F90 | 68 +-- hamocc/mo_apply_ndep.F90 | 83 +-- hamocc/mo_apply_oafx.F90 | 64 +-- hamocc/mo_apply_rivin.F90 | 103 ++-- hamocc/mo_aufr_bgc.F90 | 401 +++++++------- hamocc/mo_aufw_bgc.F90 | 483 ++++++++--------- hamocc/mo_bgcmean.F90 | 926 ++++++++++++++------------------- hamocc/mo_biomod.F90 | 344 ++++++------ hamocc/mo_boxatm.F90 | 93 ++-- hamocc/mo_carbch.F90 | 465 ++++++++--------- hamocc/mo_carchm.F90 | 460 ++++++---------- hamocc/mo_chemcon.F90 | 82 ++- hamocc/mo_clim_swa.F90 | 84 ++- hamocc/mo_control_bgc.F90 | 66 ++- hamocc/mo_cyano.F90 | 71 +-- hamocc/mo_dipowa.F90 | 85 ++- hamocc/mo_get_cfc.F90 | 20 +- hamocc/mo_hamocc4bcm.F90 | 158 +++--- hamocc/mo_hamocc_init.F90 | 72 ++- hamocc/mo_hamocc_step.F90 | 12 +- hamocc/mo_ini_fields.F90 | 70 +-- hamocc/mo_intfcblom.F90 | 317 +++++------ hamocc/mo_inventory_bgc.F90 | 240 ++++----- hamocc/mo_ncout_hamocc.F90 | 10 +- hamocc/mo_netcdf_def_vardb.F90 | 219 ++++---- hamocc/mo_ocprod.F90 | 114 ++-- hamocc/mo_param1_bgc.F90 | 31 +- hamocc/mo_param_bgc.F90 | 339 ++++++------ hamocc/mo_powach.F90 | 72 +-- hamocc/mo_powadi.F90 | 57 +- hamocc/mo_preftrc.F90 | 45 +- hamocc/mo_profile_gd.F90 | 46 +- hamocc/mo_read_fedep.F90 | 119 ++--- hamocc/mo_read_ndep.F90 | 118 ++--- hamocc/mo_read_netcdf_var.F90 | 15 +- hamocc/mo_read_oafx.F90 | 156 ++---- hamocc/mo_read_pi_ph.F90 | 76 ++- hamocc/mo_read_rivin.F90 | 100 ++-- hamocc/mo_read_sedpor.F90 | 35 +- hamocc/mo_restart_hamoccwt.F90 | 16 +- hamocc/mo_sedmnt.F90 | 324 +++++------- hamocc/mo_sedshi.F90 | 48 +- hamocc/mo_trc_limitc.F90 | 44 +- hamocc/mo_vgrid.F90 | 201 +++---- hamocc/mo_write_netcdf_var.F90 | 17 +- 48 files changed, 2963 insertions(+), 4329 deletions(-) diff --git a/hamocc/meson.build b/hamocc/meson.build index 0ea8ee2f..255067d5 100644 --- a/hamocc/meson.build +++ b/hamocc/meson.build @@ -2,7 +2,7 @@ sources += files( 'mo_accfields.F90', 'mo_aufr_bgc.F90', 'mo_aufw_bgc.F90', - 'mo_mo_ini_fields.F90', + 'mo_ini_fields.F90', 'mo_carchm.F90', 'mo_cyano.F90', 'mo_dipowa.F90', diff --git a/hamocc/mo_Gdata_read.F90 b/hamocc/mo_Gdata_read.F90 index d977d985..f31a9392 100644 --- a/hamocc/mo_Gdata_read.F90 +++ b/hamocc/mo_Gdata_read.F90 @@ -15,86 +15,76 @@ ! 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_Gdata_read !******************************************************************************** - ! J.Schwinger, *Gfi, Bergen* 2011-05-19 - ! + ! J.Schwinger, *Gfi, Bergen* 2011-05-19 ! Modified ! -------- ! J.Schwinger, *Uni Climate, BCCR* 2017-07-07 ! - adapted this module to read the initial conditions for OMIP-BGC. - ! - ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 ! - adaptions for reading c-isotope initial values as d13C and d14C - ! ! Purpose ! ------- ! - Routines for reading initial condition files for OMIP-BGC, which are based ! on WOA 2013 and GLODAPv2 gridded data netCDF files - ! ! Description: ! ------------ ! Public routines and variable of this module: - ! ! -subroutine set_Gdata ! Initialise global varibles and read in one data set. Must be ! called before the processing of one data set starts. - ! ! -subroutine clean_Gdata ! Deallocate global fields of this module and reset all global variables. ! Should be called each time, the processing of one data set is finished. - ! ! -subroutine get_profile ! Returns one profile from the currently open data set (opened by a ! previous call to set_Gdata). See header of get profile for details. - ! ! -function get_region ! Returns the index of the region a given point belongs to. If no region ! is found get_region returns 0, which is the index of the 'global region'. ! Note that the regions are defined below in the module header. - ! - ! -nz_woa - ! Number of z-levels in the WOA data files. - ! - ! -nz_glo - ! Number of z-levels in the GLODAP data files. - ! - ! -nzmax - ! Max nuber of z-levels (=nzwoa) - ! - ! -zlev - ! Depth of each z-level [m] in the current data file. - ! - ! !******************************************************************************** - use netcdf, only: nf90_noerr,nf90_nowrite,nf90_strerror,nf90_inq_dimid,nf90_inquire_dimension,nf90_inq_varid,nf90_get_var, & - & nf90_inquire_variable,nf90_get_att,nf90_close,nf90_open + use netcdf, only: nf90_noerr,nf90_nowrite,nf90_strerror,nf90_inq_dimid, & + nf90_inquire_dimension,nf90_inq_varid,nf90_get_var, & + nf90_inquire_variable,nf90_get_att,nf90_close,nf90_open use mod_xc, only: mnproc,xchalt use mo_control_bgc, only: io_stdo_bgc implicit none - private - public :: set_Gdata,clean_Gdata,get_profile,get_region,nzmax,nz,zlev,zlev_bnds,fillval + ! routines + public :: set_Gdata + public :: get_profile + public :: get_region + public :: clean_Gdata + + private :: set_regional_profiles + private :: read_Gdata + private :: calc_mean_profile + + ! module variables + public :: zlev ! Depth of each z-level [m] in the current data file. + public :: zlev_bnds + public :: nzmax,nz,fillval public :: inidic,inialk,inipo4,inioxy,inino3,inisil,inid13c,inid14c ! Number of latitudes, longitudes, and z-levels in the WOA and GLODAP data - integer, parameter :: nlon = 360 - integer, parameter :: nlat = 180 - integer, parameter :: nz_woa = 102 - integer, parameter :: nz_glo = 33 - integer, parameter :: nzmax = nz_woa - ! Resolution of data in degree - real, parameter :: dres = 1.0 + integer, parameter :: nlon = 360 + integer, parameter :: nlat = 180 + integer, parameter :: nz_woa = 102 ! Number of z-levels in the WOA data files. + integer, parameter :: nz_glo = 33 ! Number of z-levels in the GLODAP data files. + integer, parameter :: nzmax = nz_woa ! Max nuber of z-levels (=nzwoa) + ! Resolution of data in degree + real, parameter :: dres = 1.0 ! Max number of gridpoints to select around the center for averaging in ! longitude direction - integer, parameter :: dnmax = 100.0 + integer, parameter :: dnmax = 100.0 ! Fill value used in this module, original fill values of data files are @@ -102,29 +92,28 @@ module mo_Gdata_read real, parameter :: fillval = -1.e+32 ! Input file names (incl. full path) set through namelist - character(len=256), save :: inidic = '' - character(len=256), save :: inialk = '' - character(len=256), save :: inipo4 = '' - character(len=256), save :: inioxy = '' - character(len=256), save :: inino3 = '' - character(len=256), save :: inisil = '' - character(len=256), save :: inid13c = '' - character(len=256), save :: inid14c = '' - character(len=256), save :: inic13 = '' ! currently not used - character(len=256), save :: inic14 = '' ! currently not used + character(len=256) :: inidic = '' + character(len=256) :: inialk = '' + character(len=256) :: inipo4 = '' + character(len=256) :: inioxy = '' + character(len=256) :: inino3 = '' + character(len=256) :: inisil = '' + character(len=256) :: inid13c = '' + character(len=256) :: inid14c = '' + character(len=256) :: inic13 = '' ! currently not used + character(len=256) :: inic14 = '' ! currently not used ! Variables set by call to Gdata_set - integer, save :: nz - real, save :: cfac, ddeg - real, save, dimension(:), allocatable :: lon,lat,zlev - real, save, dimension(:,:), allocatable :: zlev_bnds - real, save, dimension(:, :, :), allocatable :: rvar,gdata - character(len=16), save :: var,ncname - character(len=3) , save :: dsrc - character(len=256), save :: infile - - logical, save :: lset = .false. + integer :: nz + real :: cfac, ddeg + real, dimension(:), allocatable :: lon,lat,zlev + real, dimension(:,:), allocatable :: zlev_bnds + real, dimension(:, :, :), allocatable :: rvar,gdata + character(len=16) :: var,ncname + character(len=3) :: dsrc + character(len=256) :: infile + logical :: lset = .false. !----------------------------------------- ! Definitions for regional mean profiles: @@ -142,7 +131,6 @@ module mo_Gdata_read integer, parameter :: nreg=10 type(region) :: rg(0:nreg) - ! Set regions for fall-back profiles ! Global profile; @@ -205,53 +193,40 @@ module mo_Gdata_read data rg(9)%dlon, rg(9)%dlat / 180.0, 30.0 / data rg(9)%global / .false. / - ! Southern Ocean data rg(10)%idx, rg(10)%name / 10, 'Southern Ocean' / data rg(10)%clon, rg(10)%clat / 180.0, -70.0 / data rg(10)%dlon, rg(10)%dlat / 360.0, 40.0 / data rg(10)%global / .false. / - - !******************************************************************************** contains - subroutine set_Gdata(vname,inddeg) !-------------------------------------------------------------------------------- - ! - ! Purpose: - ! -------- ! Initialise global varibles and read data set specified by vname. Must be ! called before the first call to any routine of this module. - ! - ! Description: - ! ------------ - ! - ! - ! Arguments: - ! ---------- - ! vname: data set name to read in; valid names are - ! 'pho' - WOA phosphate - ! 'nit' - WOA nitrate - ! 'sil' - WOA silicate - ! 'oxy' - WOA dissolved oxygen - ! 'alk' - GLODAP alkalinity - ! 'dic' - GLODAP dissolved inorganic carbon - ! 'C13' - Dissolved inorganic 13C carbon isotope - ! 'd13' - delta13C of dissolved inorganic carbon - ! 'C14' - Dissolved inorganic 14C carbon isotope - ! 'd14' - delta14C of dissolved inorganic carbon - ! inddeg: extent (in degrees) of region used for averaging - ! !-------------------------------------------------------------------------------- - character(len=*), intent(in) :: vname - real, intent(in) :: inddeg + + ! Arguments + character(len=*), intent(in) :: vname ! data set name to read in + real, intent(in) :: inddeg ! extent (in degrees) of region used for averaging + + ! Valid values of vname are: + ! 'pho' - WOA phosphate + ! 'nit' - WOA nitrate + ! 'sil' - WOA silicate + ! 'oxy' - WOA dissolved oxygen + ! 'alk' - GLODAP alkalinity + ! 'dic' - GLODAP dissolved inorganic carbon + ! 'C13' - Dissolved inorganic 13C carbon isotope + ! 'd13' - delta13C of dissolved inorganic carbon + ! 'C14' - Dissolved inorganic 14C carbon isotope + ! 'd14' - delta14C of dissolved inorganic carbon + ! Local variables character(len=*), parameter :: routinestr = 'set_Gdata' - if( allocated(lon) ) deallocate( lon ) if( allocated(lat) ) deallocate( lat ) if( allocated(zlev) ) deallocate( zlev ) @@ -344,46 +319,32 @@ subroutine set_Gdata(vname,inddeg) lset = .true. call set_regional_profiles() - - - !-------------------------------------------------------------------------------- end subroutine set_Gdata - subroutine get_profile(clon,clat,prf) !-------------------------------------------------------------------------------- - ! - ! Purpose: - ! -------- ! Return a profile suitable for initialisation of HAMCC at point clon/clat. - ! - ! Description: - ! ------------ ! A mean profile is calculated by calling calc_mean_profile with the settings ! defined by a previous call to set_Gdata. If no valid data is found for the ! point clon/clat, it is tried to obtain a mean regional profile (e.g. for the ! north atlantic area). These mean profiles are initialised as part of ! set_Gdata. - ! - ! - ! Arguments: - ! ---------- - ! clon, clat: center lon/lat of mean profile - ! prf: mean profile for initialisation - ! !-------------------------------------------------------------------------------- - real, intent(in) :: clon, clat - real, intent(out) :: prf(nzmax) + + ! Arguments + real, intent(in) :: clon ! center lon of mean profile + real, intent(in) :: clat ! center lat of mean profile + real, intent(out) :: prf(nzmax) ! mean profile for initialisation ! Local variables integer :: idx, npts(nzmax) real :: clon_tmp,clat_tmp character(len=*), parameter :: routinestr = 'mo_Gdata_read, get_profile' - - if( .not. lset ) call moderr(routinestr, ' Module not initialised yet') - + if( .not. lset ) then + call moderr(routinestr, ' Module not initialised yet') + end if if( clon < 0 ) then clon_tmp=clon+360.0 @@ -396,7 +357,6 @@ subroutine get_profile(clon,clat,prf) ! Try to obtain a mean profile for a region centered at clon/clat call calc_mean_profile(clon_tmp,clat_tmp,ddeg,ddeg,prf,npts) - ! Fall back to regional profile if number of valid data points is smaller ! than 3 for the surface layer. A global mean profile is used if ! get_region returns 0. @@ -407,47 +367,33 @@ subroutine get_profile(clon,clat,prf) !write(*,*) 'Region is ', rg(idx)%name, clon, clat endif - - - !-------------------------------------------------------------------------------- end subroutine get_profile - function get_region(clon,clat) !-------------------------------------------------------------------------------- - ! - ! Purpose: - ! -------- ! Return index of region the point clon/clat belongs to - ! - ! Description: - ! ------------ ! The rectangular regions as defined in the module header (and stored in the ! data type 'rg') are searched. If point clon/clat belongs to region i, the ! index i is the result of this function. If no region is found, get_region ! returns 0, which is the index of the 'global' region defined in the header. - ! - ! Arguments: - ! ---------- - ! clon, clat: lon/lat of point - ! !-------------------------------------------------------------------------------- - real, intent(in) :: clon,clat - integer :: get_region + + ! ARGUMENTS + real, intent(in) :: clon,clat ! lon/lat of point ! Local variables - integer :: i - real :: ll_lon, ur_lon - real :: ll_lat, ur_lat - logical :: boundwithin, found + integer :: get_region + integer :: i + real :: ll_lon, ur_lon + real :: ll_lat, ur_lat + logical :: boundwithin, found character(len=*), parameter :: routinestr = 'mo_Gdata_read, get_region' - if( clon < 0 ) call moderr(routinestr, ' clon must be in the range [0,360]') if( clon > 360.0 ) call moderr(routinestr, ' clon must be in the range [0,360]') - found = .false. + found = .false. do i=1,nreg @@ -485,18 +431,12 @@ function get_region(clon,clat) else get_region = 0 endif - - - !-------------------------------------------------------------------------------- end function get_region - subroutine set_regional_profiles() !-------------------------------------------------------------------------------- - ! ! Calculate the mean profiles in regions as defined in the module header - ! !-------------------------------------------------------------------------------- ! Local variables @@ -517,17 +457,12 @@ subroutine set_regional_profiles() !write(*,*) '===============' enddo - - !-------------------------------------------------------------------------------- end subroutine set_regional_profiles - subroutine read_Gdata() !-------------------------------------------------------------------------------- - ! ! Read the WOA or GLODAP data into variables lon/lat/zlev and rvar - ! !-------------------------------------------------------------------------------- ! Local variables @@ -540,7 +475,6 @@ subroutine read_Gdata() character(len=16) :: lonstr,latstr,depthstr,depthbndsstr,fvalstr character(len=*), parameter :: routinestr = 'mo_Gdata_read, read_Gdata' - lonstr = 'lon' latstr = 'lat' fvalstr = '_FillValue' @@ -564,12 +498,10 @@ subroutine read_Gdata() end select - ! Open file if(mnproc == 1) write(io_stdo_bgc,*) 'Reading ', trim(infile) status = nf90_open(infile,nf90_nowrite,ncid); call ncerr(status) - ! Get dimensions status = nf90_inq_dimid(ncid, trim(lonstr), dId) call ncerr(status) @@ -655,55 +587,37 @@ subroutine read_Gdata() rvar = rvar*cfac end where - ! Close data file status = nf90_close(ncid) call ncerr(status) - - !-------------------------------------------------------------------------------- end subroutine read_Gdata - subroutine calc_mean_profile(clon,clat,dlon,dlat,prf,npts,global) !-------------------------------------------------------------------------------- - ! - ! Purpose: - ! -------- ! Return mean profile around the center point clon/clat. - ! - ! Description: - ! ------------ ! The mean profile is calculated from valid data points in the square defined ! by clon+/-dlon/2 clat+/-dlat/2. The number of valid data points per depth ! level is returned in npts. By setting the optional argument global to true, ! all valid data points are used to calculate a global mean profile. clon, clat, ! dlon, and dlat are ignored in this case. - ! - ! Arguments: - ! ---------- - ! clon, clat: center lon/lat of mean profile - ! dlon, dlat: lon/lat extent of region to select for averaging - ! prf: mean profile calculated from all data in selected region - ! npts: nb of valid data points found for each depth level - ! global: if set to true, calculate mean over the whole data set - ! !-------------------------------------------------------------------------------- - real, intent(in) :: clon, clat - real, intent(in) :: dlon, dlat - real, intent(out) :: prf(nzmax) - integer, intent(out) :: npts(nzmax) - logical, optional, intent(in) :: global + + ! Arguments + real, intent(in) :: clon, clat ! center lon/lat of mean profile + real, intent(in) :: dlon, dlat ! lon/lat extent of region to select for averaging + real, intent(out) :: prf(nzmax) ! mean profile calculated from all data in selected region + integer, intent(out) :: npts(nzmax) ! nb of valid data points found for each depth level + logical, optional, intent(in) :: global ! if set to true, calculate mean over the whole data set ! Local variables - integer :: ilonc, ilons, ilone, dnlon - integer :: ilatc, ilats, ilate, dnlat - integer :: l, nelmlon,nelmlat - logical :: gl = .false. + integer :: ilonc, ilons, ilone, dnlon + integer :: ilatc, ilats, ilate, dnlat + integer :: l, nelmlon,nelmlat + logical :: gl character(len=*), parameter :: routinestr = 'mo_Gdata_read, calc_mean_profile' - if( .not. lset ) call moderr(routinestr, ' Module not initialised yet') if( clon < 0 ) call moderr(routinestr, ' clon must be in the range [0,360]') if( clon > 360.0 ) call moderr(routinestr, ' clon must be in the range [0,360]') @@ -711,6 +625,7 @@ subroutine calc_mean_profile(clon,clat,dlon,dlat,prf,npts,global) prf(:) = fillval npts(:) = 0.0 + gl = .false. if( present(global) ) gl=global if( gl ) then @@ -762,7 +677,6 @@ subroutine calc_mean_profile(clon,clat,dlon,dlat,prf,npts,global) endif - ! Calculate mean profile: do l=1,nz @@ -776,7 +690,6 @@ subroutine calc_mean_profile(clon,clat,dlon,dlat,prf,npts,global) enddo - !write(*,*) '================' !if( gl ) then ! write(*,*) 'global' @@ -786,12 +699,10 @@ subroutine calc_mean_profile(clon,clat,dlon,dlat,prf,npts,global) ! write(*,*) ilatc,ilats,ilate,lat(ilatc) !endif !write(*,*) '================' - !-------------------------------------------------------------------------------- end subroutine calc_mean_profile - subroutine clean_Gdata() !-------------------------------------------------------------------------------- ! Deallocate fields and reset global variables @@ -812,12 +723,10 @@ subroutine clean_Gdata() ddeg = 0.0 nz = 0 lset = .false. - !-------------------------------------------------------------------------------- end subroutine clean_Gdata - subroutine ncerr(status) !-------------------------------------------------------------------------------- ! Handle netCDF-errors @@ -831,8 +740,6 @@ subroutine ncerr(status) call flush(io_stdo_bgc) call xchalt('(Module mo_Gdata_read, ncerr)') stop '(Module mo_Gdata_read, ncerr)' - - !-------------------------------------------------------------------------------- end subroutine ncerr @@ -849,11 +756,7 @@ subroutine moderr(routinestr,errstr) call flush(io_stdo_bgc) call xchalt('(Module mo_Gdata_read)') stop '(Module mo_Gdata_read)' - - !-------------------------------------------------------------------------------- end subroutine moderr - - !******************************************************************************** end module mo_Gdata_read diff --git a/hamocc/mo_accfields.F90 b/hamocc/mo_accfields.F90 index b8fd7cd8..136ce5c8 100644 --- a/hamocc/mo_accfields.F90 +++ b/hamocc/mo_accfields.F90 @@ -15,21 +15,19 @@ ! 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_ACCFIELDS +module mo_accfields implicit none private public :: ACCFIELDS -CONTAINS +contains - SUBROUTINE ACCFIELDS(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask) + subroutine accfields(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask) !******************************************************************************* ! - !**** *ACCFIELDS* - . - ! ! J.Schwinger, *UNI-RESEARCH* 2018-03-22 ! ! Modified @@ -39,20 +37,8 @@ SUBROUTINE ACCFIELDS(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask) ! ------- ! Accumulate fields for time-avaraged output and write output ! - ! - ! - !**** Parameter list: - ! --------------- - ! - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. - ! *REAL* *pdlxp* - size of scalar grid cell (1st dimension) [m]. - ! *REAL* *pdlyp* - size of scalar grid cell (2nd dimension) [m]. - ! *REAL* *pddpo* - size of scalar grid cell (3rd dimension) [m]. - ! *REAL* *omask* - land/ocean mask - ! !******************************************************************************* + 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, & @@ -102,11 +88,13 @@ SUBROUTINE ACCFIELDS(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask) use mo_ncwrt_bgc , only: ncwrt_bgc ! Arguments - 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) + integer , intent(in) :: kpie ! 1st dimension of model grid. + integer , intent(in) :: kpje ! 1st dimension of model grid. + integer , intent(in) :: kpke ! 1st dimension of model grid. + real , intent(in) :: pdlxp(kpie,kpje) ! size of scalar grid cell (1st dimension) [m]. + real , intent(in) :: pdlyp(kpie,kpje) ! size of scalar grid cell (2nd dimension) [m]. + real , intent(in) :: pddpo(kpie,kpje,kpke) ! size of scalar grid cell (3rd dimension) [m]. + real , intent(in) :: omask(kpie,kpje) ! land/ocean mask ! Local variables integer :: i,j,k,l @@ -458,7 +446,7 @@ SUBROUTINE ACCFIELDS(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask) nacc_bgc(l)=nacc_bgc(l)+1 if (bgcwrt(l)) then if (GLB_INVENTORY(l).ne.0) then - CALL INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,l) + call INVENTORY_BGC(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,l) endif call ncwrt_bgc(l) nacc_bgc(l)=0 @@ -470,6 +458,6 @@ SUBROUTINE ACCFIELDS(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask) oalkflx=0. rivinflx=0. - END SUBROUTINE ACCFIELDS + end subroutine accfields -END MODULE MO_ACCFIELDS +end module mo_accfields diff --git a/hamocc/mo_apply_fedep.F90 b/hamocc/mo_apply_fedep.F90 index ebdc5125..87175142 100644 --- a/hamocc/mo_apply_fedep.F90 +++ b/hamocc/mo_apply_fedep.F90 @@ -17,76 +17,42 @@ module mo_apply_fedep + !******************************************************************************** - ! - ! J. Schwinger, *NORCE climate, Bergen* 2022-05-19 - ! - ! - ! Purpose - ! ------- - ! - Routines for applying iron deposition data - ! - ! - ! Description: - ! ------------ - ! Public routines and variable of this module: - ! - ! -subroutine apply_fedep - ! apply iron deposition to the ocean tracer field - ! + ! Routines for applying iron deposition data ! This module replaces code previously found inside the ocprod-routine and ! encapsulates it in a module. ! - ! - ! Changes: - ! -------- - ! + ! J. Schwinger, *NORCE climate, Bergen* 2022-05-19 !******************************************************************************** - implicit none + implicit none private - public :: apply_fedep - !******************************************************************************** -contains + public :: apply_fedep ! apply iron deposition to the ocean tracer field +contains subroutine apply_fedep(kpie,kpje,kpke,pddpo,omask,dust) !-------------------------------------------------------------------------------- - ! - ! Purpose: - ! -------- ! Apply dust deposition input to oceanic tracer fields - ! - ! Description: - ! ------------ - ! - ! - ! Arguments: - ! ---------- - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. - ! *REAL* *pddpo* - size of scalar grid cell (3rd dimension) [m]. - ! *REAL* *omask* - ocean mask - ! *REAL* *dust* - dust deposition flux [kg/m2/month]. - ! !-------------------------------------------------------------------------------- + use mo_control_bgc, only: dtb use mo_param1_bgc, only: ifdust,iiron use mo_param_bgc, only: perc_diron use mo_carbch, only: ocetra - implicit none - - integer,intent(in) :: kpie,kpje,kpke - real, intent(in) :: pddpo(kpie,kpje,kpke) - real, intent(in) :: omask(kpie,kpje) - real, intent(in) :: dust(kpie,kpje) + integer,intent(in) :: kpie ! 1st dimension of model grid. + integer,intent(in) :: kpje ! 2nd dimension of model grid. + integer,intent(in) :: kpke ! 3rd (vertical) dimension of model grid. + real, intent(in) :: pddpo(kpie,kpje,kpke) ! size of scalar grid cell (3rd dimension) [m]. + real, intent(in) :: omask(kpie,kpje) ! ocean mask + real, intent(in) :: dust(kpie,kpje) ! dust deposition flux [kg/m2/month]. ! local variables - integer :: i,j - real :: dustinp + integer :: i,j + real :: dustinp ! dust flux from the atmosphere to the surface layer; dust fields are ! monthly mean values (kg/m2/month - assume 30 days per month here) @@ -104,10 +70,6 @@ subroutine apply_fedep(kpie,kpje,kpke,pddpo,omask,dust) enddo !$OMP END PARALLEL DO - - !-------------------------------------------------------------------------------- end subroutine apply_fedep - - !******************************************************************************** end module mo_apply_fedep diff --git a/hamocc/mo_apply_ndep.F90 b/hamocc/mo_apply_ndep.F90 index b26bc541..cd5d590f 100644 --- a/hamocc/mo_apply_ndep.F90 +++ b/hamocc/mo_apply_ndep.F90 @@ -18,90 +18,54 @@ module mo_apply_ndep !****************************************************************************** + ! Routine for applying the nitrogen deposition flux + ! The routine n_deposition applies the nitrogen deposition flux to the + ! top-most model layer. + ! N deposition is activated through a logical switch 'do_ndep' read from + ! HAMOCC's bgcnml namelist. ! - ! S.Gao *Gfi, Bergen* 2017-08-19 - ! - ! Modified - ! -------- + ! S.Gao *Gfi, Bergen* 2017-08-19 + ! Modified: ! J. Tjiputra, *Uni Research, Bergen* 2017-09-18 ! -add 1 mol [H+], per mol [NO3] deposition, to alkalinity (minus 1 mol) - ! ! J. Schwinger, *NORCE climate, Bergen* 2022-05-18 ! -seperate modules into one module that reads a specific data set, and this ! module that applies the n-deposition flux to the surface ocean - ! - ! - ! Purpose - ! ------- - ! -Routine for applying the nitrogen deposition flux - ! - ! - ! Description: - ! ------------ - ! - ! The routine n_deposition applies the nitrogen deposition flux to the - ! top-most model layer. - ! - ! N deposition is activated through a logical switch 'do_ndep' read from - ! HAMOCC's bgcnml namelist. - ! - ! -subroutine apply_ndep - ! Apply n-deposition to the top-most model layer. - ! - ! !****************************************************************************** - implicit none + implicit none private - public :: apply_ndep + public :: apply_ndep ! Apply n-deposition to the top-most model layer. - !****************************************************************************** contains - subroutine apply_ndep(kpie,kpje,kpke,pddpo,omask,ndep) !****************************************************************************** + ! Apply n-deposition to the top-most model layer. ! - ! S. Gao *Gfi, Bergen* 19.08.2017 - ! - ! Purpose - ! ------- - ! -apply n-deposition to the top-most model layer. - ! - ! Changes: - ! -------- - ! Tjiputra (18.09.2017): add 1 mol [H+], per mol [NO3] deposition, to - ! alkalinity (minus 1 mol) - ! - ! Parameter list: - ! --------------- - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. - ! *REAL* *pddpo* - size of grid cell (depth) [m]. - ! *REAL* *omask* - land/ocean mask (1=ocean) - ! *REAL* *ndep* - N-deposition field to apply - ! + ! S. Gao *Gfi, Bergen* 19.08.2017 + ! Modified: + ! Tjiputra (18.09.2017): add 1 mol [H+], per mol [NO3] deposition, to alkalinity (minus 1 mol) !****************************************************************************** + use mo_control_bgc, only: 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 - - integer, intent(in) :: kpie,kpje,kpke - real, intent(in) :: pddpo(kpie,kpje,kpke) - real, intent(in) :: omask(kpie,kpje) - real, intent(in) :: ndep(kpie,kpje) + ! Arguments + integer, intent(in) :: kpie ! 1st dimension of model grid. + integer, intent(in) :: kpje ! 2nd dimension of model grid. + integer, intent(in) :: kpke ! 3rd (vertical) dimension of model grid. + real, intent(in) :: pddpo(kpie,kpje,kpke) ! size of grid cell (depth) [m]. + real, intent(in) :: omask(kpie,kpje) ! land/ocean mask (1=ocean) + real, intent(in) :: ndep(kpie,kpje) ! N-deposition field to apply ! local variables integer :: i,j - - ! ndepflx stores the applied n-deposition flux for inventory calculations - ! and output + ! ndepflx stores the applied n-deposition flux for inventory calculations and output ndepflx(:,:)=0.0 if (.not. do_ndep) return @@ -120,9 +84,6 @@ subroutine apply_ndep(kpie,kpje,kpke,pddpo,omask,ndep) enddo enddo - !****************************************************************************** end subroutine apply_ndep - - !****************************************************************************** end module mo_apply_ndep diff --git a/hamocc/mo_apply_oafx.F90 b/hamocc/mo_apply_oafx.F90 index 06ba90da..cefed6d7 100644 --- a/hamocc/mo_apply_oafx.F90 +++ b/hamocc/mo_apply_oafx.F90 @@ -17,68 +17,39 @@ module mo_apply_oafx + !****************************************************************************** + ! Routines for applying ocean alkalinization ! - ! J.Schwinger *NORCE Climate, Bergen* 2021-11-15 - ! - ! Modified - ! -------- - ! - ! Purpose - ! ------- - ! -Routines for applying ocean alkalinization - ! - ! - ! Description: - ! ------------ - ! - ! -subroutine alkalinization - ! Apply alkalinization to the top-most model layer. - ! - ! + ! J.Schwinger *NORCE Climate, Bergen* 2021-11-15 !****************************************************************************** - implicit none + implicit none private - public :: apply_oafx - - !****************************************************************************** -contains + public :: apply_oafx ! Apply alkalinization to the top-most model layer. +contains subroutine apply_oafx(kpie,kpje,kpke,pddpo,omask,oafx) + !****************************************************************************** + ! Apply alkalinization to the top-most model layer. ! - ! J. Schwinger *NORCE Climate, Bergen* 2021-11-15 - ! - ! Purpose - ! ------- - ! -apply alkalinization to the top-most model layer. - ! - ! Changes: - ! -------- - ! - ! - ! Parameter list: - ! --------------- - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! *REAL* *pddpo* - size of grid cell (depth) [m]. - ! *REAL* *omask* - land/ocean mask (1=ocean) - ! *REAL* *oafx* - alkalinization field to apply [kmol m-2 yr-1] - ! + ! J. Schwinger *NORCE Climate, Bergen* 2021-11-15 !****************************************************************************** + use mo_control_bgc, only: dtb,do_oalk use mo_param1_bgc, only: ialkali use mo_carbch, only: ocetra,oalkflx,OmegaA use mo_read_oafx, only: thrh_omegaa - implicit none - - integer, intent(in) :: kpie,kpje,kpke - real, intent(in) :: pddpo(kpie,kpje,kpke) - real, intent(in) :: omask(kpie,kpje) + ! Arguments + integer, intent(in) :: kpie ! 1st dimension of model grid. + integer, intent(in) :: kpje ! 2nd dimension of model grid. + integer, intent(in) :: kpke ! size of grid cell (depth) [m]. + real, intent(in) :: pddpo(kpie,kpje,kpke) ! land/ocean mask (1=ocean) + real, intent(in) :: omask(kpie,kpje) ! alkalinization field to apply [kmol m-2 yr-1] real, intent(in) :: oafx(kpie,kpje) ! local variables @@ -101,9 +72,6 @@ subroutine apply_oafx(kpie,kpje,kpke,pddpo,omask,oafx) enddo enddo - !****************************************************************************** end subroutine apply_oafx - - !****************************************************************************** end module mo_apply_oafx diff --git a/hamocc/mo_apply_rivin.F90 b/hamocc/mo_apply_rivin.F90 index 1f611d25..ee031e84 100644 --- a/hamocc/mo_apply_rivin.F90 +++ b/hamocc/mo_apply_rivin.F90 @@ -17,96 +17,62 @@ module mo_apply_rivin + !******************************************************************************** + ! Routines for applying riverine nutrient and carbon input data + ! BLOM_RIVER_NUTRIENTS must be set to TRUE in env_run.xml to activate + ! riverine nutrients. ! - ! S. Gao, *Gfi, Bergen* 19.08.2017 - ! - ! Purpose - ! ------- - ! - Routines for applying riverine nutrient and carbon input data - ! - ! - ! Description: - ! ------------ - ! Public routines and variable of this module: - ! - ! -subroutine apply_rivin - ! apply riverine input to the ocean tracer field - ! - ! BLOM_RIVER_NUTRIENTS must be set to TRUE in env_run.xml to activate - ! riverine nutrients. - ! - ! - ! Changes: - ! -------- + ! S. Gao, *Gfi, Bergen* 19.08.2017 + ! Modified: ! J. Schwinger, *NORCE climate, Bergen* 2020-05-27 ! - re-structured this module such that riverine input can be passed as an ! argument to iHAMOCC's main routine - ! ! J. Schwinger, *NORCE climate, Bergen* 2022-05-18 ! - re-structured and renamed this module such that reading and application of ! data are seperated into two distinct modules ! !******************************************************************************** - implicit none + implicit none private - public :: apply_rivin + + public :: apply_rivin ! apply riverine input to the ocean tracer field ! Approx. 80-99% of dFe riverine input is lost to the particulate phase in ! estuaries at low salinities [Boyle et al., 1977; Chester, 1990; Dai and ! Martin, 1995; Lohan and Bruland, 2006; Sholkovitz, 1978]. dFe_frac is the ! fraction of dissolved iron that enters the costal ocean. - real, parameter :: dFe_frac = 0.01 ! assume 99% loss of dissolved iron + real, parameter :: dFe_frac = 0.01 ! assume 99% loss of dissolved iron - !******************************************************************************** contains - - subroutine apply_rivin(kpie,kpje,kpke,pddpo,omask,rivin) !-------------------------------------------------------------------------------- - ! - ! Purpose: - ! -------- ! Apply riverine input to oceanic tracer fields - ! - ! Description: - ! ------------ - ! - ! - ! Arguments: - ! ---------- - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. - ! *REAL* *pddpo* - size of scalar grid cell (3rd dimension) [m]. - ! *REAL* *omask* - ocean mask - ! *REAL* *rivin* - riverine input field [kmol m-2 yr-1] - ! !-------------------------------------------------------------------------------- + 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 - ! cisonew + iano3,iphosph,isilica,isco212,iiron,idoc,idet, & + ialkali,inatsco212,inatalkali use mo_param1_bgc, only: idet13,idet14,idoc13,idoc14,isco213,isco214,safediv use mo_vgrid, only: kmle use mo_carbch, only: ocetra,rivinflx use mo_control_bgc, only: use_natDIC - implicit none - - integer,intent(in) :: kpie,kpje,kpke - real, intent(in) :: pddpo(kpie,kpje,kpke) - real, intent(in) :: omask(kpie,kpje) - real, intent(in) :: rivin(kpie,kpje,nriv) + ! Arguments + integer,intent(in) :: kpie ! 1st dimension of model grid. + integer,intent(in) :: kpje ! 2nd dimension of model grid. + integer,intent(in) :: kpke ! 3rd (vertical) dimension of model grid. + real, intent(in) :: pddpo(kpie,kpje,kpke) ! size of scalar grid cell (3rd dimension) [m]. + real, intent(in) :: omask(kpie,kpje) ! ocean mask + real, intent(in) :: rivin(kpie,kpje,nriv) ! riverine input field [kmol m-2 yr-1] ! local variables - integer :: i,j,k - real :: fdt,volij - + integer :: i,j,k + real :: fdt,volij ! rivinflx stores the applied n-deposition flux for inventory calculations ! and output @@ -165,25 +131,22 @@ subroutine apply_rivin(kpie,kpje,kpke,pddpo,omask,rivin) + 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 - 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 - - rivinflx(i,j,irdin) = rivin(i,j,irdin)*fdt - rivinflx(i,j,irdip) = rivin(i,j,irdip)*fdt - rivinflx(i,j,irsi) = rivin(i,j,irsi)*fdt - rivinflx(i,j,iralk) = rivin(i,j,iralk)*fdt - rivinflx(i,j,iriron) = rivin(i,j,iriron)*fdt*dFe_frac - rivinflx(i,j,irdoc) = rivin(i,j,irdoc)*fdt - rivinflx(i,j,irdet) = rivin(i,j,irdet)*fdt + 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 + + rivinflx(i,j,irdin) = rivin(i,j,irdin)*fdt + rivinflx(i,j,irdip) = rivin(i,j,irdip)*fdt + rivinflx(i,j,irsi) = rivin(i,j,irsi)*fdt + rivinflx(i,j,iralk) = rivin(i,j,iralk)*fdt + rivinflx(i,j,iriron) = rivin(i,j,iriron)*fdt*dFe_frac + rivinflx(i,j,irdoc) = rivin(i,j,irdoc)*fdt + rivinflx(i,j,irdet) = rivin(i,j,irdet)*fdt ENDIF ENDDO ENDDO !$OMP END PARALLEL DO - !-------------------------------------------------------------------------------- end subroutine apply_rivin - - !******************************************************************************** end module mo_apply_rivin diff --git a/hamocc/mo_aufr_bgc.F90 b/hamocc/mo_aufr_bgc.F90 index 36abd8fc..e56dc3b2 100644 --- a/hamocc/mo_aufr_bgc.F90 +++ b/hamocc/mo_aufr_bgc.F90 @@ -17,98 +17,61 @@ ! 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_AUFR_BGC +module mo_aufr_bgc implicit none private - public :: AUFR_BGC + public :: aufr_bgc CONTAINS - SUBROUTINE AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & + subroutine aufr_bgc(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & kplyear,kplmon,kplday,omask,rstfnm) !****************************************************************************** - ! - !**** *AUFR_BGC* - reads marine bgc restart data. - ! - ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 - ! - ! Modified - ! -------- - ! S.Legutke, *MPI-MaD, HH* 10.04.01 - ! - extra SBR for reading bgc data from the restart file. - ! S.Legutke, *MPI-MaD, HH* 15.08.01 - ! - netCDF version (with cond.comp. PNETCDF) - ! - no use of chemc values from netCDF restart - ! - ! Patrick Wetzel, *MPI-Met, HH* 16.04.02 - ! - read chemcm(i,j,7,12) from netCDF restart - ! - ! J.Schwinger, *GFI, Bergen* 2013-10-21 - ! - removed reading of chemcm and ak* fields - ! - code cleanup, remoded preprocessor option "PNETCDF" - ! and "NOMPI" - ! - ! J.Schwinger, *GFI, Bergen* 2014-05-21 - ! - adapted code for writing of two time level tracer - ! and sediment fields - ! - ! A.Moree, *GFI, Bergen* 2018-04-12 - ! - new version of carbon isotope code - ! - ! J.Tjiputra, *Uni Research, Bergen* 2018-04-12 - ! - added preformed and saturated DIC tracers - ! - ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 - ! - added cappability to restart c-isotopes from scratch (from - ! 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 - ! not found in the restart file. - ! - removed satn2o which is not needed to restart the model - ! - added sediment bypass preprocessor option - ! - ! J.Schwinger, *Uni Research, Bergen* 2018-08-23 - ! - added reading of atmosphere field for BOXATM - ! - ! M. Bentsen, *NORCE, Bergen* 2020-05-03 - ! - changed ocean model from MICOM to BLOM - ! - ! Purpose - ! ------- - ! Read restart data to continue an interrupted integration. - ! - ! Method - ! ------- - ! 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 - ! difference of the offsets of restart files. - ! - ! - !** Interface to ocean model (parameter list): - ! ----------------------------------------- - ! - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. - ! *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 - ! ocean model [mol/kg] - ! *INTEGER* *kplyear* - year in ocean restart date - ! *INTEGER* *kplmon* - month in ocean restart date - ! *INTEGER* *kplday* - day in ocean restart date - ! *REAL* *omask* - land/ocean mask - ! *CHAR* *rstfnm* - restart file name-informations - ! - ! + ! Reads marine bgc restart data. + ! Read restart data to continue an interrupted integration. + ! 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 + ! difference of the offsets of restart files. + ! + ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 + ! Modified: + ! S.Legutke, *MPI-MaD, HH* 10.04.01 + ! - extra SBR for reading bgc data from the restart file. + ! S.Legutke, *MPI-MaD, HH* 15.08.01 + ! - netCDF version (with cond.comp. PNETCDF) + ! - no use of chemc values from netCDF restart + ! Patrick Wetzel, *MPI-Met, HH* 16.04.02 + ! - read chemcm(i,j,7,12) from netCDF restart + ! J.Schwinger, *GFI, Bergen* 2013-10-21 + ! - removed reading of chemcm and ak* fields + ! - code cleanup, remoded preprocessor option "PNETCDF" + ! and "NOMPI" + ! J.Schwinger, *GFI, Bergen* 2014-05-21 + ! - adapted code for writing of two time level tracer + ! and sediment fields + ! A.Moree, *GFI, Bergen* 2018-04-12 + ! - new version of carbon isotope code + ! J.Tjiputra, *Uni Research, Bergen* 2018-04-12 + ! - added preformed and saturated DIC tracers + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - added cappability to restart c-isotopes from scratch (from + ! 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 + ! not found in the restart file. + ! - removed satn2o which is not needed to restart the model + ! - added sediment bypass preprocessor option + ! J.Schwinger, *Uni Research, Bergen* 2018-08-23 + ! - added reading of atmosphere field for BOXATM + ! M. Bentsen, *NORCE, Bergen* 2020-05-03 + ! - changed ocean model from MICOM to BLOM !************************************************************************** use netcdf, only: nf90_global,nf90_noerr,nf90_nowrite,nf90_close, & @@ -135,16 +98,18 @@ SUBROUTINE AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & use mo_read_netcdf_var, only: read_netcdf_var ! Arguments - integer, intent(in) :: kpie - integer, intent(in) :: kpje - integer, intent(in) :: kpke - integer, intent(in) :: ntr - integer, intent(in) :: ntrbgc - integer, intent(in) :: 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 + integer, intent(in) :: kpie ! 1st dimension of model grid. + integer, intent(in) :: kpje ! 2nd dimension of model grid. + integer, intent(in) :: kpke ! 3rd (vertical) dimension of model grid. + integer, intent(in) :: ntr ! number of tracers in tracer field + integer, intent(in) :: ntrbgc ! number of biogechemical tracers in tracer field + integer, intent(in) :: itrbgc ! start index for biogeochemical tracers in tracer field + real, intent(inout) :: trc(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy,2*kpke,ntr) ! initial/restart tracer field to be passed to the ocean model [mol/kg] + integer, intent(in) :: kplyear ! year in ocean restart date + integer, intent(in) :: kplmon ! month in ocean restart date + integer, intent(in) :: kplday ! day in ocean restart date + real, intent(in) :: omask(kpie,kpje) ! land/ocean mask + character(len=*), intent(in) :: rstfnm ! restart file name-informations ! Local variables real, allocatable :: locetra(:,:,:,:) ! local array for reading @@ -184,7 +149,7 @@ SUBROUTINE AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & ncstat = NF90_OPEN(rstfnm,NF90_NOWRITE, ncid) IF ( ncstat .NE. NF90_NOERR ) THEN - CALL xchalt('(AUFR: Problem with netCDF1)') + call xchalt('(AUFR: Problem with netCDF1)') stop '(AUFR: Problem with netCDF1)' ENDIF ! @@ -192,7 +157,7 @@ SUBROUTINE AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & ! ncstat = NF90_GET_ATT(ncid, NF90_GLOBAL,'date', idate) IF ( ncstat .NE. NF90_NOERR ) THEN - CALL xchalt('(AUFR: Problem reading date of restart file)') + call xchalt('(AUFR: Problem reading date of restart file)') stop '(AUFR: Problem reading date of restart file)' ENDIF restyear = idate(1) @@ -200,14 +165,14 @@ SUBROUTINE AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & restday = idate(3) restdtoce = idate(4) ldtbgc = idate(5) - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Date of bgc restart file : ' - WRITE(io_stdo_bgc,*) ' year = ',restyear - WRITE(io_stdo_bgc,*) ' month = ',restmonth - WRITE(io_stdo_bgc,*) ' day = ',restday - WRITE(io_stdo_bgc,*) ' dtoce = ',restdtoce - WRITE(io_stdo_bgc,*) ' dtbgc = ',ldtbgc - WRITE(io_stdo_bgc,*) ' ' + write(io_stdo_bgc,*) ' ' + write(io_stdo_bgc,*) 'Date of bgc restart file : ' + write(io_stdo_bgc,*) ' year = ',restyear + write(io_stdo_bgc,*) ' month = ',restmonth + write(io_stdo_bgc,*) ' day = ',restday + write(io_stdo_bgc,*) ' dtoce = ',restdtoce + write(io_stdo_bgc,*) ' dtbgc = ',ldtbgc + write(io_stdo_bgc,*) ' ' ELSE IF(IOTYPE==1) THEN @@ -223,7 +188,7 @@ SUBROUTINE AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & ncstat = NFMPI_OPEN(mpicomm,rstfnm,NF_NOWRITE,INFO, ncid) IF ( ncstat .NE. NF_NOERR ) THEN - CALL xchalt('(AUFR: Problem with netCDF1)') + call xchalt('(AUFR: Problem with netCDF1)') stop '(AUFR: Problem with netCDF1)' ENDIF ! @@ -231,7 +196,7 @@ SUBROUTINE AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & ! 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)') + call xchalt('(AUFR: Problem reading date of restart file)') stop '(AUFR: Problem reading date of restart file)' ENDIF restyear = idate(1) @@ -240,18 +205,18 @@ SUBROUTINE AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & restdtoce = idate(4) ldtbgc = idate(5) IF(mnproc==1) THEN - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Date of bgc restart file : ' - WRITE(io_stdo_bgc,*) ' year = ',restyear - WRITE(io_stdo_bgc,*) ' month = ',restmonth - WRITE(io_stdo_bgc,*) ' day = ',restday - WRITE(io_stdo_bgc,*) ' dtoce = ',restdtoce - WRITE(io_stdo_bgc,*) ' dtbgc = ',ldtbgc - WRITE(io_stdo_bgc,*) ' ' + write(io_stdo_bgc,*) ' ' + write(io_stdo_bgc,*) 'Date of bgc restart file : ' + write(io_stdo_bgc,*) ' year = ',restyear + write(io_stdo_bgc,*) ' month = ',restmonth + write(io_stdo_bgc,*) ' day = ',restday + write(io_stdo_bgc,*) ' dtoce = ',restdtoce + write(io_stdo_bgc,*) ' dtbgc = ',ldtbgc + write(io_stdo_bgc,*) ' ' ENDIF #endif if(testio .eq. 0) then - CALL xchalt('(AUFR: Problem with namelist iotype)') + call xchalt('(AUFR: Problem with namelist iotype)') stop '(AUFR: Problem with namelist iotype)' endif @@ -262,13 +227,13 @@ SUBROUTINE AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & ! IF (mnproc.eq.1) THEN - IF ( kplyear .NE. restyear ) WRITE(io_stdo_bgc,*) & + IF ( kplyear .NE. restyear ) write(io_stdo_bgc,*) & 'WARNING: restart years in oce/bgc are not the same : ', kplyear,'/',restyear,' !!!' - IF ( kplmon .NE. restmonth ) WRITE(io_stdo_bgc,*) & + IF ( kplmon .NE. restmonth ) write(io_stdo_bgc,*) & 'WARNING: restart months in oce/bgc are not the same : ',kplmon,'/',restmonth,' !!!' - IF ( kplday .NE. restday ) WRITE(io_stdo_bgc,*) & + IF ( kplday .NE. restday ) write(io_stdo_bgc,*) & 'WARNING: restart days in oce/bgc are not the same : ', kplday,'/',restday,' !!!' ENDIF @@ -287,9 +252,9 @@ SUBROUTINE AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & #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.' + 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 @@ -307,10 +272,10 @@ SUBROUTINE AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & #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.' + 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 endif @@ -328,9 +293,9 @@ SUBROUTINE AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & #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 ' + 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 @@ -348,9 +313,9 @@ SUBROUTINE AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & #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).' + 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 @@ -368,114 +333,114 @@ SUBROUTINE AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & #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 ' + 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 ! ! 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) - CALL read_netcdf_var(ncid,'oxygen',locetra(1,1,1,ioxygen),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'gasnit',locetra(1,1,1,igasnit),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'ano3',locetra(1,1,1,iano3),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'silica',locetra(1,1,1,isilica),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'doc',locetra(1,1,1,idoc),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'phyto',locetra(1,1,1,iphy),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'grazer',locetra(1,1,1,izoo),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'poc',locetra(1,1,1,idet),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'calciu',locetra(1,1,1,icalc),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'opal',locetra(1,1,1,iopal),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'n2o',locetra(1,1,1,ian2o),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'dms',locetra(1,1,1,idms),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'fdust',locetra(1,1,1,ifdust),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'iron',locetra(1,1,1,iiron),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'prefo2',locetra(1,1,1,iprefo2),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'prefpo4',locetra(1,1,1,iprefpo4),2*kpke,0,iotype) - CALL read_netcdf_var(ncid,'prefalk',locetra(1,1,1,iprefalk),2*kpke,0,iotype) - 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) + 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) + call read_netcdf_var(ncid,'oxygen',locetra(1,1,1,ioxygen),2*kpke,0,iotype) + call read_netcdf_var(ncid,'gasnit',locetra(1,1,1,igasnit),2*kpke,0,iotype) + call read_netcdf_var(ncid,'ano3',locetra(1,1,1,iano3),2*kpke,0,iotype) + call read_netcdf_var(ncid,'silica',locetra(1,1,1,isilica),2*kpke,0,iotype) + call read_netcdf_var(ncid,'doc',locetra(1,1,1,idoc),2*kpke,0,iotype) + call read_netcdf_var(ncid,'phyto',locetra(1,1,1,iphy),2*kpke,0,iotype) + call read_netcdf_var(ncid,'grazer',locetra(1,1,1,izoo),2*kpke,0,iotype) + call read_netcdf_var(ncid,'poc',locetra(1,1,1,idet),2*kpke,0,iotype) + call read_netcdf_var(ncid,'calciu',locetra(1,1,1,icalc),2*kpke,0,iotype) + call read_netcdf_var(ncid,'opal',locetra(1,1,1,iopal),2*kpke,0,iotype) + call read_netcdf_var(ncid,'n2o',locetra(1,1,1,ian2o),2*kpke,0,iotype) + call read_netcdf_var(ncid,'dms',locetra(1,1,1,idms),2*kpke,0,iotype) + call read_netcdf_var(ncid,'fdust',locetra(1,1,1,ifdust),2*kpke,0,iotype) + call read_netcdf_var(ncid,'iron',locetra(1,1,1,iiron),2*kpke,0,iotype) + call read_netcdf_var(ncid,'prefo2',locetra(1,1,1,iprefo2),2*kpke,0,iotype) + call read_netcdf_var(ncid,'prefpo4',locetra(1,1,1,iprefpo4),2*kpke,0,iotype) + call read_netcdf_var(ncid,'prefalk',locetra(1,1,1,iprefalk),2*kpke,0,iotype) + 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) if (use_cisonew .and. 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) + 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 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) + 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 if (use_CFC .and. 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) + 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 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) + 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) + 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 if (use_BROMO .and. lread_bro) then - CALL read_netcdf_var(ncid,'bromo',locetra(1,1,1,ibromo),2*kpke,0,iotype) + call read_netcdf_var(ncid,'bromo',locetra(1,1,1,ibromo),2*kpke,0,iotype) endif ! ! 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) + 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. ! 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) + 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 .and. 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) + 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 ! @@ -483,13 +448,13 @@ SUBROUTINE AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & ! 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) + 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) + 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. @@ -510,7 +475,7 @@ SUBROUTINE AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & ENDIF endif if (use_natDIC) then - CALL read_netcdf_var(ncid,'atmnco2',atm2(1,1,1,iatmnco2),2,0,iotype) + 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 @@ -611,6 +576,6 @@ SUBROUTINE AUFR_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & trc(1:kpie,1:kpje,:,itrbgc:itrbgc+ntrbgc-1)=locetra(:,:,:,:) deallocate(locetra) - END SUBROUTINE AUFR_BGC + end subroutine aufr_bgc -END MODULE MO_AUFR_BGC +end module mo_aufr_bgc diff --git a/hamocc/mo_aufw_bgc.F90 b/hamocc/mo_aufw_bgc.F90 index f570a081..71b730bb 100644 --- a/hamocc/mo_aufw_bgc.F90 +++ b/hamocc/mo_aufw_bgc.F90 @@ -30,81 +30,43 @@ SUBROUTINE AUFW_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & kplyear,kplmon,kplday,kpldtoce,omask,rstfnm) !****************************************************************************** - ! - !**** *AUFW_BGC* - write marine bgc restart data. - ! - ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 - ! - ! Modified - ! -------- - ! S.Legutke, *MPI-MaD, HH* 10.04.01 - ! - extra SBR for writing bgc data to the restart file. - ! S.Legutke, *MPI-MaD, HH* 15.08.01 - ! - netCDF version (cond.comp. PNETCDF) - ! - chemcm is multiplied with layer-dependent constant in order - ! to be displayable by ncview. It is not read in AUFR_BGC! - ! - ! J.Schwinger, *GFI, Bergen* 2013-10-21 - ! - tracer field is passed from ocean model for writing now - ! - removed writing of chemcm and ak* fields - ! - code cleanup, removed preprocessor option "PNETCDF" - ! - ! J.Schwinger, *GFI, Bergen* 2014-05-21 - ! - adapted code for writing of two time level tracer and - ! sediment fields - ! - ! A.Moree, *GFI, Bergen* 2018-04-12 - ! - new version of carbon isotope code - ! - ! J.Tjiputra, *Uni Research, Bergen* 2018-04-12 - ! - added preformed and saturated DIC tracers - ! - ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 - ! - removed satn2o which is not needed to restart the model - ! - added sediment bypass preprocessor option - ! - ! J.Schwinger, *Uni Research, Bergen* 2018-08-23 - ! - added writing of atmosphere field for BOXATM - ! - ! M. Bentsen, *NORCE, Bergen* 2020-05-03 - ! - changed ocean model from MICOM to BLOM - ! - ! Purpose - ! ------- - ! Write restart data for continuation of interrupted integration. - ! - ! Method - ! ------- - ! 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)). - ! It can differ from that of the ocean (idate(4)) by the difference - ! of the offsets of restart files. - ! - ! - !** Interface to ocean model (parameter list): - ! ----------------------------------------- - ! - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. - ! *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 - ! ocean model [mol/kg] - ! *REAL* *sedlay2* - initial/restart sediment (two time levels) field - ! *REAL* *powtra2* - initial/restart pore water tracer (two time levels) field - ! *REAL* *burial2* - initial/restart sediment burial (two time levels) field - ! *INTEGER* *kplyear* - year in ocean restart date - ! *INTEGER* *kplmon* - month in ocean restart date - ! *INTEGER* *kplday* - day in ocean restart date - ! *INTEGER* *kpldtoce* - step in ocean restart date - ! *REAL* *omask* - land/ocean mask - ! *CHAR* *rstfnm* - restart file name-informations - ! + ! Wwrite marine bgc restart data. + ! Write restart data for continuation of interrupted integration. + ! 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)). + ! It can differ from that of the ocean (idate(4)) by the difference + ! of the offsets of restart files. + ! + ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 + ! Modified + ! S.Legutke, *MPI-MaD, HH* 10.04.01 + ! - extra SBR for writing bgc data to the restart file. + ! S.Legutke, *MPI-MaD, HH* 15.08.01 + ! - netCDF version (cond.comp. PNETCDF) + ! - chemcm is multiplied with layer-dependent constant in order + ! to be displayable by ncview. It is not read in AUFR_BGC! + ! J.Schwinger, *GFI, Bergen* 2013-10-21 + ! - tracer field is passed from ocean model for writing now + ! - removed writing of chemcm and ak* fields + ! - code cleanup, removed preprocessor option "PNETCDF" + ! J.Schwinger, *GFI, Bergen* 2014-05-21 + ! - adapted code for writing of two time level tracer and + ! sediment fields + ! A.Moree, *GFI, Bergen* 2018-04-12 + ! - new version of carbon isotope code + ! J.Tjiputra, *Uni Research, Bergen* 2018-04-12 + ! - added preformed and saturated DIC tracers + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - removed satn2o which is not needed to restart the model + ! - added sediment bypass preprocessor option + ! J.Schwinger, *Uni Research, Bergen* 2018-08-23 + ! - added writing of atmosphere field for BOXATM + ! M. Bentsen, *NORCE, Bergen* 2020-05-03 + ! - changed ocean model from MICOM to BLOM !************************************************************************** + 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 mod_xc, only: nbdy,itdm,jtdm,mnproc,iqr,jqr,xchalt @@ -125,22 +87,31 @@ SUBROUTINE AUFW_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & use mo_write_netcdf_var, only: write_netcdf_var ! Arguments - INTEGER, intent(in) :: kpie,kpje,kpke,ntr,ntrbgc,itrbgc - REAL, intent(in) :: trc(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy,2*kpke,ntr) - REAL, intent(in) :: omask(kpie,kpje) - INTEGER, intent(in) :: kplyear,kplmon,kplday,kpldtoce - character(len=*), intent(in) :: rstfnm + integer, intent(in) :: kpie ! 1st dimension of model grid. + integer, intent(in) :: kpje ! 2nd dimension of model grid. + integer, intent(in) :: kpke ! 3rd (vertical) dimension of model grid. + integer, intent(in) :: ntr ! number of tracers in tracer field + integer, intent(in) :: ntrbgc ! number of biogechemical tracers in tracer field + integer, intent(in) :: itrbgc ! start index for biogeochemical tracers in tracer field + integer, intent(in) :: kplyear ! year in ocean restart date + integer, intent(in) :: kplmon ! month in ocean restart date + integer, intent(in) :: kplday ! day in ocean restart date + integer, intent(in) :: kpldtoce ! step in ocean restart date + real, intent(in) :: omask(kpie,kpje) ! land/ocean mask + character(len=*), intent(in) :: rstfnm ! restart file name-informations + ! initial/restart tracer field to be passed to the ocean model [mol/kg] + real, intent(in) :: trc(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy,2*kpke,ntr) ! Local variables - INTEGER :: i,j - REAL :: locetra(kpie,kpje,2*kpke,nocetra) - INTEGER :: errstat + integer :: i,j + real :: locetra(kpie,kpje,2*kpke,nocetra) + integer :: errstat ! Variables for netcdf - INTEGER :: ncid,ncvarid,ncstat,ncoldmod,ncdimst(4) - INTEGER :: nclatid,nclonid,nclevid,nclev2id,ncksid,ncks2id,nctlvl2id - INTEGER :: idate(5),ierr,testio - REAL :: rmissing + integer :: ncid,ncvarid,ncstat,ncoldmod,ncdimst(4) + integer :: nclatid,nclonid,nclevid,nclev2id,ncksid,ncks2id,nctlvl2id + integer :: idate(5),ierr,testio + real :: rmissing character(len=3) :: stripestr character(len=9) :: stripestr2 #ifdef PNETCDF @@ -170,10 +141,10 @@ 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 @@ -198,7 +169,7 @@ SUBROUTINE AUFW_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & call mpi_info_set(info,'romio_ds_write','disable',ierr) call mpi_info_set(info,"striping_factor",stripestr,ierr) call mpi_info_set(info,"striping_unit",stripestr2,ierr) - ncstat = NFMPI_CREATE(mpicomm,rstfnm, & + ncstat = NFMPI_CREATE(mpicomm,rstfnm, & & IOR(nf_clobber,nf_64bit_offset),info,ncid) IF ( ncstat .NE. NF_NOERR ) THEN call xchalt('(AUFW: Problem with PnetCDF1)') @@ -206,7 +177,7 @@ SUBROUTINE AUFW_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & ENDIF #endif if(testio .eq. 0) then - CALL xchalt('(AUFW: Problem with namelist iotype)') + call xchalt('(AUFW: Problem with namelist iotype)') stop '(AUFW: Problem with namelist iotype)' endif @@ -407,173 +378,173 @@ SUBROUTINE AUFW_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & ncdimst(4) = 0 ENDIF - CALL NETCDF_DEF_VARDB(ncid,6,'sco212',3,ncdimst,ncvarid, & + 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, & + 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, & + 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, & + 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, & + 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, & + 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, & + 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, & + 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, & + 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, & + 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, & + 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, & + 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, & + 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, & + 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, & + 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, & + 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, & + 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, & + 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, & + 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, & + 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, & + 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, & + call NETCDF_DEF_VARDB(ncid,6,'dicsat',3,ncdimst,ncvarid, & & 6,'mol/kg',13,'Saturated dic', & rmissing,31,io_stdo_bgc) if (use_cisonew) then - CALL NETCDF_DEF_VARDB(ncid,6,'sco213',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,6,'sco213',3,ncdimst,ncvarid, & & 6,'mol/kg',15, 'Dissolved CO213',rmissing,32,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,6,'sco214',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,6,'sco214',3,ncdimst,ncvarid, & & 6,'mol/kg',15, 'Dissolved CO214',rmissing,33,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,5,'doc13',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,5,'doc13',3,ncdimst,ncvarid, & & 6,'mol/kg',24,'Dissolved organic carb13', & & rmissing,34,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,5,'doc14',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,5,'doc14',3,ncdimst,ncvarid, & & 6,'mol/kg',24,'Dissolved organic carb14', & & rmissing,35,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,5,'poc13',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,5,'poc13',3,ncdimst,ncvarid, & & 7,'molC/kg',28,'Particulate organic carbon13', & & rmissing,36,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,5,'poc14',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,5,'poc14',3,ncdimst,ncvarid, & & 7,'molC/kg',28,'Particulate organic carbon14', & & rmissing,37,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,7,'phyto13',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,7,'phyto13',3,ncdimst,ncvarid, & & 7,'molP/kg',27,'Phytoplankton concentr. 13c', & & rmissing,38,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,7,'phyto14',3,ncdimst,ncvarid, & + 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, & + call NETCDF_DEF_VARDB(ncid,8,'grazer13',3,ncdimst,ncvarid, & & 7,'molP/kg',25,'Zooplankton concentr. 13c', & & rmissing,40,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,8,'grazer14',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,8,'grazer14',3,ncdimst,ncvarid, & & 7,'molP/kg',25,'Zooplankton concentr. 14c', & & rmissing,41,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,8,'calciu13',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,8,'calciu13',3,ncdimst,ncvarid, & & 7,'molC/kg',19,'Calcium carbonate13', & & rmissing,42,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,8,'calciu14',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,8,'calciu14',3,ncdimst,ncvarid, & & 7,'molC/kg',19,'Calcium carbonate14', & & rmissing,43,io_stdo_bgc) endif if (use_AGG) then - CALL NETCDF_DEF_VARDB(ncid,4,'snos',3,ncdimst,ncvarid, & + 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) - CALL NETCDF_DEF_VARDB(ncid,5,'adust',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,5,'adust',3,ncdimst,ncvarid, & & 4,'g/kg',15,'Aggregated dust', & & rmissing,45,io_stdo_bgc) endif if (use_CFC) then - CALL NETCDF_DEF_VARDB(ncid,5,'cfc11',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,5,'cfc11',3,ncdimst,ncvarid, & & 6,'mol/kg',5,'CFC11', & & rmissing,47,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,5,'cfc12',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,5,'cfc12',3,ncdimst,ncvarid, & & 6,'mol/kg',5,'CFC12', & & rmissing,48,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,3,'sf6',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,3,'sf6',3,ncdimst,ncvarid, & & 6,'mol/kg',4,'SF-6', & & rmissing,49,io_stdo_bgc) endif if (use_natDIC) then - CALL NETCDF_DEF_VARDB(ncid,9,'natsco212',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,9,'natsco212',3,ncdimst,ncvarid, & & 6,'mol/kg',21, 'Natural dissolved CO2',rmissing,50,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,9,'natalkali',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,9,'natalkali',3,ncdimst,ncvarid, & & 6,'mol/kg',18,'Natural alkalinity',rmissing,51,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,9,'natcalciu',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,9,'natcalciu',3,ncdimst,ncvarid, & & 6,'mol/kg',25,'Natural calcium carbonate', & & rmissing,52,io_stdo_bgc) endif if (use_BROMO) then - CALL NETCDF_DEF_VARDB(ncid,5,'bromo',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,5,'bromo',3,ncdimst,ncvarid, & & 6,'mol/kg',9,'Bromoform',rmissing,47,io_stdo_bgc) endif @@ -588,24 +559,24 @@ SUBROUTINE AUFW_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & ncdimst(4) = 0 ENDIF - CALL NETCDF_DEF_VARDB(ncid,2,'hi',3,ncdimst,ncvarid, & + 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, & + 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, & + 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, & + call NETCDF_DEF_VARDB(ncid,6,'satoxy',3,ncdimst,ncvarid, & & 6,'mol/kg',16 ,'Saturated oxygen', & & rmissing,63,io_stdo_bgc) if (use_natDIC) then - CALL NETCDF_DEF_VARDB(ncid,5,'nathi',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,5,'nathi',3,ncdimst,ncvarid, & & 6,'mol/kg',34,'Natural hydrogen ion concentration', & & rmissing,64,io_stdo_bgc) endif @@ -622,72 +593,72 @@ SUBROUTINE AUFW_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & ncdimst(4) = 0 ENDIF - CALL NETCDF_DEF_VARDB(ncid,6,'ssso12',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,6,'ssso12',3,ncdimst,ncvarid, & & 9,'kmol/m**3',35,'Sediment accumulated organic carbon', & & rmissing,70,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,6,'sssc12',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,6,'sssc12',3,ncdimst,ncvarid, & & 9,'kmol/m**3',38,'Sediment accumulated calcium carbonate', & & rmissing,71,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,6,'ssssil',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,6,'ssssil',3,ncdimst,ncvarid, & & 9,'kmol/m**3',25,'Sediment accumulated opal', & & rmissing,72,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,6,'ssster',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,6,'ssster',3,ncdimst,ncvarid, & & 7,'kg/m**3',25,'Sediment accumulated clay', & & rmissing,73,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,6,'powaic',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,6,'powaic',3,ncdimst,ncvarid, & & 9,'kmol/m**3',23,'Sediment pore water CO2', & & rmissing,74,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,6,'powaal',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,6,'powaal',3,ncdimst,ncvarid, & & 9,'kmol/m**3',30,'Sediment pore water alkalinity', & & rmissing,75,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,6,'powaph',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,6,'powaph',3,ncdimst,ncvarid, & & 9,'kmol/m**3',29,'Sediment pore water phosphate', & & rmissing,76,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,6,'powaox',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,6,'powaox',3,ncdimst,ncvarid, & & 9,'kmol/m**3',26,'Sediment pore water oxygen', & & rmissing,77,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,5,'pown2',3,ncdimst,ncvarid, & + 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) - CALL NETCDF_DEF_VARDB(ncid,6,'powno3',3,ncdimst,ncvarid, & + 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) - CALL NETCDF_DEF_VARDB(ncid,6,'powasi',3,ncdimst,ncvarid, & + 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) if (use_cisonew) then - CALL NETCDF_DEF_VARDB(ncid,6,'ssso13',3,ncdimst,ncvarid, & + 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, & + 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, & + 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, & + 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, & + 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, & + call NETCDF_DEF_VARDB(ncid,6,'powc14',3,ncdimst,ncvarid, & & 9,'kmol/m**3',25,'Sediment pore water DIC14', & & rmissing,86,io_stdo_bgc) @@ -700,7 +671,7 @@ SUBROUTINE AUFW_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & ncdimst(4) = 0 ENDIF - CALL NETCDF_DEF_VARDB(ncid,6,'sedhpl',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,6,'sedhpl',3,ncdimst,ncvarid, & & 9,'kmol/m**2',34,'Sediment accumulated hydrogen ions', & & rmissing,87,io_stdo_bgc) ! @@ -714,36 +685,36 @@ SUBROUTINE AUFW_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & ncdimst(4) = 0 ENDIF - CALL NETCDF_DEF_VARDB(ncid,7,'bur_o12',3,ncdimst,ncvarid, & + 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) - CALL NETCDF_DEF_VARDB(ncid,7,'bur_c12',3,ncdimst,ncvarid, & + 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) - CALL NETCDF_DEF_VARDB(ncid,7,'bur_sil',3,ncdimst,ncvarid, & + 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) - CALL NETCDF_DEF_VARDB(ncid,8,'bur_clay',3,ncdimst,ncvarid, & + 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) if (use_cisonew) then - CALL NETCDF_DEF_VARDB(ncid,8,'bur_o13',3,ncdimst,ncvarid, & + 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, & + 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, & + 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, & + 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 @@ -762,28 +733,28 @@ SUBROUTINE AUFW_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & ncdimst(4) = 0 ENDIF - CALL NETCDF_DEF_VARDB(ncid,6,'atmco2',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,6,'atmco2',3,ncdimst,ncvarid, & & 3,'ppm',15,'atmospheric CO2', & & rmissing,101,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,5,'atmo2',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,5,'atmo2',3,ncdimst,ncvarid, & & 3,'ppm',14,'atmospheric O2', & & rmissing,102,io_stdo_bgc) - CALL NETCDF_DEF_VARDB(ncid,5,'atmn2',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,5,'atmn2',3,ncdimst,ncvarid, & & 3,'ppm',14,'atmospheric N2', & & rmissing,103,io_stdo_bgc) if (use_cisonew) then - CALL NETCDF_DEF_VARDB(ncid,6,'atmc13',3,ncdimst,ncvarid, & + 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, & + call NETCDF_DEF_VARDB(ncid,6,'atmc14',3,ncdimst,ncvarid, & & 3,'ppm',17,'atmospheric 14CO2', & & rmissing,105,io_stdo_bgc) endif if (use_natDIC) then - CALL NETCDF_DEF_VARDB(ncid,7,'atmnco2',3,ncdimst,ncvarid, & + call NETCDF_DEF_VARDB(ncid,7,'atmnco2',3,ncdimst,ncvarid, & & 3,'ppm',23,'natural atmospheric CO2', & & rmissing,106,io_stdo_bgc) endif @@ -821,116 +792,116 @@ SUBROUTINE AUFW_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & ! 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) + 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) + 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 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) + 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 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) + 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 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) + 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 if (use_BROMO) then - CALL write_netcdf_var(ncid,'bromo',locetra(1,1,1,ibromo),2*kpke,0) + 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) + 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) + call write_netcdf_var(ncid,'nathi',nathi(1,1,1),kpke,0) endif ! ! 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) - CALL write_netcdf_var(ncid,'ssster',sedlay2(1,1,1,issster),2*ks,0) - CALL write_netcdf_var(ncid,'bur_o12',burial2(1,1,1,issso12),2,0) - CALL write_netcdf_var(ncid,'bur_c12',burial2(1,1,1,isssc12),2,0) - CALL write_netcdf_var(ncid,'bur_sil',burial2(1,1,1,issssil),2,0) - CALL write_netcdf_var(ncid,'bur_clay',burial2(1,1,1,issster),2,0) - CALL write_netcdf_var(ncid,'sedhpl',sedhpl(1,1,1),ks,0) - CALL write_netcdf_var(ncid,'powaic',powtra2(1,1,1,ipowaic),2*ks,0) - CALL write_netcdf_var(ncid,'powaal',powtra2(1,1,1,ipowaal),2*ks,0) - CALL write_netcdf_var(ncid,'powaph',powtra2(1,1,1,ipowaph),2*ks,0) - CALL write_netcdf_var(ncid,'powaox',powtra2(1,1,1,ipowaox),2*ks,0) - 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) + 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) + call write_netcdf_var(ncid,'ssster',sedlay2(1,1,1,issster),2*ks,0) + call write_netcdf_var(ncid,'bur_o12',burial2(1,1,1,issso12),2,0) + call write_netcdf_var(ncid,'bur_c12',burial2(1,1,1,isssc12),2,0) + call write_netcdf_var(ncid,'bur_sil',burial2(1,1,1,issssil),2,0) + call write_netcdf_var(ncid,'bur_clay',burial2(1,1,1,issster),2,0) + call write_netcdf_var(ncid,'sedhpl',sedhpl(1,1,1),ks,0) + call write_netcdf_var(ncid,'powaic',powtra2(1,1,1,ipowaic),2*ks,0) + call write_netcdf_var(ncid,'powaal',powtra2(1,1,1,ipowaal),2*ks,0) + call write_netcdf_var(ncid,'powaph',powtra2(1,1,1,ipowaph),2*ks,0) + call write_netcdf_var(ncid,'powaox',powtra2(1,1,1,ipowaox),2*ks,0) + 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) 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) + 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 (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) + 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) 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) + 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 if (use_natDIC) then - CALL write_netcdf_var(ncid,'atmnco2',atm2(1,1,1,iatmnco2),2,0) + call write_netcdf_var(ncid,'atmnco2',atm2(1,1,1,iatmnco2),2,0) endif endif @@ -951,10 +922,10 @@ SUBROUTINE AUFW_BGC(kpie,kpje,kpke,ntr,ntrbgc,itrbgc,trc, & ENDIF IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*) 'End of AUFW_BGC' - WRITE(io_stdo_bgc,*) '***************' + write(io_stdo_bgc,*) 'End of AUFW_BGC' + write(io_stdo_bgc,*) '***************' ENDIF - END SUBROUTINE AUFW_BGC + end subroutine aufw_bgc -END MODULE MO_AUFW_BGC +end module mo_aufw_bgc diff --git a/hamocc/mo_bgcmean.F90 b/hamocc/mo_bgcmean.F90 index 786eff46..140abef7 100644 --- a/hamocc/mo_bgcmean.F90 +++ b/hamocc/mo_bgcmean.F90 @@ -18,41 +18,33 @@ ! along with BLOM. If not, see https://www.gnu.org/licenses/. -MODULE mo_bgcmean +module mo_bgcmean + !*********************************************************************** + ! Variables for bgcmean. + ! - declaration and memory allocation + ! - declaration of auxiliary functions ! - !**** *MODULE mo_bgcmean* - Variables for bgcmean. - ! - ! - ! Patrick Wetzel *MPI-Met, HH* 09.12.02 - ! Ingo Bethke *Bjer.NE. C.* 05.11.09 - ! J. Schwinger *GFI, UiB 10.02.12 - ! - added variables and functions for sediment burial - ! - added variables for CFC output - ! - added initialisation of namelist variables and - ! index arrays - ! - ! Tjiputra *UNI-RESEARCH 25.11.15 - ! - added natural DIC/ALK/CALC/OMEGAC variables - ! - ! A.Moree, *GFI, Bergen* 2018-04-12 - ! - new version of carbon isotope code - ! - ! J.Tjiputra, *Uni Research, Bergen* 2018-04-12 - ! - added preformed and saturated DIC tracers - ! - ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 - ! - changed naming of particle fluxes - ! - removed output of AOU and added O2_sat instead - ! - added output of omegaA - ! - added sediment bypass preprocessor option - ! - ! Purpose - ! ------- - ! - declaration and memory allocation - ! - declaration of auxiliary functions - ! + ! Patrick Wetzel *MPI-Met, HH* 09.12.02 + ! Ingo Bethke *Bjer.NE. C.* 05.11.09 + ! J. Schwinger *GFI, UiB 10.02.12 + ! - added variables and functions for sediment burial + ! - added variables for CFC output + ! - added initialisation of namelist variables and + ! index arrays + ! Tjiputra *UNI-RESEARCH 25.11.15 + ! - added natural DIC/ALK/CALC/OMEGAC variables + ! A.Moree, *GFI, Bergen* 2018-04-12 + ! - new version of carbon isotope code + ! J.Tjiputra, *Uni Research, Bergen* 2018-04-12 + ! - added preformed and saturated DIC tracers + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - changed naming of particle fluxes + ! - removed output of AOU and added O2_sat instead + ! - added output of omegaA + ! - added sediment bypass preprocessor option !********************************************************************** + use mod_xc, only: ii,jj,kk,idm,jdm,kdm,nbdy,ifp,isp,ilp,mnproc,ip use mod_dia, only: ddm,depthslev,depthslev_bnds,nstepinday,pbath use mod_nctools, only: ncpack,nccomp,nccopa,ncwrtr @@ -60,21 +52,48 @@ MODULE mo_bgcmean 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 - - PRIVATE :: ii,jj,kk,idm,jdm,kdm,nbdy,ifp,isp,ilp - PUBLIC :: ks,ddm,depthslev,depthslev_bnds + implicit NONE + + ! routines + public :: alloc_mem_bgcmean + public :: inisrf ! initialise 2d diagnostic field + public :: inilyr ! initialise layer diagnostic field + public :: inilvl ! initialise level diagnostic field + public :: inisdm ! initialise sediment diagnostic field + public :: inibur ! initialise sediment burial diagnostic field + public :: accsrf ! accumulate 2d fields + public :: acclyr ! accumulate layer fields + public :: acclvl ! accumulate 3d level fields + public :: accsdm ! accumulate sediment fields + public :: accbur ! accumulate sediment burial fields + public :: finsrf ! finalise accumulation of weighted 2d fields + public :: finlyr ! finalise accumulation of weighted 3d layer fields + public :: wrtsrf ! writes diagnostic 2d field to file + public :: wrtlyr ! writes diagnostic layer field to file + public :: wrtlvl ! writes diagnostic level field to file + public :: wrtsdm ! writes diagnostic sediment field to file + public :: wrtbur ! writes diagnostic sediment burial field to file + public :: logsrf ! replace 2d field with log10(field) + public :: loglyr ! replace layer field with log10(field) + public :: loglvl ! replace level field with log10(field) + public :: logsdm ! replace sediment field with log10(field) + public :: msksrf ! set sea floor points to NaN in mass flux fields + public :: msklvl ! set sea floor points to NaN in level fields + public :: bgczlv + + private :: ii,jj,kk,idm,jdm,kdm,nbdy,ifp,isp,ilp + + public :: ks,ddm,depthslev,depthslev_bnds ! --- Averaging and writing frequencies for diagnostic output - INTEGER, SAVE :: nbgc - INTEGER, PARAMETER :: nbgcmax=10 - REAL, DIMENSION(nbgcmax), SAVE :: diagfq_bgc,filefq_bgc - INTEGER, DIMENSION(nbgcmax), SAVE :: nacc_bgc - LOGICAL, DIMENSION(nbgcmax), SAVE :: diagmon_bgc,diagann_bgc, & - & filemon_bgc,fileann_bgc,bgcwrt + integer :: nbgc + integer, parameter :: nbgcmax=10 + real, dimension(nbgcmax) :: diagfq_bgc,filefq_bgc + integer, dimension(nbgcmax) :: nacc_bgc + logical, dimension(nbgcmax) :: diagmon_bgc,diagann_bgc,filemon_bgc,fileann_bgc,bgcwrt ! --- Namelist for diagnostic output - INTEGER, DIMENSION(nbgcmax), SAVE :: & + integer, dimension(nbgcmax) :: & & SRF_KWCO2 =0 ,SRF_PCO2 =0 ,SRF_DMSFLUX =0 , & & SRF_KWCO2KHM =0 ,SRF_CO2KHM =0 ,SRF_CO2KH =0 , & & SRF_PCO2M =0 , & @@ -151,8 +170,9 @@ MODULE mo_bgcmean & BUR_SSSTER =0 , & & GLB_AVEPERIO =0 ,GLB_FILEFREQ =0 ,GLB_COMPFLAG =0 , & & GLB_NCFORMAT =0 ,GLB_INVENTORY =0 - CHARACTER(LEN=10), DIMENSION(nbgcmax), SAVE :: GLB_FNAMETAG - namelist /DIABGC/ & + + character(len=10), dimension(nbgcmax) :: glb_fnametag + namelist /diabgc/ & & SRF_KWCO2 ,SRF_PCO2 ,SRF_DMSFLUX , & & SRF_KWCO2KHM ,SRF_CO2KHM ,SRF_CO2KH , & & SRF_PCO2M , & @@ -234,7 +254,7 @@ MODULE mo_bgcmean ! declarations for inventory_bgc.F90 ! order and increments of river (jir...) indices require to be the same ! as in mo_riverinpt - INTEGER, parameter :: & + integer, parameter :: & & jco2flux =1, & & jo2flux =2, & & jn2flux =3, & @@ -261,8 +281,8 @@ MODULE mo_bgcmean & nbgct2d =23 !---------------------------------------------------------------- - INTEGER, SAVE :: i_bsc_m2d - INTEGER, DIMENSION(nbgcmax), SAVE :: & + integer :: i_bsc_m2d + integer, dimension(nbgcmax) :: & & jkwco2 = 0 , & & jkwco2khm = 0 , & & jco2kh = 0 , & @@ -322,7 +342,7 @@ MODULE mo_bgcmean & jcalflx4000= 0 , & & jcalflx_bot= 0 - INTEGER, DIMENSION(nbgcmax), SAVE :: & + integer, dimension(nbgcmax) :: & & jsediffic = 0 , & & jsediffal = 0 , & & jsediffph = 0 , & @@ -331,21 +351,21 @@ MODULE mo_bgcmean & jsediffno3 = 0 , & jsediffsi = 0 - INTEGER, DIMENSION(nbgcmax), SAVE :: & + integer, dimension(nbgcmax) :: & & jsrfnatdic = 0 , & & jsrfnatalk = 0 , & & jnatpco2 = 0 , & & jnatco2fx = 0 , & & jsrfnatph = 0 - INTEGER, DIMENSION(nbgcmax), SAVE :: & + integer, dimension(nbgcmax) :: & & jbromofx = 0 , & & jsrfbromo = 0 , & & jbromo_prod= 0 , & & jbromo_uv = 0 - INTEGER, SAVE :: i_atm_m2d - INTEGER, DIMENSION(nbgcmax), SAVE :: & + integer :: i_atm_m2d + integer, dimension(nbgcmax) :: & & jatmco2 = 0 , & & jatmo2 = 0 , & & jatmn2 = 0 , & @@ -353,13 +373,13 @@ MODULE mo_bgcmean & jatmc14 = 0 , & & jatmbromo= 0 - INTEGER, SAVE :: nbgcm2d + integer :: nbgcm2d - LOGICAL, SAVE :: domassfluxes = .false. + logical :: domassfluxes = .false. !---------------------------------------------------------------- - INTEGER, SAVE :: i_bsc_m3d,ilvl_bsc_m3d - INTEGER, DIMENSION(nbgcmax), SAVE :: & + integer :: i_bsc_m3d,ilvl_bsc_m3d + integer, dimension(nbgcmax) :: & & jdp = 0 , & & jphyto = 0 , & & jgrazer = 0 , & @@ -418,7 +438,7 @@ MODULE mo_bgcmean & jlvlcfc12 = 0 , & & jlvlsf6 = 0 - INTEGER, DIMENSION(nbgcmax), SAVE :: & + integer, dimension(nbgcmax) :: & & jdic13 = 0 , & & jdic14 = 0 , & & jd13c = 0 , & @@ -440,7 +460,7 @@ MODULE mo_bgcmean & jlvlphyto13 = 0, & & jlvlgrazer13= 0 - INTEGER, DIMENSION(nbgcmax), SAVE :: & + integer, dimension(nbgcmax) :: & & jnos = 0 , & & jwphy = 0 , & & jwnos = 0 , & @@ -452,7 +472,7 @@ MODULE mo_bgcmean & jlvleps = 0 , & & jlvlasize = 0 - INTEGER, DIMENSION(nbgcmax), SAVE :: & + integer, dimension(nbgcmax) :: & & jnatco3 = 0 , & & jnatalkali = 0 , & & jnatdic = 0 , & @@ -468,16 +488,16 @@ MODULE mo_bgcmean & jlvlnatomegaa = 0 , & & jlvlnatomegac = 0 - INTEGER, DIMENSION(nbgcmax), SAVE :: & + integer, dimension(nbgcmax) :: & & jbromo = 0 , & & jlvlbromo = 0 - INTEGER, SAVE :: nbgcm3d,nbgcm3dlvl + integer :: nbgcm3d,nbgcm3dlvl !---------------------------------------------------------------- ! sediment - INTEGER, SAVE :: i_bsc_sed - INTEGER, DIMENSION(nbgcmax), SAVE :: & + integer :: i_bsc_sed + integer, dimension(nbgcmax) :: & & jpowaic = 0 , & & jpowaal = 0 , & & jpowaph = 0 , & @@ -491,51 +511,49 @@ MODULE mo_bgcmean & jssster = 0 - INTEGER, SAVE :: nbgct_sed + integer :: nbgct_sed !---------------------------------------------------------------- ! burial - INTEGER, SAVE :: i_bsc_bur - INTEGER, DIMENSION(nbgcmax), SAVE :: & + integer :: i_bsc_bur + integer, dimension(nbgcmax) :: & & jburssso12 = 0 , & & jbursssc12 = 0 , & & jburssssil = 0 , & & jburssster = 0 - INTEGER, SAVE :: nbgct_bur + integer :: nbgct_bur !---------------------------------------------------------------- - - REAL, DIMENSION (:,:,:), ALLOCATABLE :: bgct2d - REAL, DIMENSION (:,:,:), ALLOCATABLE :: bgcm2d - REAL, DIMENSION (:,:,:,:), ALLOCATABLE :: bgcm3d,bgcm3dlvl - REAL, DIMENSION (:,:,:,:), ALLOCATABLE :: bgct_sed - REAL, DIMENSION (:,:,:), ALLOCATABLE :: bgct_bur - + real, dimension (:,:,:), allocatable :: bgct2d + real, dimension (:,:,:), allocatable :: bgcm2d + real, dimension (:,:,:,:), allocatable :: bgcm3d,bgcm3dlvl + real, dimension (:,:,:,:), allocatable :: bgct_sed + real, dimension (:,:,:), allocatable :: bgct_bur CONTAINS - SUBROUTINE ALLOC_MEM_BGCMEAN(kpie,kpje,kpke) use mo_control_bgc, only: io_stdo_bgc,bgc_namelist,get_bgc_namelist IMPLICIT NONE - INTEGER, intent(in) :: kpie,kpje,kpke + ! Arguments + integer, intent(in) :: kpie,kpje,kpke - INTEGER :: m,n,errstat,iounit,checkdp(nbgcmax) + ! Local variables + INTEGER :: m,n,errstat,iounit,checkdp(nbgcmax) - ! Read namelist for diagnostic output + ! Read namelist for diagnostic output GLB_AVEPERIO=0 if(.not. allocated(bgc_namelist)) call get_bgc_namelist - OPEN (newunit=iounit, file=bgc_namelist, & - status='old', action='read', recl=80) - READ (iounit,nml=diabgc) - CLOSE (iounit) + open (newunit=iounit, file=bgc_namelist, status='old', action='read', recl=80) + read (iounit,nml=diabgc) + close (iounit) - ! Determine number of output groups + ! Determine number of output groups nbgc=0 DO n=1,nbgcmax IF (GLB_AVEPERIO(n).NE.0) THEN @@ -572,7 +590,7 @@ SUBROUTINE ALLOC_MEM_BGCMEAN(kpie,kpje,kpke) ENDIF ENDDO - ! Re-define index variables according to namelist + ! Re-define index variables according to namelist i_bsc_m2d=0 DO n=1,nbgc IF (SRF_KWCO2(n).GT.0) i_bsc_m2d=i_bsc_m2d+1 @@ -735,12 +753,12 @@ SUBROUTINE ALLOC_MEM_BGCMEAN(kpie,kpje,kpke) endif ENDDO - domassfluxes = any( & - jcarflx0100+jcarflx0500+jcarflx1000+ & - jcarflx2000+jcarflx4000+jcarflx_bot+ & - jbsiflx0100+jbsiflx0500+jbsiflx1000+ & - jbsiflx2000+jbsiflx4000+jbsiflx_bot+ & - jcalflx0100+jcalflx0500+jcalflx1000+ & + domassfluxes = any( & + jcarflx0100+jcarflx0500+jcarflx1000+ & + jcarflx2000+jcarflx4000+jcarflx_bot+ & + jbsiflx0100+jbsiflx0500+jbsiflx1000+ & + jbsiflx2000+jbsiflx4000+jbsiflx_bot+ & + jcalflx0100+jcalflx0500+jcalflx1000+ & jcalflx2000+jcalflx4000+jcalflx_bot > 0) i_atm_m2d=i_bsc_m2d @@ -1003,7 +1021,7 @@ SUBROUTINE ALLOC_MEM_BGCMEAN(kpie,kpje,kpke) ENDDO - ! add dp required + ! add dp required DO n=1,nbgc IF (checkdp(n).NE.0.AND.LYR_DP(n).EQ.0) THEN i_bsc_m3d=i_bsc_m3d+1 @@ -1057,89 +1075,83 @@ SUBROUTINE ALLOC_MEM_BGCMEAN(kpie,kpje,kpke) nbgct_sed = i_bsc_sed nbgct_bur = i_bsc_bur - ! Allocate buffers + ! Allocate buffers IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'***************************************************' - WRITE(io_stdo_bgc,*)'Memory allocation for averaging model output :' - WRITE(io_stdo_bgc,*)' ' + write(io_stdo_bgc,*)' ' + write(io_stdo_bgc,*)'***************************************************' + write(io_stdo_bgc,*)'Memory allocation for averaging model output :' + write(io_stdo_bgc,*)' ' ENDIF IF (mnproc.EQ.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable bgct2d ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',nbgct2d + write(io_stdo_bgc,*)'Memory allocation for variable bgct2d ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Third dimension : ',nbgct2d ENDIF - ALLOCATE (bgct2d(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy,nbgct2d), & - & stat=errstat) + allocate (bgct2d(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy,nbgct2d),stat=errstat) IF (errstat.NE.0) STOP 'not enough memory bgct2d' IF (nbgct2d.NE.0) bgct2d=0. IF (mnproc.EQ.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable bgcm2d ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',nbgcm2d + write(io_stdo_bgc,*)'Memory allocation for variable bgcm2d ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Third dimension : ',nbgcm2d ENDIF - ALLOCATE (bgcm2d(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy,nbgcm2d), & - & stat=errstat) + allocate (bgcm2d(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy,nbgcm2d),stat=errstat) IF (errstat.NE.0) STOP 'not enough memory bgcm2d' IF (nbgcm2d.NE.0) bgcm2d=0. IF (mnproc.EQ.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable bgcm3d ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',kpke - WRITE(io_stdo_bgc,*)'Forth dimension : ',nbgcm3d + write(io_stdo_bgc,*)'Memory allocation for variable bgcm3d ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Third dimension : ',kpke + write(io_stdo_bgc,*)'Forth dimension : ',nbgcm3d ENDIF - ALLOCATE (bgcm3d(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy,kpke,nbgcm3d), & - & stat=errstat) + allocate (bgcm3d(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy,kpke,nbgcm3d),stat=errstat) IF (errstat.NE.0) STOP 'not enough memory bgcm3d' IF (nbgcm3d.NE.0) bgcm3d=0. IF (mnproc.EQ.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable bgcm3dlvl ' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',kpke - WRITE(io_stdo_bgc,*)'Forth dimension : ',nbgcm3dlvl + write(io_stdo_bgc,*)'Memory allocation for variable bgcm3dlvl ' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Third dimension : ',kpke + write(io_stdo_bgc,*)'Forth dimension : ',nbgcm3dlvl ENDIF - ALLOCATE (bgcm3dlvl(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy,ddm, & - & nbgcm3dlvl),stat=errstat) + allocate (bgcm3dlvl(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy,ddm,nbgcm3dlvl),stat=errstat) IF (errstat.NE.0) STOP 'not enough memory bgcm3dlvl' IF (nbgcm3dlvl.NE.0) bgcm3dlvl=0. 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 + 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) + 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 + 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) + 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 @@ -1152,18 +1164,14 @@ SUBROUTINE inisrf(pos,inival) ! ! --- ------------------------------------------------------------------ ! --- Description: initialise 2d diagnostic field - ! --- - ! --- Arguments: - ! --- int pos (in) : position in common buffer - ! --- real inival (in) : value used for initalisation ! --- ------------------------------------------------------------------ ! - IMPLICIT NONE - ! - INTEGER :: pos - REAL ::inival + ! Arguments + integer, intent(in) :: pos ! position in common buffer + real, intent(in) :: inival ! value used for initalisation ! - INTEGER :: i,j,l + ! Local variables + integer :: i,j,l ! ! --- Check whether field should be initialised IF (pos.EQ.0) RETURN @@ -1186,18 +1194,14 @@ SUBROUTINE inilyr(pos,inival) ! ! --- ------------------------------------------------------------------ ! --- Description: initialise layer diagnostic field - ! --- - ! --- Arguments: - ! --- int pos (in) : position in common buffer - ! --- real inival (in) : value used for initalisation ! --- ------------------------------------------------------------------ ! - IMPLICIT NONE + ! Arguments + integer, intent(in) :: pos ! position in common buffer + real, intent(in) :: inival ! value used for initalisation ! - INTEGER :: pos - REAL ::inival - ! - INTEGER :: i,j,k,l + ! Local variables + integer :: i,j,k,l ! ! --- Check whether field should be initialised IF (pos.EQ.0) RETURN @@ -1222,18 +1226,14 @@ SUBROUTINE inilvl(pos,inival) ! ! --- ------------------------------------------------------------------ ! --- Description: initialise level diagnostic field - ! --- - ! --- Arguments: - ! --- int pos (in) : position in common buffer - ! --- real inival (in) : value used for initalisation ! --- ------------------------------------------------------------------ ! - IMPLICIT NONE + ! Arguments + integer, intent(in) :: pos ! position in common buffer + real, intent(in) :: inival ! value used for initalisation ! - INTEGER :: pos - REAL ::inival - ! - INTEGER :: i,j,k,l + ! Local variables + integer :: i,j,k,l ! ! --- Check whether field should be initialised IF (pos.EQ.0) RETURN @@ -1258,18 +1258,14 @@ SUBROUTINE inisdm(pos,inival) ! ! --- ------------------------------------------------------------------ ! --- Description: initialise sediment diagnostic field - ! --- - ! --- Arguments: - ! --- int pos (in) : position in common buffer - ! --- real inival (in) : value used for initalisation ! --- ------------------------------------------------------------------ ! - IMPLICIT NONE - ! - INTEGER :: pos - REAL ::inival + ! Arguments + integer, intent(in) :: pos ! position in common buffer + real, intent(in) :: inival ! value used for initalisation ! - INTEGER :: i,j,k,l + ! Local variables + integer :: i,j,k,l ! ! --- Check whether field should be initialised IF (pos.EQ.0) RETURN @@ -1294,18 +1290,14 @@ SUBROUTINE inibur(pos,inival) ! ! --- ------------------------------------------------------------------ ! --- Description: initialise sediment burial diagnostic field - ! --- - ! --- Arguments: - ! --- int pos (in) : position in common buffer - ! --- real inival (in) : value used for initalisation ! --- ------------------------------------------------------------------ ! - IMPLICIT NONE - ! - INTEGER :: pos - REAL ::inival + ! Arguments + integer, intent(in) :: pos ! position in common buffer + real, intent(in) :: inival ! value used for initalisation ! - INTEGER :: i,j,l + ! Local variables + integer :: i,j,k,l ! ! --- Check whether field should be initialised IF (pos.EQ.0) RETURN @@ -1328,19 +1320,16 @@ SUBROUTINE accsrf(pos,fld,wghts,wghtsflg) ! ! --- ------------------------------------------------------------------ ! --- Description: accumulate 2d fields - ! --- - ! --- Arguments: - ! --- int pos (in) : position in 2d buffer - ! --- real fld (in) : input data used for accumulation - ! --- real wghts (in) : weights used for accumulation ! --- ------------------------------------------------------------------ ! - IMPLICIT NONE - ! - INTEGER :: pos(nbgcmax),wghtsflg - REAL, DIMENSION(idm,jdm) :: fld,wghts + ! Arguments + integer, intent(in) :: pos(nbgcmax) ! position in 2d buffer + real, intent(in) :: fld(idm,jdm) ! input data used for accumulation + real, intent(in) :: wghts(idm,jdm) ! weights used for accumulation + integer, intent(in) :: wghtsflg ! - INTEGER :: i,j,l,o + ! Local variables + integer :: i,j,l,o ! ! --- Check whether field should be accumulated DO o=1,nbgc @@ -1351,7 +1340,7 @@ SUBROUTINE accsrf(pos,fld,wghts,wghtsflg) DO j=1,jj DO l=1,isp(j) DO i=max(1,ifp(j,l)),min(ii,ilp(j,l)) - bgcm2d(i,j,pos(o))=bgcm2d(i,j,pos(o))+fld(i,j) + bgcm2d(i,j,pos(o))=bgcm2d(i,j,pos(o)) + fld(i,j) ENDDO ENDDO ENDDO @@ -1361,14 +1350,12 @@ SUBROUTINE accsrf(pos,fld,wghts,wghtsflg) DO j=1,jj DO l=1,isp(j) DO i=max(1,ifp(j,l)),min(ii,ilp(j,l)) - bgcm2d(i,j,pos(o))=bgcm2d(i,j,pos(o))+fld(i,j)* & - & wghts(i,j) + bgcm2d(i,j,pos(o))=bgcm2d(i,j,pos(o))+fld(i,j)*wghts(i,j) ENDDO ENDDO ENDDO !$OMP END PARALLEL DO ENDIF - ! ENDDO ! END SUBROUTINE accsrf @@ -1379,19 +1366,16 @@ SUBROUTINE acclyr(pos,fld,wghts,wghtsflg) ! ! --- ------------------------------------------------------------------ ! --- Description: accumulate layer fields - ! --- - ! --- Arguments: - ! --- int pos (in) : position in 3d layer buffer - ! --- real fld (in) : input data used for accumulation - ! --- real wghts (in) : weights used for accumulation ! --- ------------------------------------------------------------------ ! - IMPLICIT NONE - ! - INTEGER :: pos(nbgcmax),wghtsflg - REAL, DIMENSION(idm,jdm,kdm) :: fld,wghts + ! Arguments + integer, intent(in) :: pos(nbgcmax) ! position in 2d buffer + real, intent(in) :: fld(idm,jdm,kdm) ! input data used for accumulation + real, intent(in) :: wghts(idm,jdm,kdm) ! weights used for accumulation + integer, intent(in) :: wghtsflg ! - INTEGER :: i,j,k,l,o + ! Local variables + integer :: i,j,l,o,k ! ! --- Check whether field should be accumulated DO o=1,nbgc @@ -1403,8 +1387,7 @@ SUBROUTINE acclyr(pos,fld,wghts,wghtsflg) DO j=1,jj DO l=1,isp(j) DO i=max(1,ifp(j,l)),min(ii,ilp(j,l)) - bgcm3d(i,j,k,pos(o))=bgcm3d(i,j,k,pos(o))+ & - & fld(i,j,k) + bgcm3d(i,j,k,pos(o))=bgcm3d(i,j,k,pos(o)) + fld(i,j,k) ENDDO ENDDO ENDDO @@ -1416,8 +1399,7 @@ SUBROUTINE acclyr(pos,fld,wghts,wghtsflg) DO j=1,jj DO l=1,isp(j) DO i=max(1,ifp(j,l)),min(ii,ilp(j,l)) - bgcm3d(i,j,k,pos(o))=bgcm3d(i,j,k,pos(o))+ & - & fld(i,j,k)*wghts(i,j,k) + bgcm3d(i,j,k,pos(o))=bgcm3d(i,j,k,pos(o))+fld(i,j,k)*wghts(i,j,k) ENDDO ENDDO ENDDO @@ -1434,24 +1416,18 @@ SUBROUTINE acclvl(pos,fld,k,ind1,ind2,wghts) ! ! --- ------------------------------------------------------------------ ! --- Description: accumulate 3d level fields - ! --- - ! --- Arguments: - ! --- int pos (in) : position in buffer - ! --- real fld (in) : input data used for accumulation - ! --- int k (in) : layer index of fld - ! --- int ind1 (in) : index field for first accumulated level - ! --- int ind2 (in) : index field for last accumulated level - ! --- real wghts (in) : weights used for accumulation ! --- ------------------------------------------------------------------ ! - IMPLICIT NONE - ! - INTEGER :: pos(nbgcmax),k - INTEGER, DIMENSION(idm,jdm) :: ind1,ind2 - REAL, DIMENSION(idm,jdm,ddm) :: wghts - REAL, DIMENSION(idm,jdm,kdm) :: fld + ! Arguments + integer, intent(in) :: pos(nbgcmax) ! position in buffer + real, intent(in) :: fld(idm,jdm,ddm) ! input data used for accumulation + integer, intent(in) :: k ! layer index of fld + integer, intent(in) :: ind1(idm,jdm) ! index field for first accumulated level + integer, intent(in) :: ind2(idm,jdm) ! index field for last accumulated level + real, intent(in) :: wghts(idm,jdm,ddm) ! weights used for accumulation ! - INTEGER :: d,i,j,l,o + ! Local variables + integer :: d,i,j,l,o ! ! --- Check whether field should be accumulated DO o=1,nbgc @@ -1462,8 +1438,7 @@ SUBROUTINE acclvl(pos,fld,k,ind1,ind2,wghts) DO l=1,isp(j) DO i=max(1,ifp(j,l)),min(ii,ilp(j,l)) DO d=ind1(i,j),ind2(i,j) - bgcm3dlvl(i,j,d,pos(o))=bgcm3dlvl(i,j,d,pos(o))+ & - & fld(i,j,k)*wghts(i,j,d) + bgcm3dlvl(i,j,d,pos(o))=bgcm3dlvl(i,j,d,pos(o))+fld(i,j,k)*wghts(i,j,d) ENDDO ENDDO ENDDO @@ -1479,18 +1454,14 @@ SUBROUTINE accsdm(pos,fld) ! ! --- ------------------------------------------------------------------ ! --- Description: accumulate sediment fields - ! --- - ! --- Arguments: - ! --- int pos (in) : position in 3d layer buffer - ! --- real fld (in) : input data used for accumulation ! --- ------------------------------------------------------------------ ! - IMPLICIT NONE + ! Arguments + integer, intent(in) :: pos(nbgcmax) ! position in 3d layer buffer + real, intent(in) :: fld(idm,jdm,ks) ! input data used for accumulation ! - INTEGER :: pos(nbgcmax) - REAL, DIMENSION(idm,jdm,ks) :: fld - ! - INTEGER :: i,j,k,l,o + ! Local variables + integer :: i,j,k,l,o ! ! --- Check whether field should be accumulated DO o=1,nbgc @@ -1517,18 +1488,14 @@ SUBROUTINE accbur(pos,fld) ! ! --- ------------------------------------------------------------------ ! --- Description: accumulate sediment burial fields - ! --- - ! --- Arguments: - ! --- int pos (in) : position in 3d layer buffer - ! --- real fld (in) : input data used for accumulation ! --- ------------------------------------------------------------------ ! - IMPLICIT NONE + ! Arguments + integer, intent(in) :: pos(nbgcmax) ! position in 3d layer buffer + real, intent(in) :: fld(idm,jdm) ! input data used for accumulation ! - INTEGER :: pos(nbgcmax) - REAL, DIMENSION(idm,jdm) :: fld - ! - INTEGER :: i,j,l,o + ! Local varaibles + integer :: i,j,l,o ! ! --- Check whether field should be accumulated DO o=1,nbgc @@ -1548,23 +1515,19 @@ SUBROUTINE accbur(pos,fld) END SUBROUTINE accbur - SUBROUTINE finsrf(posacc,poswgt) ! ! --- ------------------------------------------------------------------ ! --- Description: finalise accumulation of weighted 2d fields - ! --- - ! --- Arguments: - ! --- real posacc (in) : position of accumulated field in buffer - ! --- real poswgt (in) : position of accumulated weights ! --- ------------------------------------------------------------------ ! - IMPLICIT NONE - ! - INTEGER :: posacc,poswgt + ! Arguments + integer, intent(in) :: posacc ! position of accumulated field in buffer + integer, intent(in) :: poswgt ! position of accumulated weights ! - INTEGER :: i,j,l - REAL, parameter :: epsil=1e-11 + ! Local variables + integer :: i,j,l + real, parameter :: epsil=1e-11 ! ! --- Check whether field should be initialised IF (posacc.EQ.0) RETURN @@ -1573,8 +1536,7 @@ SUBROUTINE finsrf(posacc,poswgt) DO j=1,jj DO l=1,isp(j) DO i=max(1,ifp(j,l)),min(ii,ilp(j,l)) - bgcm2d(i,j,posacc)=bgcm2d(i,j,posacc)/ & - & max(epsil,bgcm2d(i,j,poswgt)) + bgcm2d(i,j,posacc)=bgcm2d(i,j,posacc)/max(epsil,bgcm2d(i,j,poswgt)) ENDDO ENDDO ENDDO @@ -1588,18 +1550,15 @@ SUBROUTINE finlyr(posacc,poswgt) ! ! --- ------------------------------------------------------------------ ! --- Description: finalise accumulation of weighted 3d layer fields - ! --- - ! --- Arguments: - ! --- real posacc (in) : position of accumulated field in buffer - ! --- real poswgt) (in) : position of accumulated weights ! --- ------------------------------------------------------------------ ! - IMPLICIT NONE - ! - INTEGER :: posacc,poswgt + ! Arguments + integer, intent(in) :: posacc ! position of accumulated field in buffer + integer, intent(in) :: poswgt ! position of accumulated weights ! - INTEGER :: i,j,k,l - REAL, parameter :: epsil=1e-11 + ! Local variables + integer :: i,j,k,l + real, parameter :: epsil=1e-11 ! ! --- Check whether field should be initialised IF (posacc.EQ.0) RETURN @@ -1610,8 +1569,7 @@ SUBROUTINE finlyr(posacc,poswgt) DO l=1,isp(j) DO i=max(1,ifp(j,l)),min(ii,ilp(j,l)) IF (bgcm3d(i,j,k,poswgt).GT.epsil) THEN - bgcm3d(i,j,k,posacc)=bgcm3d(i,j,k,posacc)/ & - & bgcm3d(i,j,k,poswgt) + bgcm3d(i,j,k,posacc)=bgcm3d(i,j,k,posacc)/bgcm3d(i,j,k,poswgt) ELSE bgcm3d(i,j,k,posacc)=nf90_fill_double ENDIF @@ -1629,30 +1587,23 @@ SUBROUTINE wrtsrf(pos,frmt,sfac,offs,cmpflg,vnm) ! ! --- ------------------------------------------------------------------ ! --- Description: writes diagnostic 2d field to file - ! --- - ! --- Arguments: - ! --- int pos (in) : variable position in common buffer - ! --- int frmt (in) : format/precision of output - ! --- 0=field is not written - ! --- 2=field is written as int2 with scale - ! --- factor and offset - ! --- 4=field is written as real4 - ! --- 8=field is written as real8 - ! --- real sfac (in) : user def.NE. scale factor to be applied - ! --- real offs (in) : user def.NE. offset to be added - ! --- int cmpflg (in) : compression flag; only wet points are - ! --- written IF flag is set to 1 - ! --- char vnm (in) : variable name used in nc-file ! --- ------------------------------------------------------------------ ! - IMPLICIT NONE - ! - REAL, intent(in) :: sfac,offs - INTEGER, intent(in) :: frmt,cmpflg,pos - CHARACTER(LEN=*),intent(in) :: vnm - ! - INTEGER :: n - CHARACTER(LEN=100) :: dims + ! Arguments + real, intent(in) :: sfac ! variable position in common buffer + real, intent(in) :: offs ! format/precision of output + ! 0=field is not written + ! 2=field is written as int2 with scale factor and offset + ! 4=field is written as real4 + ! 8=field is written as real8 + integer, intent(in) :: frmt ! user def.ne. scale factor to be applied + integer, intent(in) :: pos ! user def.ne. offset to be added + integer, intent(in) :: cmpflg ! compression flag; only wet points are written if flag is set to 1 + character(len=*), intent(in) :: vnm ! variable name used in nc-file + ! + ! Local variables + integer :: n + character(LEN=100) :: dims ! ! --- Check whether field should be written IF (pos.EQ.0 .OR. frmt.EQ.0) RETURN @@ -1667,27 +1618,21 @@ SUBROUTINE wrtsrf(pos,frmt,sfac,offs,cmpflg,vnm) ! --- Check output format IF (frmt.EQ.2) THEN IF (cmpflg.EQ.1) THEN - CALL nccopa(vnm,dims,bgcm2d(1-nbdy,1-nbdy,pos),ip,sfac, & - & offs) + call nccopa(vnm,dims,bgcm2d(1-nbdy,1-nbdy,pos),ip,sfac,offs) ELSE - CALL ncpack(vnm,dims,bgcm2d(1-nbdy,1-nbdy,pos),ip,2, & - & sfac,offs) + call ncpack(vnm,dims,bgcm2d(1-nbdy,1-nbdy,pos),ip,2,sfac,offs) ENDIF ELSEIF (frmt.EQ.4) THEN IF (cmpflg.EQ.1) THEN - CALL nccomp(vnm,dims,bgcm2d(1-nbdy,1-nbdy,pos),ip,sfac, & - & offs,4) + call nccomp(vnm,dims,bgcm2d(1-nbdy,1-nbdy,pos),ip,sfac,offs,4) ELSE - CALL ncwrtr(vnm,dims,bgcm2d(1-nbdy,1-nbdy,pos),ip,1, & - & sfac,offs,4) + call ncwrtr(vnm,dims,bgcm2d(1-nbdy,1-nbdy,pos),ip,1,sfac,offs,4) ENDIF ELSEIF (frmt.EQ.8) THEN IF (cmpflg.EQ.1) THEN - CALL nccomp(vnm,dims,bgcm2d(1-nbdy,1-nbdy,pos),ip,sfac, & - & offs,8) + call nccomp(vnm,dims,bgcm2d(1-nbdy,1-nbdy,pos),ip,sfac,offs,8) ELSE - CALL ncwrtr(vnm,dims,bgcm2d(1-nbdy,1-nbdy,pos),ip,1, & - & sfac,offs,8) + call ncwrtr(vnm,dims,bgcm2d(1-nbdy,1-nbdy,pos),ip,1,sfac,offs,8) ENDIF ELSE STOP 'unknown output format ' @@ -1701,30 +1646,23 @@ SUBROUTINE wrtlyr(pos,frmt,sfac,offs,cmpflg,vnm) ! ! --- ------------------------------------------------------------------ ! --- Description: writes diagnostic layer field to file - ! --- - ! --- Arguments: - ! --- int pos (in) : variable position in common buffer - ! --- int frmt (in) : format/precision of output - ! --- 0=field is not written - ! --- 2=field is written as int2 with scale - ! --- factor and offset - ! --- 4=field is written as real4 - ! --- 8=field is written as real8 - ! --- real sfac (in) : user def.NE. scale factor to be applied - ! --- real offs (in) : user def.NE. offset to be added - ! --- int cmpflg (in) : compression flag; only wet points are - ! --- written IF flag is set to 1 - ! --- char vnm (in) : variable name used in nc-file ! --- ------------------------------------------------------------------ ! - IMPLICIT NONE - ! - REAL, intent(in) :: sfac,offs - INTEGER, intent(in) :: frmt,cmpflg,pos - CHARACTER(LEN=*),intent(in) :: vnm - ! - INTEGER :: n - CHARACTER(LEN=100) :: dims + ! Arguments + real, intent(in) :: sfac ! variable position in common buffer + real, intent(in) :: offs ! format/precision of output + ! 0=field is not written + ! 2=field is written as int2 with scale factor and offset + ! 4=field is written as real4 + ! 8=field is written as real8 + integer, intent(in) :: frmt ! user def.ne. scale factor to be applied + integer, intent(in) :: pos ! user def.ne. offset to be added + integer, intent(in) :: cmpflg ! compression flag; only wet points are written if flag is set to 1 + character(len=*), intent(in) :: vnm ! variable name used in nc-file + ! + ! Local variables + integer :: n + character(LEN=100) :: dims ! ! --- Check whether field should be written IF (pos.EQ.0 .OR. frmt.EQ.0) RETURN @@ -1739,27 +1677,21 @@ SUBROUTINE wrtlyr(pos,frmt,sfac,offs,cmpflg,vnm) ! --- Check output format IF (frmt.EQ.2) THEN IF (cmpflg.EQ.1) THEN - CALL nccopa(vnm,dims,bgcm3d(1-nbdy,1-nbdy,1,pos),ip,sfac, & - & offs) + call nccopa(vnm,dims,bgcm3d(1-nbdy,1-nbdy,1,pos),ip,sfac,offs) ELSE - CALL ncpack(vnm,dims,bgcm3d(1-nbdy,1-nbdy,1,pos),ip,2, & - & sfac,offs) + call ncpack(vnm,dims,bgcm3d(1-nbdy,1-nbdy,1,pos),ip,2,sfac,offs) ENDIF ELSEIF (frmt.EQ.4) THEN IF (cmpflg.EQ.1) THEN - CALL nccomp(vnm,dims,bgcm3d(1-nbdy,1-nbdy,1,pos),ip,sfac, & - & offs,4) + call nccomp(vnm,dims,bgcm3d(1-nbdy,1-nbdy,1,pos),ip,sfac,offs,4) ELSE - CALL ncwrtr(vnm,dims,bgcm3d(1-nbdy,1-nbdy,1,pos),ip,2, & - & sfac,offs,4) + call ncwrtr(vnm,dims,bgcm3d(1-nbdy,1-nbdy,1,pos),ip,2,sfac,offs,4) ENDIF ELSEIF (frmt.EQ.8) THEN IF (cmpflg.EQ.1) THEN - CALL nccomp(vnm,dims,bgcm3d(1-nbdy,1-nbdy,1,pos),ip,sfac, & - & offs,8) + call nccomp(vnm,dims,bgcm3d(1-nbdy,1-nbdy,1,pos),ip,sfac,offs,8) ELSE - CALL ncwrtr(vnm,dims,bgcm3d(1-nbdy,1-nbdy,1,pos),ip,2, & - & sfac,offs,8) + call ncwrtr(vnm,dims,bgcm3d(1-nbdy,1-nbdy,1,pos),ip,2,sfac,offs,8) ENDIF ELSE STOP 'unknown output format ' @@ -1773,30 +1705,23 @@ SUBROUTINE wrtlvl(pos,frmt,sfac,offs,cmpflg,vnm) ! ! --- ------------------------------------------------------------------ ! --- Description: writes diagnostic level field to file - ! --- - ! --- Arguments: - ! --- int pos (in) : variable position in common buffer - ! --- int frmt (in) : format/precision of output - ! --- 0=field is not written - ! --- 2=field is written as int2 with scale - ! --- factor and offset - ! --- 4=field is written as real4 - ! --- 8=field is written as real8 - ! --- real sfac (in) : user def.NE. scale factor to be applied - ! --- real offs (in) : user def.NE. offset to be added - ! --- int cmpflg (in) : compression flag; only wet points are - ! --- written IF flag is set to 1 - ! --- char vnm (in) : variable name used in nc-file ! --- ------------------------------------------------------------------ ! - IMPLICIT NONE - ! - REAL, intent(in) :: sfac,offs - INTEGER, intent(in) :: frmt,cmpflg,pos - CHARACTER(LEN=*),intent(in) :: vnm - ! - INTEGER :: n - CHARACTER(LEN=100) :: dims + ! Arguments + real, intent(in) :: sfac ! variable position in common buffer + real, intent(in) :: offs ! format/precision of output + ! 0=field is not written + ! 2=field is written as int2 with scale factor and offset + ! 4=field is written as real4 + ! 8=field is written as real8 + integer, intent(in) :: frmt ! user def.ne. scale factor to be applied + integer, intent(in) :: pos ! user def.ne. offset to be added + integer, intent(in) :: cmpflg ! compression flag; only wet points are written if flag is set to 1 + character(len=*), intent(in) :: vnm ! variable name used in nc-file + ! + ! Local variables + integer :: n + character(LEN=100) :: dims ! ! --- Check whether field should be written IF (pos.EQ.0 .OR. frmt.EQ.0) RETURN @@ -1811,27 +1736,21 @@ SUBROUTINE wrtlvl(pos,frmt,sfac,offs,cmpflg,vnm) ! --- Check output format IF (frmt.EQ.2) THEN IF (cmpflg.EQ.1) THEN - CALL nccopa(vnm,dims,bgcm3dlvl(1-nbdy,1-nbdy,1,pos),ip,sfac, & - & offs) + call nccopa(vnm,dims,bgcm3dlvl(1-nbdy,1-nbdy,1,pos),ip,sfac,offs) ELSE - CALL ncpack(vnm,dims,bgcm3dlvl(1-nbdy,1-nbdy,1,pos),ip,2, & - & sfac,offs) + call ncpack(vnm,dims,bgcm3dlvl(1-nbdy,1-nbdy,1,pos),ip,2,sfac,offs) ENDIF ELSEIF (frmt.EQ.4) THEN IF (cmpflg.EQ.1) THEN - CALL nccomp(vnm,dims,bgcm3dlvl(1-nbdy,1-nbdy,1,pos),ip,sfac, & - & offs,4) + call nccomp(vnm,dims,bgcm3dlvl(1-nbdy,1-nbdy,1,pos),ip,sfac,offs,4) ELSE - CALL ncwrtr(vnm,dims,bgcm3dlvl(1-nbdy,1-nbdy,1,pos),ip,2, & - & sfac,offs,4) + call ncwrtr(vnm,dims,bgcm3dlvl(1-nbdy,1-nbdy,1,pos),ip,2,sfac,offs,4) ENDIF ELSEIF (frmt.EQ.8) THEN IF (cmpflg.EQ.1) THEN - CALL nccomp(vnm,dims,bgcm3dlvl(1-nbdy,1-nbdy,1,pos),ip,sfac, & - & offs,8) + call nccomp(vnm,dims,bgcm3dlvl(1-nbdy,1-nbdy,1,pos),ip,sfac,offs,8) ELSE - CALL ncwrtr(vnm,dims,bgcm3dlvl(1-nbdy,1-nbdy,1,pos),ip,2, & - & sfac,offs,8) + call ncwrtr(vnm,dims,bgcm3dlvl(1-nbdy,1-nbdy,1,pos),ip,2,sfac,offs,8) ENDIF ELSE STOP 'unknown output format ' @@ -1845,30 +1764,23 @@ SUBROUTINE wrtsdm(pos,frmt,sfac,offs,cmpflg,vnm) ! ! --- ------------------------------------------------------------------ ! --- Description: writes diagnostic sediment field to file - ! --- - ! --- Arguments: - ! --- int pos (in) : variable position in common buffer - ! --- int frmt (in) : format/precision of output - ! --- 0=field is not written - ! --- 2=field is written as int2 with scale - ! --- factor and offset - ! --- 4=field is written as real4 - ! --- 8=field is written as real8 - ! --- real sfac (in) : user def.NE. scale factor to be applied - ! --- real offs (in) : user def.NE. offset to be added - ! --- int cmpflg (in) : compression flag; only wet points are - ! --- written IF flag is set to 1 - ! --- char vnm (in) : variable name used in nc-file ! --- ------------------------------------------------------------------ ! - IMPLICIT NONE - ! - REAL, intent(in) :: sfac,offs - INTEGER, intent(in) :: frmt,cmpflg,pos - CHARACTER(LEN=*),intent(in) :: vnm - ! - INTEGER :: n - CHARACTER(LEN=100) :: dims + ! Arguments + real, intent(in) :: sfac ! variable position in common buffer + real, intent(in) :: offs ! format/precision of output + ! 0=field is not written + ! 2=field is written as int2 with scale factor and offset + ! 4=field is written as real4 + ! 8=field is written as real8 + integer, intent(in) :: frmt ! user def.ne. scale factor to be applied + integer, intent(in) :: pos ! user def.ne. offset to be added + integer, intent(in) :: cmpflg ! compression flag; only wet points are written if flag is set to 1 + character(len=*), intent(in) :: vnm ! variable name used in nc-file + ! + ! Local variables + integer :: n + character(LEN=100) :: dims ! ! --- Check whether field should be written IF (pos.EQ.0 .OR. frmt.EQ.0) RETURN @@ -1883,27 +1795,21 @@ SUBROUTINE wrtsdm(pos,frmt,sfac,offs,cmpflg,vnm) ! --- Check output format IF (frmt.EQ.2) THEN IF (cmpflg.EQ.1) THEN - CALL nccopa(vnm,dims,bgct_sed(1-nbdy,1-nbdy,1,pos),ip,sfac, & - & offs) + call nccopa(vnm,dims,bgct_sed(1-nbdy,1-nbdy,1,pos),ip,sfac,offs) ELSE - CALL ncpack(vnm,dims,bgct_sed(1-nbdy,1-nbdy,1,pos),ip,1, & - & sfac,offs) + call ncpack(vnm,dims,bgct_sed(1-nbdy,1-nbdy,1,pos),ip,1,sfac,offs) ENDIF ELSEIF (frmt.EQ.4) THEN IF (cmpflg.EQ.1) THEN - CALL nccomp(vnm,dims,bgct_sed(1-nbdy,1-nbdy,1,pos),ip,sfac, & - & offs,4) + call nccomp(vnm,dims,bgct_sed(1-nbdy,1-nbdy,1,pos),ip,sfac,offs,4) ELSE - CALL ncwrtr(vnm,dims,bgct_sed(1-nbdy,1-nbdy,1,pos),ip,1, & - & sfac,offs,4) + call ncwrtr(vnm,dims,bgct_sed(1-nbdy,1-nbdy,1,pos),ip,1,sfac,offs,4) ENDIF ELSEIF (frmt.EQ.8) THEN IF (cmpflg.EQ.1) THEN - CALL nccomp(vnm,dims,bgct_sed(1-nbdy,1-nbdy,1,pos),ip,sfac, & - & offs,8) + call nccomp(vnm,dims,bgct_sed(1-nbdy,1-nbdy,1,pos),ip,sfac,offs,8) ELSE - CALL ncwrtr(vnm,dims,bgct_sed(1-nbdy,1-nbdy,1,pos),ip,1, & - & sfac,offs,8) + call ncwrtr(vnm,dims,bgct_sed(1-nbdy,1-nbdy,1,pos),ip,1,sfac,offs,8) ENDIF ELSE STOP 'unknown output format ' @@ -1917,30 +1823,23 @@ SUBROUTINE wrtbur(pos,frmt,sfac,offs,cmpflg,vnm) ! ! --- ------------------------------------------------------------------ ! --- Description: writes diagnostic sediment burial field to file - ! --- - ! --- Arguments: - ! --- int pos (in) : variable position in common buffer - ! --- int frmt (in) : format/precision of output - ! --- 0=field is not written - ! --- 2=field is written as int2 with scale - ! --- factor and offset - ! --- 4=field is written as real4 - ! --- 8=field is written as real8 - ! --- real sfac (in) : user def.NE. scale factor to be applied - ! --- real offs (in) : user def.NE. offset to be added - ! --- int cmpflg (in) : compression flag; only wet points are - ! --- written IF flag is set to 1 - ! --- char vnm (in) : variable name used in nc-file ! --- ------------------------------------------------------------------ ! - IMPLICIT NONE - ! - REAL, intent(in) :: sfac,offs - INTEGER, intent(in) :: frmt,cmpflg,pos - CHARACTER(LEN=*),intent(in) :: vnm - ! - INTEGER :: n - CHARACTER(LEN=100) :: dims + ! Arguments + real, intent(in) :: sfac ! variable position in common buffer + real, intent(in) :: offs ! format/precision of output + ! 0=field is not written + ! 2=field is written as int2 with scale factor and offset + ! 4=field is written as real4 + ! 8=field is written as real8 + integer, intent(in) :: frmt ! user def.ne. scale factor to be applied + integer, intent(in) :: pos ! user def.ne. offset to be added + integer, intent(in) :: cmpflg ! compression flag; only wet points are written if flag is set to 1 + character(len=*), intent(in) :: vnm ! variable name used in nc-file + ! + ! Local variables + integer :: n + character(LEN=100) :: dims ! ! --- Check whether field should be written IF (pos.EQ.0 .OR. frmt.EQ.0) RETURN @@ -1955,27 +1854,21 @@ SUBROUTINE wrtbur(pos,frmt,sfac,offs,cmpflg,vnm) ! --- Check output format IF (frmt.EQ.2) THEN IF (cmpflg.EQ.1) THEN - CALL nccopa(vnm,dims,bgct_bur(1-nbdy,1-nbdy,pos),ip,sfac, & - & offs) + call nccopa(vnm,dims,bgct_bur(1-nbdy,1-nbdy,pos),ip,sfac,offs) ELSE - CALL ncpack(vnm,dims,bgct_bur(1-nbdy,1-nbdy,pos),ip,1, & - & sfac,offs) + call ncpack(vnm,dims,bgct_bur(1-nbdy,1-nbdy,pos),ip,1,sfac,offs) ENDIF ELSEIF (frmt.EQ.4) THEN IF (cmpflg.EQ.1) THEN - CALL nccomp(vnm,dims,bgct_bur(1-nbdy,1-nbdy,pos),ip,sfac, & - & offs,4) + call nccomp(vnm,dims,bgct_bur(1-nbdy,1-nbdy,pos),ip,sfac,offs,4) ELSE - CALL ncwrtr(vnm,dims,bgct_bur(1-nbdy,1-nbdy,pos),ip,1, & - & sfac,offs,4) + call ncwrtr(vnm,dims,bgct_bur(1-nbdy,1-nbdy,pos),ip,1,sfac,offs,4) ENDIF ELSEIF (frmt.EQ.8) THEN IF (cmpflg.EQ.1) THEN - CALL nccomp(vnm,dims,bgct_bur(1-nbdy,1-nbdy,pos),ip,sfac, & - & offs,8) + call nccomp(vnm,dims,bgct_bur(1-nbdy,1-nbdy,pos),ip,sfac,offs,8) ELSE - CALL ncwrtr(vnm,dims,bgct_bur(1-nbdy,1-nbdy,pos),ip,1, & - & sfac,offs,8) + call ncwrtr(vnm,dims,bgct_bur(1-nbdy,1-nbdy,pos),ip,1,sfac,offs,8) ENDIF ELSE STOP 'unknown output format ' @@ -1989,20 +1882,16 @@ SUBROUTINE logsrf(pos,sfac,offs) ! ! --- ------------------------------------------------------------------ ! --- Description: replace 2d field with log10(field) - ! --- - ! --- Arguments: - ! --- int pos (in) : field position in layer buffer - ! --- real sfac (in) : scale factor to be applied before log10 - ! --- real offs (in) : offset to be added before log10 ! --- ------------------------------------------------------------------ ! - IMPLICIT NONE + ! Arguments + real, intent(in) :: sfac ! field position in layer buffer + real, intent(in) :: offs ! scale factor to be applied before log10 + integer, intent(in) :: pos ! offset to be added before log10 ! - REAL ::sfac,offs - INTEGER :: pos - ! - INTEGER :: i,j,l - REAL ::epsil=1e-11 + ! Local variables + integer :: i,j,l + real :: epsil=1e-11 ! ! --- Check whether field should be processed IF (pos.EQ.0) RETURN @@ -2029,20 +1918,16 @@ SUBROUTINE loglyr(pos,sfac,offs) ! ! --- ------------------------------------------------------------------ ! --- Description: replace layer field with log10(field) - ! --- - ! --- Arguments: - ! --- int pos (in) : field position in layer buffer - ! --- real sfac (in) : scale factor to be applied before log10 - ! --- real offs (in) : offset to be added before log10 ! --- ------------------------------------------------------------------ ! - IMPLICIT NONE + ! Arguments + real, intent(in) :: sfac ! field position in layer buffer + real, intent(in) :: offs ! scale factor to be applied before log10 + integer, intent(in) :: pos ! offset to be added before log10 ! - REAL ::sfac,offs - INTEGER :: pos - ! - INTEGER :: i,j,k,l - REAL ::epsil=1e-11 + ! Local variable + integer :: i,j,k,l + real :: epsil=1e-11 ! ! --- Check whether field should be processed IF (pos.EQ.0) RETURN @@ -2066,25 +1951,20 @@ SUBROUTINE loglyr(pos,sfac,offs) END SUBROUTINE loglyr - SUBROUTINE loglvl(pos,sfac,offs) ! ! --- ------------------------------------------------------------------ ! --- Description: replace level field with log10(field) - ! --- - ! --- Arguments: - ! --- int pos (in) : field position in layer buffer - ! --- real sfac (in) : scale factor to be applied before log10 - ! --- real offs (in) : offset to be added before log10 ! --- ------------------------------------------------------------------ ! - IMPLICIT NONE + ! Arguments + real, intent(in) :: sfac ! field position in layer buffer + real, intent(in) :: offs ! scale factor to be applied before log10 + integer, intent(in) :: pos ! offset to be added before log10 ! - REAL ::sfac,offs - INTEGER :: pos - ! - INTEGER :: i,j,k,l - REAL ::epsil=1e-11 + ! Local variable + integer :: i,j,k,l + real :: epsil=1e-11 ! ! --- Check whether field should be processed IF (pos.EQ.0) RETURN @@ -2097,8 +1977,7 @@ SUBROUTINE loglvl(pos,sfac,offs) IF (bgcm3dlvl(i,j,k,pos).LT.epsil) THEN bgcm3dlvl(i,j,k,pos)=0. ELSEIF (bgcm3dlvl(i,j,k,pos).NE.nf90_fill_double) THEN - bgcm3dlvl(i,j,k,pos)=log10(bgcm3dlvl(i,j,k,pos)*sfac+ & - & offs) + bgcm3dlvl(i,j,k,pos)=log10(bgcm3dlvl(i,j,k,pos)*sfac+offs) ENDIF ENDDO ENDDO @@ -2114,20 +1993,16 @@ SUBROUTINE logsdm(pos,sfac,offs) ! ! --- ------------------------------------------------------------------ ! --- Description: replace sediment field with log10(field) - ! --- - ! --- Arguments: - ! --- int pos (in) : field position in layer buffer - ! --- real sfac (in) : scale factor to be applied before log10 - ! --- real offs (in) : offset to be added before log10 ! --- ------------------------------------------------------------------ ! - IMPLICIT NONE - ! - REAL ::sfac,offs - INTEGER :: pos + ! Arguments + real, intent(in) :: sfac ! field position in layer buffer + real, intent(in) :: offs ! scale factor to be applied before log10 + integer, intent(in) :: pos ! offset to be added before log10 ! - INTEGER :: i,j,k,l - REAL ::epsil=1e-11 + ! Local variable + integer :: i,j,k,l + real :: epsil=1e-11 ! ! --- Check whether field should be processed IF (pos.EQ.0) RETURN @@ -2155,20 +2030,15 @@ SUBROUTINE msksrf(pos,idepth) ! ! --- ------------------------------------------------------------------ ! --- Description: set sea floor points to NaN in mass flux fields - ! --- - ! --- Arguments: - ! --- int pos (in) : field position in level buffer - ! --- int idepth (in) : k-index field used to define the - ! --- depth surface ! --- ------------------------------------------------------------------ ! - IMPLICIT NONE - ! - INTEGER :: pos - INTEGER, DIMENSION(idm,jdm) :: idepth + ! Arguments + integer, intent(in) :: pos ! field position in level buffer + integer, intent(in) :: idepth(idm,jdm) ! k-index field used to define the depth surface ! - INTEGER :: i,j,l - REAL, parameter :: mskval=nf90_fill_double + ! Local variables + integer :: i,j,l + real, parameter :: mskval=nf90_fill_double ! ! --- Check whether field should be initia IF (pos.EQ.0) RETURN @@ -2190,23 +2060,17 @@ SUBROUTINE msklvl(pos,depths) ! ! --- ------------------------------------------------------------------ ! --- Description: set sea floor points to NaN in level fields - ! --- - ! --- Arguments: - ! --- int pos (in) : field position in level buffer - ! --- int depths (in) : bathymetry field ! --- ------------------------------------------------------------------ + + ! Arguments + integer, intent(in) :: pos ! field position in level buffer + real, intent(in) :: depths(1-nbdy:idm+nbdy,1-nbdy:jdm+nbdy) ! bathymetry field ! - IMPLICIT NONE - ! - INTEGER :: pos - REAL, DIMENSION(1-nbdy:idm+nbdy,1-nbdy:jdm+nbdy) :: depths - ! - INTEGER :: i,j,k,l - LOGICAL :: iniflg=.true. - INTEGER, DIMENSION(idm,jdm) :: kmax - REAL, parameter :: mskval=nf90_fill_double - ! - SAVE iniflg,kmax + ! Local variables + integer :: i,j,k,l + logical, save :: iniflg=.true. + integer, save :: kmax(idm,jdm) + real, parameter :: mskval=nf90_fill_double ! ! --- Check whether field should be processed IF (pos.EQ.0) RETURN @@ -2250,19 +2114,21 @@ END SUBROUTINE msklvl SUBROUTINE bgczlv(pddpo,kin,ind1,ind2,weights) !----------------------------------------------------------------------- ! - ! - IMPLICIT NONE - ! - INTEGER :: d,i,j,k,l,kin - INTEGER, DIMENSION(idm,jdm) :: ind1,ind2 - ! - REAL, PARAMETER :: eps=1e-10 - REAL, DIMENSION(idm,jdm,kdm) :: pddpo,ztop,zbot - REAL, DIMENSION(idm,jdm,ddm) :: weights,dlev - ! - LOGICAL :: iniflg=.true. - ! - SAVE ztop,zbot,dlev,iniflg + ! Arguments + real, intent(in) :: pddpo(idm,jdm,kdm) + integer, intent(in) :: kin + integer, intent(inout) :: ind1(idm,jdm) + integer, intent(inout) :: ind2(idm,jdm) + real, intent(inout) :: weights(idm,jdm,ddm) + ! + ! Local variables + ! TODO: why do the following have save attributes? + integer :: d,i,j,k,l + real, save :: dlev(idm,jdm,ddm) + real, save :: ztop(idm,jdm,kdm) + real, save :: zbot(idm,jdm,kdm) + logical, save :: iniflg=.true. + real, parameter :: eps=1e-10 ! ! --- Adjust bounds of levitus levels according to model bathymetry IF (iniflg) THEN @@ -2271,8 +2137,7 @@ SUBROUTINE bgczlv(pddpo,kin,ind1,ind2,weights) DO j=1,jj DO l=1,isp(j) DO i=max(1,ifp(j,l)),min(ii,ilp(j,l)) - dlev(i,j,d)=max(eps,min(pbath(i,j), & - & depthslev_bnds(2,d))-depthslev_bnds(1,d)) + dlev(i,j,d)=max(eps, min(pbath(i,j),depthslev_bnds(2,d))-depthslev_bnds(1,d)) ENDDO ENDDO ENDDO @@ -2328,7 +2193,7 @@ SUBROUTINE bgczlv(pddpo,kin,ind1,ind2,weights) ENDDO ENDIF ! - ! --- Compute interpolation weights + !--- Compute interpolation weights !$OMP PARALLEL DO PRIVATE(l,i,d) DO j=1,jj DO l=1,isp(j) @@ -2343,9 +2208,8 @@ SUBROUTINE bgczlv(pddpo,kin,ind1,ind2,weights) EXIT ENDIF ind2(i,j)=d - weights(i,j,d)=(min(zbot(i,j,kin), & - & depthslev_bnds(2,d))-max(ztop(i,j,kin), & - & depthslev_bnds(1,d)))/dlev(i,j,d) + weights(i,j,d)=(min(zbot(i,j,kin), depthslev_bnds(2,d)) - & + max(ztop(i,j,kin), depthslev_bnds(1,d)))/dlev(i,j,d) ENDDO ENDIF ENDDO @@ -2353,6 +2217,6 @@ SUBROUTINE bgczlv(pddpo,kin,ind1,ind2,weights) ENDDO !$OMP END PARALLEL DO ! - END SUBROUTINE bgczlv + end subroutine bgczlv -END MODULE mo_bgcmean +end module mo_bgcmean diff --git a/hamocc/mo_biomod.F90 b/hamocc/mo_biomod.F90 index 9f023a28..ec53332d 100644 --- a/hamocc/mo_biomod.F90 +++ b/hamocc/mo_biomod.F90 @@ -19,82 +19,73 @@ MODULE mo_biomod !****************************************************************************** + ! Variables for marine biology. + ! - declaration and memory allocation. ! - ! MODULE mo_biomod - Variables for marine biology. - ! - ! S.Legutke, *MPI-MaD, HH* 31.10.01 - ! - ! Modified - ! -------- - ! - ! I. Kriest, GEOMAR, 11.08.2016 - ! - included T-dependence of cyanobacteria growth - ! - modified stoichiometry for denitrification - ! - ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 - ! - moved accumulation of all output fields to seperate subroutine, - ! new global fields for output defined here - ! - ! Purpose - ! ------- - ! - declaration and memory allocation. - ! - ! Description: - ! ------------ - ! Public routines and variable of this module: - ! - ! -subroutine alloc_mem_biomod - ! Allocate memory for biomod variables - ! - ! + ! S.Legutke, *MPI-MaD, HH* 31.10.01 + ! Modified + ! I. Kriest, GEOMAR, 11.08.2016 + ! - included T-dependence of cyanobacteria growth + ! - modified stoichiometry for denitrification + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - moved accumulation of all output fields to seperate subroutine, + ! new global fields for output defined here !****************************************************************************** - implicit none - REAL, DIMENSION (:,:), ALLOCATABLE :: strahl - REAL, DIMENSION (:,:), ALLOCATABLE :: expoor - REAL, DIMENSION (:,:), ALLOCATABLE :: expoca - REAL, DIMENSION (:,:), ALLOCATABLE :: exposi - REAL, DIMENSION (:,:), ALLOCATABLE :: intphosy - REAL, DIMENSION (:,:), ALLOCATABLE :: intdnit - REAL, DIMENSION (:,:), ALLOCATABLE :: intnfix - REAL, DIMENSION (:,:), ALLOCATABLE :: intdmsprod - REAL, DIMENSION (:,:), ALLOCATABLE :: intdms_bac - REAL, DIMENSION (:,:), ALLOCATABLE :: intdms_uv - REAL, DIMENSION (:,:), ALLOCATABLE :: carflx0100 - REAL, DIMENSION (:,:), ALLOCATABLE :: carflx0500 - REAL, DIMENSION (:,:), ALLOCATABLE :: carflx1000 - REAL, DIMENSION (:,:), ALLOCATABLE :: carflx2000 - REAL, DIMENSION (:,:), ALLOCATABLE :: carflx4000 - REAL, DIMENSION (:,:), ALLOCATABLE :: carflx_bot - REAL, DIMENSION (:,:), ALLOCATABLE :: bsiflx0100 - REAL, DIMENSION (:,:), ALLOCATABLE :: bsiflx0500 - REAL, DIMENSION (:,:), ALLOCATABLE :: bsiflx1000 - REAL, DIMENSION (:,:), ALLOCATABLE :: bsiflx2000 - REAL, DIMENSION (:,:), ALLOCATABLE :: bsiflx4000 - REAL, DIMENSION (:,:), ALLOCATABLE :: bsiflx_bot - REAL, DIMENSION (:,:), ALLOCATABLE :: calflx0100 - REAL, DIMENSION (:,:), ALLOCATABLE :: calflx0500 - REAL, DIMENSION (:,:), ALLOCATABLE :: calflx1000 - REAL, DIMENSION (:,:), ALLOCATABLE :: calflx2000 - REAL, DIMENSION (:,:), ALLOCATABLE :: calflx4000 - REAL, DIMENSION (:,:), ALLOCATABLE :: calflx_bot - REAL, DIMENSION (:,:,:), ALLOCATABLE :: phosy3d + implicit none + private + + ! Routines + + public :: alloc_mem_biomod ! Allocate memory for biomod variables + + ! Module variables + + real, dimension (:,:), allocatable, public :: strahl + real, dimension (:,:), allocatable, public :: expoor + real, dimension (:,:), allocatable, public :: expoca + real, dimension (:,:), allocatable, public :: exposi + real, dimension (:,:), allocatable, public :: intphosy + real, dimension (:,:), allocatable, public :: intdnit + real, dimension (:,:), allocatable, public :: intnfix + real, dimension (:,:), allocatable, public :: intdmsprod + real, dimension (:,:), allocatable, public :: intdms_bac + real, dimension (:,:), allocatable, public :: intdms_uv + real, dimension (:,:), allocatable, public :: carflx0100 + real, dimension (:,:), allocatable, public :: carflx0500 + real, dimension (:,:), allocatable, public :: carflx1000 + real, dimension (:,:), allocatable, public :: carflx2000 + real, dimension (:,:), allocatable, public :: carflx4000 + real, dimension (:,:), allocatable, public :: carflx_bot + real, dimension (:,:), allocatable, public :: bsiflx0100 + real, dimension (:,:), allocatable, public :: bsiflx0500 + real, dimension (:,:), allocatable, public :: bsiflx1000 + real, dimension (:,:), allocatable, public :: bsiflx2000 + real, dimension (:,:), allocatable, public :: bsiflx4000 + real, dimension (:,:), allocatable, public :: bsiflx_bot + real, dimension (:,:), allocatable, public :: calflx0100 + real, dimension (:,:), allocatable, public :: calflx0500 + real, dimension (:,:), allocatable, public :: calflx1000 + real, dimension (:,:), allocatable, public :: calflx2000 + real, dimension (:,:), allocatable, public :: calflx4000 + real, dimension (:,:), allocatable, public :: calflx_bot + real, dimension (:,:,:), allocatable, public :: phosy3d ! Variables for interactive phytoplanktion absorption (use_FB_BGC_OCE=.true.) - REAL, DIMENSION (:,:,:), ALLOCATABLE :: abs_oce + real, dimension (:,:,:), allocatable, public :: abs_oce ! Variables for aggregation scheme (use_AGG=.true.) - REAL, DIMENSION (:,:,:), ALLOCATABLE :: wmass - REAL, DIMENSION (:,:,:), ALLOCATABLE :: wnumb - REAL, DIMENSION (:,:,:), ALLOCATABLE :: eps3d - REAL, DIMENSION (:,:,:), ALLOCATABLE :: asize3d + real, dimension (:,:,:), allocatable, public :: wmass + real, dimension (:,:,:), allocatable, public :: wnumb + real, dimension (:,:,:), allocatable, public :: eps3d + real, dimension (:,:,:), allocatable, public :: asize3d ! Variables for bromoform scheme (use_BROMO=.true.) - REAL, DIMENSION (:,:), ALLOCATABLE :: int_chbr3_prod - REAL, DIMENSION (:,:), ALLOCATABLE :: int_chbr3_uv - - REAL :: growth_co2,bifr13_perm + real, dimension (:,:), allocatable, public :: int_chbr3_prod + real, dimension (:,:), allocatable, public :: int_chbr3_uv + real, public :: growth_co2 + real, public :: bifr13_perm CONTAINS @@ -106,134 +97,133 @@ SUBROUTINE ALLOC_MEM_BIOMOD(kpie,kpje,kpke) 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 + ! Arguments + integer, intent(in) :: kpie + integer, intent(in) :: kpje + integer, intent(in) :: kpke + ! local variables + integer :: errstat IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'***************************************************' - WRITE(io_stdo_bgc,*)'Memory allocation for marine biology module :' - WRITE(io_stdo_bgc,*)' ' + write(io_stdo_bgc,*)' ' + write(io_stdo_bgc,*)'***************************************************' + write(io_stdo_bgc,*)'Memory allocation for marine biology module :' + write(io_stdo_bgc,*)' ' ENDIF - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable strahl ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable strahl ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - ALLOCATE (strahl(kpie,kpje),stat=errstat) + allocate (strahl(kpie,kpje),stat=errstat) 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 + 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) + allocate (abs_oce(kpie,kpje,kpke),stat=errstat) if(errstat.ne.0) stop 'not enough memory abs_oce' abs_oce(:,:,:) = 0.0 endif IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable expoor ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable expoor ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - ALLOCATE (expoor(kpie,kpje),stat=errstat) + allocate (expoor(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory expoor' expoor(:,:) = 0.0 - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable expoca ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable expoca ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - ALLOCATE (expoca(kpie,kpje),stat=errstat) + allocate (expoca(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory expoca' expoca(:,:) = 0.0 IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable exposi ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable exposi ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - ALLOCATE (exposi(kpie,kpje),stat=errstat) + allocate (exposi(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory exposi' exposi(:,:) = 0.0 IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable intphosy ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable intphosy ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - ALLOCATE (intphosy(kpie,kpje),stat=errstat) + allocate (intphosy(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory intphosy' intphosy(:,:) = 0.0 IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable intdnit ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable intdnit ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - ALLOCATE (intdnit(kpie,kpje),stat=errstat) + allocate (intdnit(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory intdnit' intdnit(:,:) = 0.0 - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable intnfix ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable intnfix ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - ALLOCATE (intnfix(kpie,kpje),stat=errstat) + allocate (intnfix(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory intnfix' intnfix(:,:) = 0.0 - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable intdmsprod, intdms_bac, intdms_uv ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable intdmsprod, intdms_bac, intdms_uv ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - ALLOCATE (intdmsprod(kpie,kpje),stat=errstat) - ALLOCATE (intdms_bac(kpie,kpje),stat=errstat) - ALLOCATE (intdms_uv(kpie,kpje),stat=errstat) + allocate (intdmsprod(kpie,kpje),stat=errstat) + allocate (intdms_bac(kpie,kpje),stat=errstat) + allocate (intdms_uv(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory intdmsprod, intdms_bac, intdms_uv' intdmsprod(:,:) = 0.0 intdms_bac(:,:) = 0.0 intdms_uv(:,:) = 0.0 - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable carflx* ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable carflx* ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - ALLOCATE (carflx0100(kpie,kpje),stat=errstat) - ALLOCATE (carflx0500(kpie,kpje),stat=errstat) - ALLOCATE (carflx1000(kpie,kpje),stat=errstat) - ALLOCATE (carflx2000(kpie,kpje),stat=errstat) - ALLOCATE (carflx4000(kpie,kpje),stat=errstat) - ALLOCATE (carflx_bot(kpie,kpje),stat=errstat) + allocate (carflx0100(kpie,kpje),stat=errstat) + allocate (carflx0500(kpie,kpje),stat=errstat) + allocate (carflx1000(kpie,kpje),stat=errstat) + allocate (carflx2000(kpie,kpje),stat=errstat) + allocate (carflx4000(kpie,kpje),stat=errstat) + allocate (carflx_bot(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory carflx*' carflx0100(:,:) = 0.0 carflx0500(:,:) = 0.0 @@ -242,19 +232,18 @@ SUBROUTINE ALLOC_MEM_BIOMOD(kpie,kpje,kpke) carflx4000(:,:) = 0.0 carflx_bot(:,:) = 0.0 - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable bsiflx* ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable bsiflx* ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - ALLOCATE (bsiflx0100(kpie,kpje),stat=errstat) - ALLOCATE (bsiflx0500(kpie,kpje),stat=errstat) - ALLOCATE (bsiflx1000(kpie,kpje),stat=errstat) - ALLOCATE (bsiflx2000(kpie,kpje),stat=errstat) - ALLOCATE (bsiflx4000(kpie,kpje),stat=errstat) - ALLOCATE (bsiflx_bot(kpie,kpje),stat=errstat) + allocate (bsiflx0100(kpie,kpje),stat=errstat) + allocate (bsiflx0500(kpie,kpje),stat=errstat) + allocate (bsiflx1000(kpie,kpje),stat=errstat) + allocate (bsiflx2000(kpie,kpje),stat=errstat) + allocate (bsiflx4000(kpie,kpje),stat=errstat) + allocate (bsiflx_bot(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory bsiflx*' bsiflx0100(:,:) = 0.0 bsiflx0500(:,:) = 0.0 @@ -263,19 +252,18 @@ SUBROUTINE ALLOC_MEM_BIOMOD(kpie,kpje,kpke) bsiflx4000(:,:) = 0.0 bsiflx_bot(:,:) = 0.0 - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable calflx* ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable calflx* ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - ALLOCATE (calflx0100(kpie,kpje),stat=errstat) - ALLOCATE (calflx0500(kpie,kpje),stat=errstat) - ALLOCATE (calflx1000(kpie,kpje),stat=errstat) - ALLOCATE (calflx2000(kpie,kpje),stat=errstat) - ALLOCATE (calflx4000(kpie,kpje),stat=errstat) - ALLOCATE (calflx_bot(kpie,kpje),stat=errstat) + allocate (calflx0100(kpie,kpje),stat=errstat) + allocate (calflx0500(kpie,kpje),stat=errstat) + allocate (calflx1000(kpie,kpje),stat=errstat) + allocate (calflx2000(kpie,kpje),stat=errstat) + allocate (calflx4000(kpie,kpje),stat=errstat) + allocate (calflx_bot(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory bsiflx*' calflx0100(:,:) = 0.0 calflx0500(:,:) = 0.0 @@ -284,79 +272,77 @@ SUBROUTINE ALLOC_MEM_BIOMOD(kpie,kpje,kpke) calflx4000(:,:) = 0.0 calflx_bot(:,:) = 0.0 - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable phosy3d ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',kpke + write(io_stdo_bgc,*)'Memory allocation for variable phosy3d ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Third dimension : ',kpke ENDIF - ALLOCATE (phosy3d(kpie,kpje,kpke),stat=errstat) + allocate (phosy3d(kpie,kpje,kpke),stat=errstat) if(errstat.ne.0) stop 'not enough memory phosy3d' phosy3d(:,:,:) = 0.0 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 + 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) + 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 + 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) + 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 + 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) + 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 + 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) + allocate (asize3d(kpie,kpje,kpke),stat=errstat) if(errstat.ne.0) stop 'not enough memory asize3d' asize3d(:,:,:) = 0.0 endif 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 + 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) + 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 - !****************************************************************************** - END SUBROUTINE ALLOC_MEM_BIOMOD + end subroutine alloc_mem_biomod -END MODULE mo_biomod +end module mo_biomod diff --git a/hamocc/mo_boxatm.F90 b/hamocc/mo_boxatm.F90 index 17ea61ff..4adcb9d5 100644 --- a/hamocc/mo_boxatm.F90 +++ b/hamocc/mo_boxatm.F90 @@ -19,61 +19,52 @@ module mo_boxatm !****************************************************************************** - ! A. Moree, *GFI, Bergen* Oct 2019 - ! + ! This module contains the routine update_boxatm for updating a + ! 1-D/scalar/box atmosphere + ! 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 + ! production term corresponding to the total decay in the ocean (plus sediment + ! if activated) is assumed. ! + ! A. Moree, *GFI, Bergen* Oct 2019 ! Modified - ! -------- - ! 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 - ! - ported into NorESM2 code, no functional changes - ! - ! - ! Purpose - ! ------- - ! - 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 - ! production term corresponding to the total decay in the ocean (plus sediment - ! if activated) is assumed. - ! - ! + ! 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 + ! - ported into NorESM2 code, no functional changes !****************************************************************************** -contains + implicit none + private + public :: update_boxatm + +contains 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_cisonew, use_sedbypass use mo_carbch, only: atmflx, atm, ocetra use mo_param_bgc, only: rcar,c14dec use mo_param1_bgc, only: iatmco2,iatmc13,iatmc14,isco214,idet14,icalc14,idoc14, & - iphy14,izoo14,ipowc14,issso14,isssc14 + iphy14,izoo14,ipowc14,issso14,isssc14 use mo_sedmnt, only: powtra,sedlay,seddw,porwat,porsol - 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, 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 - 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 + ! Arguments + 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) + + ! Local variables + 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 + 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 @@ -85,7 +76,7 @@ subroutine update_boxatm(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask) ENDDO ENDDO - CALL xcsum(co2flux,ztmp1,ips) + call xcsum(co2flux,ztmp1,ips) ! Convert global CO2 flux to ppm co2flux_ppm = co2flux*12.*1.e-12*pg2ppm ! [kmol C] -> [ppm] @@ -111,8 +102,8 @@ subroutine update_boxatm(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask) ENDDO ENDDO - CALL xcsum(co213flux,ztmp1,ips) - CALL xcsum(co214flux,ztmp2,ips) + 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] @@ -142,7 +133,7 @@ subroutine update_boxatm(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask) ENDDO ENDDO - CALL xcsum(totc14dec,ztmp1,ips) + call xcsum(totc14dec,ztmp1,ips) ! Update atmospheric p13CO2 and p14CO2 DO j=1,kpje @@ -154,12 +145,12 @@ subroutine update_boxatm(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask) 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,*) ' ' + 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 ! end of use_cisonew diff --git a/hamocc/mo_carbch.F90 b/hamocc/mo_carbch.F90 index 6be0e493..83cda846 100644 --- a/hamocc/mo_carbch.F90 +++ b/hamocc/mo_carbch.F90 @@ -17,398 +17,368 @@ ! along with BLOM. If not, see https://www.gnu.org/licenses/. -MODULE mo_carbch +module mo_carbch + !*********************************************************************** + ! Variables for inorganic carbon cycle. + ! - declaration and memory allocation ! - ! MODULE mo_carbch - Variables for inorganic carbon cycle. - ! - ! S.Legutke, *MPI-MaD, HH* 31.10.01 - ! - ! Modified - ! -------- - ! - ! Patrick Wetzel *MPI-Met, HH* 16.04.02 - ! - new: atm, atdifv, suppco2 - ! - changed: chemc(:,:,:) to chemcm(:,:,:,:) - ! - new: bgcmean(:,:,:,:) - ! - ! J. Schwinger *UiB-GfI, Bergen* 04.05.12 - ! - added initialisation of all vars after allocation - ! - ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 - ! - moved accumulation of all output fields to seperate subroutine, - ! new global fields for output defined here - ! - added OmegaA - ! - ! Purpose - ! ------- - ! - declaration and memory allocation - ! - ! Description: - ! ------------ - ! Public routines and variable of this module: - ! - ! -subroutine alloc_mem_carbch - ! Allocate memory for inorganic carbon variables - ! - ! + ! S.Legutke, *MPI-MaD, HH* 31.10.01 + ! Modified + ! Patrick Wetzel *MPI-Met, HH* 16.04.02 + ! - new: atm, atdifv, suppco2 + ! - changed: chemc(:,:,:) to chemcm(:,:,:,:) + ! - new: bgcmean(:,:,:,:) + ! J. Schwinger *UiB-GfI, Bergen* 04.05.12 + ! - added initialisation of all vars after allocation + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - moved accumulation of all output fields to seperate subroutine, + ! new global fields for output defined here + ! - added OmegaA !********************************************************************** + implicit none + private + + ! Routines + + public :: alloc_mem_carbch ! Allocate memory for inorganic carbon variables + + ! Module variables + + real, dimension (:,:,:,:), allocatable, public :: ocetra + real, dimension (:,:,:), allocatable, public :: atm + real, dimension (:,:,:), allocatable, public :: atmflx + real, dimension (:,:), allocatable, public :: ndepflx + real, dimension (:,:), allocatable, public :: oalkflx + real, dimension (:,:,:), allocatable, public :: rivinflx + real, dimension (:,:,:), allocatable, public :: co3 + real, dimension (:,:,:), allocatable, public :: co2star + real, dimension (:,:,:), allocatable, public :: hi + real, dimension (:,:,:), allocatable, public :: omegaa + real, dimension (:,:,:), allocatable, public :: omegac + real, dimension (:,:,:), allocatable, public :: keqb + + real, dimension (:,:,:), allocatable, public :: satoxy + real, dimension (:,:), allocatable, public :: satn2o + real, dimension (:,:), allocatable, public :: atdifv + real, dimension (:,:), allocatable, public :: suppco2 + real, dimension (:,:,:), allocatable, public :: sedfluxo + + real, dimension (:,:), allocatable, public :: pco2d + real, dimension (:,:), allocatable, public :: pco2m + real, dimension (:,:), allocatable, public :: kwco2sol + real, dimension (:,:), allocatable, public :: kwco2d + real, dimension (:,:), allocatable, public :: co2sold + real, dimension (:,:), allocatable, public :: co2solm + real, dimension (:,:), allocatable, public :: co2fxd + real, dimension (:,:), allocatable, public :: co2fxu + real, dimension (:,:), allocatable, public :: co213fxd + real, dimension (:,:), allocatable, public :: co213fxu + real, dimension (:,:), allocatable, public :: co214fxd + real, dimension (:,:), allocatable, public :: co214fxu + real, dimension (:,:), allocatable, public :: natpco2d + real, dimension (:,:,:), allocatable, public :: nathi + real, dimension (:,:,:), allocatable, public :: natco3 + real, dimension (:,:,:), allocatable, public :: natomegaa + real, dimension (:,:,:), allocatable, public :: natomegac + + real, public :: atm_co2 + real, public :: atm_cfc11_nh, atm_cfc11_sh + real, public :: atm_cfc12_nh, atm_cfc12_sh + real, public :: atm_sf6_nh, atm_sf6_sh + +contains + + subroutine alloc_mem_carbch(kpie,kpje,kpke) + + !-------------------------------------------- + ! Allocate variables in this module + !-------------------------------------------- - REAL, DIMENSION (:,:,:,:), ALLOCATABLE :: ocetra - REAL, DIMENSION (:,:,:), ALLOCATABLE :: atm - REAL, DIMENSION (:,:,:), ALLOCATABLE :: atmflx - REAL, DIMENSION (:,:), ALLOCATABLE :: ndepflx - REAL, DIMENSION (:,:), ALLOCATABLE :: oalkflx - REAL, DIMENSION (:,:,:), ALLOCATABLE :: rivinflx - REAL, DIMENSION (:,:,:), ALLOCATABLE :: co3 - REAL, DIMENSION (:,:,:), ALLOCATABLE :: co2star - REAL, DIMENSION (:,:,:), ALLOCATABLE :: hi - REAL, DIMENSION (:,:,:), ALLOCATABLE :: OmegaA - REAL, DIMENSION (:,:,:), ALLOCATABLE :: OmegaC - REAL, DIMENSION (:,:,:), ALLOCATABLE :: keqb - - REAL, DIMENSION (:,:,:), ALLOCATABLE :: satoxy - REAL, DIMENSION (:,:), ALLOCATABLE :: satn2o - REAL, DIMENSION (:,:), ALLOCATABLE :: atdifv - REAL, DIMENSION (:,:), ALLOCATABLE :: suppco2 - REAL, DIMENSION (:,:,:), ALLOCATABLE :: sedfluxo - - REAL, DIMENSION (:,:), ALLOCATABLE :: pco2d - REAL, DIMENSION (:,:), ALLOCATABLE :: pco2m - REAL, DIMENSION (:,:), ALLOCATABLE :: kwco2sol - REAL, DIMENSION (:,:), ALLOCATABLE :: kwco2d - REAL, DIMENSION (:,:), ALLOCATABLE :: co2sold - REAL, DIMENSION (:,:), ALLOCATABLE :: co2solm - REAL, DIMENSION (:,:), ALLOCATABLE :: co2fxd - REAL, DIMENSION (:,:), ALLOCATABLE :: co2fxu - REAL, DIMENSION (:,:), ALLOCATABLE :: co213fxd - REAL, DIMENSION (:,:), ALLOCATABLE :: co213fxu - REAL, DIMENSION (:,:), ALLOCATABLE :: co214fxd - REAL, DIMENSION (:,:), ALLOCATABLE :: co214fxu - REAL, DIMENSION (:,:), ALLOCATABLE :: natpco2d - REAL, DIMENSION (:,:,:), ALLOCATABLE :: nathi - REAL, DIMENSION (:,:,:), ALLOCATABLE :: natco3 - REAL, DIMENSION (:,:,:), ALLOCATABLE :: natOmegaA - REAL, DIMENSION (:,:,:), ALLOCATABLE :: natOmegaC - - REAL :: atm_co2 - REAL :: atm_cfc11_nh,atm_cfc11_sh - REAL :: atm_cfc12_nh,atm_cfc12_sh - REAL :: atm_sf6_nh,atm_sf6_sh - -CONTAINS - - SUBROUTINE ALLOC_MEM_CARBCH(kpie,kpje,kpke) - !****************************************************************************** - ! ALLOC_MEM_CARBCH - Allocate variables in this module - !****************************************************************************** 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 + integer, intent(in) :: kpie + integer, intent(in) :: kpje + integer, intent(in) :: kpke + + ! Local variables + integer :: errstat IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'***************************************************' - WRITE(io_stdo_bgc,*)'Memory allocation for carbon chemistry module :' - WRITE(io_stdo_bgc,*)' ' + write(io_stdo_bgc,*)' ' + write(io_stdo_bgc,*)'***************************************************' + write(io_stdo_bgc,*)'Memory allocation for carbon chemistry module :' + write(io_stdo_bgc,*)' ' ENDIF - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable ocetra ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',kpke - WRITE(io_stdo_bgc,*)'Forth dimension : ',nocetra + write(io_stdo_bgc,*)'Memory allocation for variable ocetra ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Third dimension : ',kpke + write(io_stdo_bgc,*)'Forth dimension : ',nocetra ENDIF - - ALLOCATE (ocetra(kpie,kpje,kpke,nocetra),stat=errstat) + allocate (ocetra(kpie,kpje,kpke,nocetra),stat=errstat) if(errstat.ne.0) stop 'not enough memory ocetra' ocetra(:,:,:,:) = 0.0 IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable hi ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',kpke + write(io_stdo_bgc,*)'Memory allocation for variable hi ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Third dimension : ',kpke ENDIF - - ALLOCATE (hi(kpie,kpje,kpke),stat=errstat) + allocate (hi(kpie,kpje,kpke),stat=errstat) if(errstat.ne.0) stop 'not enough memory hi' hi(:,:,:) = 0.0 IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable co3 ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',kpke + write(io_stdo_bgc,*)'Memory allocation for variable co3 ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Third dimension : ',kpke ENDIF - - ALLOCATE (co3(kpie,kpje,kpke),stat=errstat) + allocate (co3(kpie,kpje,kpke),stat=errstat) if(errstat.ne.0) stop 'not enough memory co3' co3(:,:,:) = 0.0 IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable co2star ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',kpke + write(io_stdo_bgc,*)'Memory allocation for variable co2star ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Third dimension : ',kpke ENDIF - - ALLOCATE (co2star(kpie,kpje,kpke),stat=errstat) + allocate (co2star(kpie,kpje,kpke),stat=errstat) if(errstat.ne.0) stop 'not enough memory co2star' co2star(:,:,:) = 0.0 - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable OmegaA, OmegaC ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',kpke + write(io_stdo_bgc,*)'Memory allocation for variable OmegaA, OmegaC ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Third dimension : ',kpke ENDIF - - ALLOCATE (OmegaA(kpie,kpje,kpke),stat=errstat) - ALLOCATE (OmegaC(kpie,kpje,kpke),stat=errstat) + allocate (OmegaA(kpie,kpje,kpke),stat=errstat) + allocate (OmegaC(kpie,kpje,kpke),stat=errstat) if(errstat.ne.0) stop 'not enough memory OmegaA, OmegaC' OmegaA(:,:,:) = 0.0 OmegaC(:,:,:) = 0.0 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 + 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) + 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 + 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) + 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 + 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) + 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 + 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) + 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 (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable sedfluxo ..' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',npowtra + write(io_stdo_bgc,*)'Memory allocation for variable sedfluxo ..' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Third dimension : ',npowtra ENDIF - - ALLOCATE (sedfluxo(kpie,kpje,npowtra),stat=errstat) + allocate (sedfluxo(kpie,kpje,npowtra),stat=errstat) if(errstat.ne.0) stop 'not enough memory sedfluxo' sedfluxo(:,:,:) = 0.0 IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable satn2o ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable satn2o ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - - ALLOCATE (satn2o(kpie,kpje),stat=errstat) + allocate (satn2o(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory satn2o' satn2o(:,:) = 0.0 IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable keqb ...' - WRITE(io_stdo_bgc,*)'First dimension : ',11 - WRITE(io_stdo_bgc,*)'Second dimension : ',kpie - WRITE(io_stdo_bgc,*)'Third dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable keqb ...' + write(io_stdo_bgc,*)'First dimension : ',11 + write(io_stdo_bgc,*)'Second dimension : ',kpie + write(io_stdo_bgc,*)'Third dimension : ',kpje ENDIF - - ALLOCATE (keqb(11,kpie,kpje),stat=errstat) + allocate (keqb(11,kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory keqb' keqb(:,:,:) = 0.0 IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable satoxy ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',kpke + write(io_stdo_bgc,*)'Memory allocation for variable satoxy ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Third dimension : ',kpke ENDIF - - ALLOCATE (satoxy(kpie,kpje,kpke),stat=errstat) + allocate (satoxy(kpie,kpje,kpke),stat=errstat) if(errstat.ne.0) stop 'not enough memory satoxy' satoxy(:,:,:) = 0.0 IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable atm ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',natm + write(io_stdo_bgc,*)'Memory allocation for variable atm ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Third dimension : ',natm ENDIF - - ALLOCATE (atm(kpie,kpje,natm),stat=errstat) + allocate (atm(kpie,kpje,natm),stat=errstat) if(errstat.ne.0) stop 'not enough memory atm' atm(:,:,:) = 0.0 IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable atmflx ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',natm + write(io_stdo_bgc,*)'Memory allocation for variable atmflx ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Third dimension : ',natm ENDIF - - ALLOCATE (atmflx(kpie,kpje,natm),stat=errstat) + allocate (atmflx(kpie,kpje,natm),stat=errstat) if(errstat.ne.0) stop 'not enough memory atmflx' atmflx(:,:,:) = 0.0 - ! Allocate field to hold N-deposition fluxes per timestep for inventory calculations and output + ! Allocate field to hold N-deposition fluxes per timestep for + ! inventory calculations and output IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable ndepflx ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable ndepflx ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - - ALLOCATE (ndepflx(kpie,kpje),stat=errstat) + allocate (ndepflx(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory ndepflx' ndepflx(:,:) = 0.0 - ! Allocate field to hold OA alkalinity fluxes per timestep for inventory calculations and output + ! Allocate field to hold OA alkalinity fluxes per timestep for + ! inventory calculations and output IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable oalkflx ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable oalkflx ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - - ALLOCATE (oalkflx(kpie,kpje),stat=errstat) + allocate (oalkflx(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory oalkflx' oalkflx(:,:) = 0.0 ! Allocate field to hold riverine fluxes per timestep for inventory calculations IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable rivinflx ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',nriv + write(io_stdo_bgc,*)'Memory allocation for variable rivinflx ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Third dimension : ',nriv ENDIF - - ALLOCATE(rivinflx(kpie,kpje,nriv),stat=errstat) + allocate(rivinflx(kpie,kpje,nriv),stat=errstat) if(errstat.ne.0) stop 'not enough memory rivinflx' rivinflx(:,:,:) = 0.0 IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable pco2d ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable pco2d ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - - ALLOCATE (pco2d(kpie,kpje),stat=errstat) + allocate (pco2d(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory pco2d' pco2d(:,:) = 0.0 IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable pco2m ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable pco2m ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - - ALLOCATE (pco2m(kpie,kpje),stat=errstat) + allocate (pco2m(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory pco2m' pco2m(:,:) = 0.0 IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable kwco2d ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable kwco2d ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - - ALLOCATE (kwco2d(kpie,kpje),stat=errstat) + allocate (kwco2d(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory kwco2d' kwco2d(:,:) = 0.0 IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable kwco2sol ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable kwco2sol ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF + allocate (kwco2sol(kpie,kpje),stat=errstat) + if(errstat.ne.0) stop 'not enough memory co2fxd,co2fxu' + kwco2sol(:,:) = 0.0 IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable co2sold ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable co2sold ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - - ALLOCATE (co2sold(kpie,kpje),stat=errstat) + allocate (co2sold(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory co2sold' co2sold(:,:) = 0.0 IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable co2solm ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable co2solm ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - - ALLOCATE (co2solm(kpie,kpje),stat=errstat) + allocate (co2solm(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory co2solm' co2solm(:,:) = 0.0 - ALLOCATE (kwco2sol(kpie,kpje),stat=errstat) - if(errstat.ne.0) stop 'not enough memory co2fxd,co2fxu' - kwco2sol(:,:) = 0.0 - - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable co2fxd, co2fxu ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable co2fxd, co2fxu ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - - ALLOCATE (co2fxd(kpie,kpje),stat=errstat) - ALLOCATE (co2fxu(kpie,kpje),stat=errstat) + allocate (co2fxd(kpie,kpje),stat=errstat) + allocate (co2fxu(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory co2fxd,co2fxu' co2fxd(:,:) = 0.0 co2fxu(:,:) = 0.0 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 + 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) + 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 @@ -416,7 +386,6 @@ SUBROUTINE ALLOC_MEM_CARBCH(kpie,kpje,kpke) co214fxu(:,:) = 0.0 endif - !****************************************************************************** - END SUBROUTINE ALLOC_MEM_CARBCH + end subroutine alloc_mem_carbch -END MODULE mo_carbch +end module mo_carbch diff --git a/hamocc/mo_carchm.F90 b/hamocc/mo_carchm.F90 index 3cfa3e22..fad93d85 100644 --- a/hamocc/mo_carchm.F90 +++ b/hamocc/mo_carchm.F90 @@ -17,96 +17,56 @@ ! 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_CARCHM +module mo_carchm implicit none private - public :: CARCHM - public :: CARCHM_SOLVE + public :: carchm + public :: carchm_solve - private :: CARCHM_KEQUI - private :: CARCHM_SOLVE_DICSAT + private :: carchm_kequi + private :: carchm_solve_dicsat -CONTAINS +contains - SUBROUTINE CARCHM(kpie,kpje,kpke,kbnd, & - pdlxp,pdlyp,pddpo,prho,pglat,omask, & + subroutine carchm(kpie,kpje,kpke,kbnd, & + pdlxp,pdlyp,pddpo,prho,pglat,omask, & psicomo,ppao,pfu10,ptho,psao) !****************************************************************************** - ! - !**** *CARCHM* - . - ! - ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 - ! - ! Modified - ! -------- - ! S.Legutke, *MPI-MaD, HH* 10.04.01 - ! - rename: ssso12(i,j,k)=sedlay(i,j,k,issso12 ) etc.; no equivalence statements - ! - rename: powasi(i,j,k )=powtra(i,j,1,ipowasi) etc.; no equivalence statements - ! - interfacing with ocean model - ! - ! J.Tjiputra, *BCCR* 09.18.08 - ! - modified all carbon chemistry formulations following the OCMIP protocols - ! - ! J.Schwinger, *GFI, UiB* 2013-04-22 - ! - Use density prho consistent with MICOM for conversion to mol/kg - ! - Calculate solubility of O2 and N2 every timestep, consistent with - ! what is done for carbon chemistry. Array chemcm not used any more. - ! - Added J.Tjiputras code for cfc- and sf6-fluxes - ! - Cautious code clean-up - ! - ! J.Schwinger, *UNI-RESEARCH* 2017-08-30 - ! - Moved the accumulation of global fields for output to routine - ! hamocc4bgc. - ! - ! A.Moree, *GFI, Bergen* 2018-04-12 - ! - new version of carbon isotope code - ! - ! J.Tjiputra, *Uni Research, Bergen* 2018-04-12 - ! - added preformed and saturated DIC tracers - ! - ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 - ! - moved accumulation of all output fields to seperate subroutine, - ! related code-restructuring - ! - dissolution of CaCO3 moved into main loop - ! - added sediment bypass preprocessor option - ! - ! Purpose - ! ------- - ! Inorganic carbon cycle. - ! - ! Method - ! ------- - ! Surface fluxes of CO2 / N2O / dms - ! Dissolution of calcium - ! - ! - !**** Parameter list: - ! --------------- - ! - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. - ! *INTEGER* *kbnd* - nb of halo grid points - ! *REAL* *pdlxp* - size of scalar grid cell (1st dimension) [m]. - ! *REAL* *pdlyp* - size of scalar grid cell (2nd dimension) [m]. - ! *REAL* *pddpo* - size of scalar grid cell (3rd dimension) [m]. - ! *REAL* *prho* - density [g/cm^3]. - ! *REAL* *pglat* - latitude of grid cells [deg north]. - ! *REAL* *omask* - ocean mask. - ! *REAL* *psicomo* - sea ice. - ! *REAL* *ppao* - sea level presure [Pascal]. - ! *REAL* *pfu10* - forcing field wind speed. - ! *REAL* *ptho* - potential temperature. - ! *REAL* *psao* - salinity [psu]. - ! - ! Externals - ! --------- - ! none. - ! + ! Inorganic carbon cycle. + ! - Surface fluxes of CO2 / N2O / dms + ! - Dissolution of calcium + ! + ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 + ! Modified: + ! S.Legutke, *MPI-MaD, HH* 10.04.01 + ! - rename: ssso12(i,j,k)=sedlay(i,j,k,issso12 ) etc.; no equivalence statements + ! - rename: powasi(i,j,k )=powtra(i,j,1,ipowasi) etc.; no equivalence statements + ! - interfacing with ocean model + ! J.Tjiputra, *BCCR* 09.18.08 + ! - modified all carbon chemistry formulations following the OCMIP protocols + ! J.Schwinger, *GFI, UiB* 2013-04-22 + ! - Use density prho consistent with MICOM for conversion to mol/kg + ! - Calculate solubility of O2 and N2 every timestep, consistent with + ! what is done for carbon chemistry. Array chemcm not used any more. + ! - Added J.Tjiputras code for cfc- and sf6-fluxes + ! - Cautious code clean-up + ! J.Schwinger, *UNI-RESEARCH* 2017-08-30 + ! - Moved the accumulation of global fields for output to routine + ! hamocc4bgc. + ! A.Moree, *GFI, Bergen* 2018-04-12 + ! - new version of carbon isotope code + ! J.Tjiputra, *Uni Research, Bergen* 2018-04-12 + ! - added preformed and saturated DIC tracers + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - moved accumulation of all output fields to seperate subroutine, + ! related code-restructuring + ! - dissolution of CaCO3 moved into main loop + ! - added sediment bypass preprocessor option !********************************************************************** + 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, & @@ -127,46 +87,49 @@ SUBROUTINE CARCHM(kpie,kpje,kpke,kbnd, & use mo_sedmnt, only: sedlay,powtra,burial ! Arguments - INTEGER, intent(in) :: kpie,kpje,kpke,kbnd - REAL, intent(in) :: pdlxp(kpie,kpje) - REAL, intent(in) :: pdlyp(kpie,kpje) - REAL, intent(in) :: pddpo(kpie,kpje,kpke) - REAL, intent(in) :: prho(kpie,kpje,kpke) - REAL, intent(in) :: pglat(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - REAL, intent(in) :: omask(kpie,kpje) - REAL, intent(in) :: psicomo(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - REAL, intent(in) :: ppao(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - REAL, intent(in) :: pfu10(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - REAL, intent(in) :: ptho(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) - REAL, intent(in) :: psao(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) + integer, intent(in) :: kpie ! 1st dimension of model grid. + integer, intent(in) :: kpje ! 2nd dimension of model grid. + integer, intent(in) :: kpke ! 3rd (vertical) dimension of model grid. + integer, intent(in) :: kbnd ! nb of halo grid points + real, intent(in) :: pdlxp(kpie,kpje) ! size of scalar grid cell (1st dimension) [m]. + real, intent(in) :: pdlyp(kpie,kpje) ! size of scalar grid cell (2nd dimension) [m]. + real, intent(in) :: pddpo(kpie,kpje,kpke) ! size of scalar grid cell (3rd dimension) [m]. + real, intent(in) :: prho(kpie,kpje,kpke) ! density [g/cm^3]. + real, intent(in) :: pglat(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) ! latitude of grid cells [deg north]. + real, intent(in) :: omask(kpie,kpje) ! ocean mask. + real, intent(in) :: psicomo(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) ! sea ice. + real, intent(in) :: ppao(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) ! sea level presure [pascal]. + real, intent(in) :: pfu10(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) ! forcing field wind speed. + real, intent(in) :: ptho(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) ! potential temperature. + real, intent(in) :: psao(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) ! salinity [psu]. ! 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 - REAL :: scco2,sco2,scn2,scdms,scn2o - REAL :: Xconvxa - REAL :: oxflux,niflux,dmsflux,n2oflux - REAL :: ato2,atn2,atco2,pco2 - REAL :: oxy,ani,anisa - REAL :: rrho,t,t2,t3,t4,tk,tk100,prb,s,rs - 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 - 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 + integer, parameter :: niter=20 + integer :: i,j,k,l,js + real :: supsat, undsa, dissol + real :: rpp0,fluxd,fluxu + real :: kwco2,kwo2,kwn2,kwdms,kwn2o + real :: scco2,sco2,scn2,scdms,scn2o + real :: xconvxa + real :: oxflux,niflux,dmsflux,n2oflux + real :: ato2,atn2,atco2,pco2 + real :: oxy,ani,anisa + real :: rrho,t,t2,t3,t4,tk,tk100,prb,s,rs + 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 + 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. @@ -233,10 +196,10 @@ SUBROUTINE CARCHM(kpie,kpje,kpke,kbnd, & pt = ocetra(i,j,k,iphosph) / rrho ah1 = hi(i,j,k) - CALL CARCHM_KEQUI(t,s,prb,Kh,Khd,K1,K2,Kb,Kw,Ks1,Kf,Ksi, & + call CARCHM_KEQUI(t,s,prb,Kh,Khd,K1,K2,Kb,Kw,Ks1,Kf,Ksi, & K1p,K2p,K3p,Kspc,Kspa) - CALL CARCHM_SOLVE(s,tc,ta,sit,pt,K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p, & + 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 @@ -257,7 +220,7 @@ SUBROUTINE CARCHM(kpie,kpje,kpke,kbnd, & 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, & + 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 @@ -285,7 +248,6 @@ SUBROUTINE CARCHM(kpie,kpje,kpke,kbnd, & natpco2 = natcu * 1.e6 / Kh endif - ! Schmidt numbers according to Wanninkhof (2014), Table 1 scco2 = 2116.8 - 136.25*t + 4.7353*t2 - 0.092307*t3 + 0.0007555 *t4 sco2 = 1920.4 - 135.6 *t + 5.2122*t2 - 0.10939 *t3 + 0.00093777*t4 @@ -382,7 +344,7 @@ SUBROUTINE CARCHM(kpie,kpje,kpke,kbnd, & ! Calculate saturation DIC concentration in mixed layer ta = ocetra(i,j,k,ialkali) / rrho - CALL carchm_solve_DICsat(s,atco2*rpp0,ta,sit,pt,Kh,K1,K2,Kb,Kw,Ks1,Kf, & + call carchm_solve_DICsat(s,atco2*rpp0,ta,sit,pt,Kh,K1,K2,Kb,Kw,Ks1,Kf, & 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 @@ -508,7 +470,7 @@ SUBROUTINE CARCHM(kpie,kpje,kpke,kbnd, & ! Save pco2 w.r.t. dry air for output pco2d(i,j) = cu * 1.e6 / Khd - !pCO2 wrt moist air + ! pCO2 wrt moist air pco2m(i,j) = cu * 1.e6 / Kh if (use_natDIC) then natpco2d(i,j) = natcu * 1.e6 / Khd @@ -633,70 +595,45 @@ SUBROUTINE CARCHM(kpie,kpje,kpke,kbnd, & !$OMP END PARALLEL DO endif ! end of use_cisonew and not use_sedbypass - END SUBROUTINE CARCHM + end subroutine carchm - SUBROUTINE CARCHM_KEQUI(temp,saln,prb,Kh,Khd,K1,K2,Kb,Kw,Ks1,Kf,Ksi, & + subroutine carchm_kequi(temp,saln,prb,Kh,Khd,K1,K2,Kb,Kw,Ks1,Kf,Ksi, & K1p,K2p,K3p,Kspc,Kspa) !******************************************************************************* - ! - !**** *CARCHM_SOLVE* - . - ! - ! J. Schwinger, *BCCR, Bergen* 09.02.16 - ! - ! Modified - ! -------- - ! - ! Purpose - ! ------- - ! Calculate equilibrium constant for the carbonate system - ! - ! Method - ! ------- - ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 - ! - added output Khd (CO2 solubility w.r.t. dry air) and - ! Kspa - ! - ! - !**** Parameter list: - ! --------------- - ! - ! *REAL* *temp* - potential temperature [degr C]. - ! *REAL* *saln* - salinity [psu]. - ! *REAL* *prb* - pressure [bar]. - ! *REAL* *Kh* - equilibrium constant Kh = [CO2]/pCO2, moist air. - ! *REAL* *Khd* - equilibrium constant Kh = [CO2]/pCO2, dry air. - ! *REAL* *K1* - equilibrium constant K1 = [H][HCO3]/[H2CO3]. - ! *REAL* *K2* - equilibrium constant K2 = [H][CO3]/[HCO3]. - ! *REAL* *Kb* - equilibrium constant Kb = [H][BO2]/[HBO2]. - ! *REAL* *Kw* - equilibrium constant Kw = [H][OH]. - ! *REAL* *Ks1* - equilibrium constant Ks1 = [H][SO4]/[HSO4]. - ! *REAL* *Kf* - equilibrium constant Kf = [H][F]/[HF]. - ! *REAL* *Ksi* - equilibrium constant Ksi = [H][SiO(OH)3]/[Si(OH)4]. - ! *REAL* *K1p* - equilibrium constant K1p = [H][H2PO4]/[H3PO4]. - ! *REAL* *K2p* - equilibrium constant K2p = [H][HPO4]/[H2PO4]. - ! *REAL* *K3p* - equilibrium constant K3p = [H][PO4]/[HPO4]. - ! *REAL* *Kspc* - equilibrium constant Kspc= [Ca2+]T [CO3]T. - ! *REAL* *Kspa* - equilibrium constant Kspa= [Ca2+]T [CO3]T. - ! - ! Externals - ! --------- - ! none. - ! + ! J. Schwinger, *BCCR, Bergen* 09.02.16 + ! Purpose: Calculate equilibrium constant for the carbonate system + ! Method: J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - added output Khd (CO2 solubility w.r.t. dry air) and Kspa !******************************************************************************* use mo_chemcon, only: tzero,rgas,bor1,bor2,salchl,ac1,ac2,ac3,ac4,bc1,bc2,bc3,ad1,ad2,ad3,bd1,bd2,bd3,a0,a1,a2,b0,b1,b2 - IMPLICIT NONE - REAL, INTENT(IN) :: temp,saln,prb - REAL, INTENT(OUT) :: Kh,Khd,K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p,Kspc,Kspa + ! Arguments + real, intent(in) :: temp ! potential temperature [degr C]. + real, intent(in) :: saln ! salinity [psu]. + real, intent(in) :: prb ! pressure [bar]. + real, intent(out) :: Kh ! equilibrium constant Kh = [CO2]/pCO2, moist air. + real, intent(out) :: Khd ! equilibrium constant Kh = [CO2]/pCO2, dry air. + real, intent(out) :: K1 ! equilibrium constant K1 = [H][HCO3]/[H2CO3]. + real, intent(out) :: K2 ! equilibrium constant K2 = [H][CO3]/[HCO3]. + real, intent(out) :: Kb ! equilibrium constant Kb = [H][BO2]/[HBO2]. + real, intent(out) :: Kw ! equilibrium constant Kw = [H][OH]. + real, intent(out) :: Ks1 ! equilibrium constant Ks1 = [H][SO4]/[HSO4]. + real, intent(out) :: Kf ! equilibrium constant Kf = [H][F]/[HF]. + real, intent(out) :: Ksi ! equilibrium constant Ksi = [H][SiO(OH)3]/[Si(OH)4]. + real, intent(out) :: K1p ! equilibrium constant K1p = [H][H2PO4]/[H3PO4]. + real, intent(out) :: K2p ! equilibrium constant K2p = [H][HPO4]/[H2PO4]. + real, intent(out) :: K3p ! equilibrium constant K3p = [H][PO4]/[HPO4]. + real, intent(out) :: Kspc ! equilibrium constant Kspc= [Ca2+]T [CO3]T. + real, intent(out) :: Kspa ! equilibrium constant Kspa= [Ca2+]T [CO3]T. ! Local varibles - INTEGER :: js - REAL :: tk,tk100,invtk,dlogtk - REAL :: s,is,is2,sqrtis,s15,s2,sqrts,scl - REAL :: nKhwe74,deltav,deltak,zprb,zprb2 - REAL :: lnkpok0(11) + integer :: js + real :: tk,tk100,invtk,dlogtk + real :: s,is,is2,sqrtis,s15,s2,sqrts,scl + real :: nKhwe74,deltav,deltak,zprb,zprb2 + real :: lnkpok0(11) s = MAX(25.,saln) tk = temp + tzero @@ -790,75 +727,48 @@ SUBROUTINE CARCHM_KEQUI(temp,saln,prb,Kh,Khd,K1,K2,Kb,Kw,Ks1,Kf,Ksi, & K2p = K2p * exp( lnkpok0(10) ) K3p = K3p * exp( lnkpok0(11) ) - END SUBROUTINE CARCHM_KEQUI + end subroutine carchm_kequi - SUBROUTINE CARCHM_SOLVE(saln,tc,ta,sit,pt, & - K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p, & + subroutine carchm_solve(saln,tc,ta,sit,pt, & + K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p, & ah1,ac,niter) !********************************************************************** + ! Solve carbon chemistry. ! - !**** *CARCHM_SOLVE* - . - ! - ! J. Schwinger, *BCCR, Bergen* 09.02.16 - ! - ! Modified - ! -------- - ! - ! Purpose - ! ------- - ! Solve carbon chemistry. - ! - ! Method - ! ------- - ! - ! - !**** Parameter list: - ! --------------- - ! *REAL* *saln* - salinity [psu]. - ! *REAL* *tc* - total DIC concentraion [mol/kg]. - ! *REAL* *ta* - total alkalinity [eq/kg]. - ! *REAL* *sit* - silicate concentration [mol/kg]. - ! *REAL* *pt* - phosphate concentration [mol/kg]. - ! *REAL* *K1* - equilibrium constant K1 = [H][HCO3]/[H2CO3]. - ! *REAL* *K2* - equilibrium constant K2 = [H][CO3]/[HCO3]. - ! *REAL* *Kb* - equilibrium constant Kb = [H][BO2]/[HBO2]. - ! *REAL* *Kw* - equilibrium constant Kw = [H][OH]. - ! *REAL* *Ks1* - equilibrium constant Ks1 = [H][SO4]/[HSO4]. - ! *REAL* *Kf* - equilibrium constant Kf = [H][F]/[HF]. - ! *REAL* *Ksi* - equilibrium constant Ksi = [H][SiO(OH)3]/[Si(OH)4]. - ! *REAL* *K1p* - equilibrium constant K1p = [H][H2PO4]/[H3PO4]. - ! *REAL* *K2p* - equilibrium constant K2p = [H][HPO4]/[H2PO4]. - ! *REAL* *K3p* - equilibrium constant K3p = [H][PO4]/[HPO4]. - ! *REAL* *ah1* - hydrogen ion concentration. - ! *REAL* *ac* - carbonate alkalinity. - ! *INTEGER* *niter* - maximum number of iteration - ! - ! Externals - ! --------- - ! none. - ! + ! J. Schwinger, *BCCR, Bergen* 09.02.16 !********************************************************************** use mo_chemcon, only: bor1,bor2,salchl - IMPLICIT NONE - REAL, INTENT(IN) :: saln,tc,ta,sit,pt - REAL, INTENT(IN) :: K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p - REAL, INTENT(INOUT) :: ah1 - REAL, INTENT(OUT) :: ac - INTEGER, INTENT(IN) :: niter + ! Arguments + real, intent(in) :: saln ! salinity [psu]. + real, intent(in) :: tc ! total DIC concentraion [mol/kg]. + real, intent(in) :: ta ! total alkalinity [eq/kg]. + real, intent(in) :: sit ! silicate concentration [mol/kg]. + real, intent(in) :: pt ! phosphate concentration [mol/kg]. + real, intent(in) :: K1 ! equilibrium constant K1 = [H][HCO3]/[H2CO3]. + real, intent(in) :: K2 ! equilibrium constant K2 = [H][CO3]/[HCO3]. + real, intent(in) :: Kb ! equilibrium constant Kb = [H][BO2]/[HBO2]. + real, intent(in) :: Kw ! equilibrium constant Kw = [H][OH]. + real, intent(in) :: Ks1 ! equilibrium constant Ks1 = [H][SO4]/[HSO4]. + real, intent(in) :: Kf ! equilibrium constant Kf = [H][F]/[HF]. + real, intent(in) :: Ksi ! equilibrium constant Ksi = [H][SiO(OH)3]/[Si(OH)4]. + real, intent(in) :: K1p ! equilibrium constant K1p = [H][H2PO4]/[H3PO4]. + real, intent(in) :: K2p ! equilibrium constant K2p = [H][HPO4]/[H2PO4]. + real, intent(in) :: K3p ! equilibrium constant K3p = [H][PO4]/[HPO4]. + real, intent(inout) :: ah1 ! hydrogen ion concentration. + real, intent(out) :: ac ! carbonate alkalinity. + integer, intent(in) :: niter ! maximum number of iteration ! Parameters to set accuracy of iteration - REAL, PARAMETER :: eps=5.e-5 - - ! Local varibles - INTEGER :: jit - REAL :: s,scl,borat,sti,ft - REAL :: hso4,hf,hsi,hpo4,ab,aw,ah2o,ah2,erel - + real, parameter :: eps=5.e-5 + ! Local variables + integer :: jit + real :: s,scl,borat,sti,ft + real :: hso4,hf,hsi,hpo4,ab,aw,ah2o,ah2,erel ! Calculate concentrations for borate, sulfate, and fluoride; see Dickson, A.G., ! Sabine, C.L. and Christian, J.R. (Eds.) 2007. Guide to best practices @@ -869,7 +779,6 @@ SUBROUTINE CARCHM_SOLVE(saln,tc,ta,sit,pt, & sti = 0.14 * scl / 96.062 ! Morris & Riley (1966) ft = 0.000067 * scl / 18.9984 ! Riley (1965) - iflag: DO jit = 1,niter hso4 = sti / ( 1. + Ks1 / ( ah1 / ( 1. + sti / Ks1 ) ) ) hf = 1. / ( 1. + Kf / ah1 ) @@ -889,72 +798,48 @@ SUBROUTINE CARCHM_SOLVE(saln,tc,ta,sit,pt, & endif ENDDO iflag - END SUBROUTINE CARCHM_SOLVE + end subroutine carchm_solve - SUBROUTINE CARCHM_SOLVE_DICSAT(saln,pco2,ta,sit,pt, & + subroutine carchm_solve_dicsat(saln,pco2,ta,sit,pt, & Kh,K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p, & tc_sat,niter) !********************************************************************** + ! Solve DICsat from TALK and pCO2. ! - !**** *CARCHM_SOLVE_DICsat* - . - ! - ! J. Tjiputra, *BCCR, Bergen* 25.01.17 - ! - ! Modified - ! -------- - ! - ! Purpose - ! ------- - ! Solve DICsat from TALK and pCO2. - ! - ! Method - ! ------- - ! - ! - !**** Parameter list: - ! --------------- - ! *REAL* *saln* - salinity [psu]. - ! *REAL* *pco2* - partial pressure of CO2 [ppm]. - ! *REAL* *ta* - total alkalinity [eq/kg]. - ! *REAL* *sit* - silicate concentration [mol/kg]. - ! *REAL* *pt* - phosphate concentration [mol/kg]. - ! *REAL* *Kh* - equilibrium constant K0 = [H2CO3]/pCO2. - ! *REAL* *K1* - equilibrium constant K1 = [H][HCO3]/[H2CO3]. - ! *REAL* *K2* - equilibrium constant K2 = [H][CO3]/[HCO3]. - ! *REAL* *Kb* - equilibrium constant Kb = [H][BO2]/[HBO2]. - ! *REAL* *Kw* - equilibrium constant Kw = [H][OH]. - ! *REAL* *Ks1* - equilibrium constant Ks1 = [H][SO4]/[HSO4]. - ! *REAL* *Kf* - equilibrium constant Kf = [H][F]/[HF]. - ! *REAL* *Ksi* - equilibrium constant Ksi = [H][SiO(OH)3]/[Si(OH)4]. - ! *REAL* *K1p* - equilibrium constant K1p = [H][H2PO4]/[H3PO4]. - ! *REAL* *K2p* - equilibrium constant K2p = [H][HPO4]/[H2PO4]. - ! *REAL* *K3p* - equilibrium constant K3p = [H][PO4]/[HPO4]. - ! *REAL* *tc_sat* - saturated total DIC concentration [mol/kg]. - ! *INTEGER* *niter* - maximum number of iteration - ! - ! Externals - ! --------- - ! none. - ! + ! J. Tjiputra, *BCCR, Bergen* 25.01.17 !********************************************************************** use mo_chemcon, only: bor1,bor2,salchl - REAL, INTENT(IN) :: saln,pco2,ta,sit,pt - REAL, INTENT(IN) :: Kh,K1,K2,Kb,Kw,Ks1,Kf,Ksi,K1p,K2p,K3p - REAL, INTENT(OUT) :: tc_sat - INTEGER, INTENT(IN) :: niter + real, intent(in) :: saln ! salinity [psu]. + real, intent(in) :: pco2 ! partial pressure of CO2 [ppm]. + real, intent(in) :: ta ! total alkalinity [eq/kg]. + real, intent(in) :: sit ! silicate concentration [mol/kg]. + real, intent(in) :: pt ! phosphate concentration [mol/kg]. + real, intent(in) :: KH ! equilibrium constant K0 = [H2CO3]/pCO2. + real, intent(in) :: K1 ! equilibrium constant K1 = [H][HCO3]/[H2CO3]. + real, intent(in) :: K2 ! equilibrium constant K2 = [H][CO3]/[HCO3]. + real, intent(in) :: Kb ! equilibrium constant Kb = [H][BO2]/[HBO2]. + real, intent(in) :: Kw ! equilibrium constant Kw = [H][OH]. + real, intent(in) :: Ks1 ! equilibrium constant Ks1 = [H][SO4]/[HSO4]. + real, intent(in) :: Kf ! equilibrium constant Kf = [H][F]/[HF]. + real, intent(in) :: Ksi ! equilibrium constant Ksi = [H][SiO(OH)3]/[Si(OH)4]. + real, intent(in) :: K1p ! equilibrium constant K1p = [H][H2PO4]/[H3PO4]. + real, intent(in) :: K2p ! equilibrium constant K2p = [H][HPO4]/[H2PO4]. + real, intent(in) :: K3p ! equilibrium constant K3p = [H][PO4]/[HPO4]. + real, intent(out) :: tc_sat ! saturated total DIC concentration [mol/kg]. + integer, intent(in) :: niter ! maximum number of iteration ! Parameters to set accuracy of iteration - REAL, PARAMETER :: eps=5.e-5 + real, parameter :: eps=5.e-5 ! Local varibles - INTEGER :: jit - REAL :: s,scl,borat,sti,ft - REAL :: hso4,hf,hsi,hpo4,ab,aw,ah2o,ah2,erel - REAL :: dic_h2co3,dic_hco3,dic_co3,ah1,ac + integer :: jit + real :: s,scl,borat,sti,ft + real :: hso4,hf,hsi,hpo4,ab,aw,ah2o,ah2,erel + real :: dic_h2co3,dic_hco3,dic_co3,ah1,ac ! Calculate concentrations for borate, sulfate, and fluoride; see Dickson, A.G., ! Sabine, C.L. and Christian, J.R. (Eds.) 2007. Guide to best practices @@ -990,7 +875,6 @@ SUBROUTINE CARCHM_SOLVE_DICSAT(saln,pco2,ta,sit,pt, & dic_co3 = Kh * K1 * K2 * pco2 * 1e-6 / ah1**2 tc_sat = dic_h2co3 + dic_hco3 + dic_co3 - END SUBROUTINE carchm_solve_DICsat - + end subroutine carchm_solve_dicsat -END MODULE MO_CARCHM +end module mo_carchm diff --git a/hamocc/mo_chemcon.F90 b/hamocc/mo_chemcon.F90 index 041c6ac4..8366ef52 100644 --- a/hamocc/mo_chemcon.F90 +++ b/hamocc/mo_chemcon.F90 @@ -16,42 +16,32 @@ ! along with BLOM. If not, see https://www.gnu.org/licenses/. -MODULE mo_chemcon +module mo_chemcon + !********************************************************************** + ! Parameter definitions for chemical formulas + ! - declare chemical parameters previously defined in subroutine chemcon ! - !**** *MODULE mo_chemcon* - Parameter definitions for chemical formulas - ! - ! J. Schwinger, *UiB-GfI, Bergen* 2013-08-21 - ! - ! Modified - ! -------- - ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 - ! - added constants for Kh CO2 w.r.t. dry air (Weiss, 1974) - ! - ! - ! Purpose - ! ------- - ! - declare chemical parameters previously defined in - ! subroutine chemcon - ! + ! J. Schwinger, *UiB-GfI, Bergen* 2013-08-21 + ! Modified + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - added constants for Kh CO2 w.r.t. dry air (Weiss, 1974) !********************************************************************** - implicit none - - - ! real, parameter :: ZERO=0. - ! real, parameter :: TENM7=10.**(-7.0) - ! real, parameter :: SMICR=1.E-6 - ! real, parameter :: THOUSI=1./1000. - ! real, parameter :: PERC=0.01 - ! real, parameter :: FOURTH=0.25 - ! real, parameter :: THIRD=1./3. - ! real, parameter :: HALF=0.5 - ! real, parameter :: ONE=1. - ! real, parameter :: TWO=2. - ! real, parameter :: TEN=10. - + public + + ! real, parameter :: ZERO=0. + ! real, parameter :: TENM7=10.**(-7.0) + ! real, parameter :: SMICR=1.E-6 + ! real, parameter :: THOUSI=1./1000. + ! real, parameter :: PERC=0.01 + ! real, parameter :: FOURTH=0.25 + ! real, parameter :: THIRD=1./3. + ! real, parameter :: HALF=0.5 + ! real, parameter :: ONE=1. + ! real, parameter :: TWO=2. + ! real, parameter :: TEN=10. ! ----------------------------------------------------------------- !* BORON CONCENTRATION IN SEA WATER IN G/KG PER O/OO CL @@ -59,7 +49,6 @@ MODULE mo_chemcon ! real, parameter :: BOR1=0.000232 - ! ----------------------------------------------------------------- !* INVERSE OF ATOMIC WEIGHT OF BORON [G**-1] ! (USED TO CONVERT SPECIFIC TOTAL BORAT INTO CONCENTRATIONS) @@ -74,13 +63,11 @@ MODULE mo_chemcon real, parameter :: SALCHL=1./1.80655 real, parameter :: rrrcl=salchl*1.025*bor1*bor2 - ! ----------------------------------------------------------------- !* ZERO DEG CENTIGRADE AT KELVIN SCALE ! real, parameter :: tzero=273.15 - ! ----------------------------------------------------------------- !* SET MEAN TOTAL [CA++] IN SEAWATER (MOLES/KG) (SEE BROECKER ! A. PENG, 1982, P. 26; [CA++](MOLES/KG)=1.028E-2*(S/35.); Value @@ -88,13 +75,11 @@ MODULE mo_chemcon ! real, parameter :: CALCON=0.01028 - ! ----------------------------------------------------------------- !* INVERS OF NORMAL MOLAL VOLUME OF AN IDEAL GAS [mol/ml] at 0C ! real, parameter :: OXYCO=1./22414.4 - ! ----------------------------------------------------------------- !* VOLUMETRIC SOLUBILITY CONSTANTS FOR O2 IN ML/L from moist air at ! one atm total pressure. Table 2 in WEISS, R. F. (1970) THE @@ -109,7 +94,6 @@ MODULE mo_chemcon real, parameter :: OX5=0.014259 real, parameter :: OX6=-0.0017 - ! ----------------------------------------------------------------- !* VOLUMETRIC SOLUBILITY CONSTANTS FOR N2 IN ML/L from moist air at ! one atm total pressure. Table 2 in WEISS, R. F. (1970) THE @@ -124,7 +108,6 @@ MODULE mo_chemcon real, parameter :: AN5=0.025018 real, parameter :: AN6=-0.0034861 - ! ----------------------------------------------------------------- ! Constants for CO2 solubility in mol/kg/atm from moist ! air at one atm total pressure. Table 6 in WEISS, R.F., @@ -139,7 +122,6 @@ MODULE mo_chemcon real, parameter :: bc2= -0.025225 real, parameter :: bc3= 0.0049867 - ! ----------------------------------------------------------------- ! Constants for CO2 solubility in mol/kg/atm for dry ! air at one atm total pressure. Table 1 in WEISS, R.F., @@ -153,7 +135,6 @@ MODULE mo_chemcon real, parameter :: bd2= -0.023656 real, parameter :: bd3= 0.0047036 - ! ----------------------------------------------------------------- ! Constants for laughing gas solubility in mol/l/atm from moist ! air at one atm total pressure. Table 2 in WEISS, R.F., @@ -168,37 +149,32 @@ MODULE mo_chemcon real, parameter :: bl2= 0.031619 real, parameter :: bl3= -0.0048472 - ! ----------------------------------------------------------------- ! Atmospheric mixing ratio of N2O around 1980 300 ppb ! real, parameter :: atn2o=3.e-7 - - ! ----------------------------------------------------------------- ! Constants needed for pressure correction of equilibrium constants ! F. Millero, Thermodynamics of the carbon dioxide system in the oceans, ! Geochimica et Cosmochimica Acta, Vol. 59, No. 4, pp. 661-677, 1995 REAL, DIMENSION(11) :: a0, a1, a2, b0, b1, b2 DATA a0 /-25.5, -15.82, -29.48, -25.60, -18.03, -9.78, -48.76, & - -46., -14.51, -23.12, -26.57/ + -46., -14.51, -23.12, -26.57/ DATA a1 /0.1271, -0.0219, 0.1622, 0.2324, 0.0466, -0.0090, & - 0.5304, 0.5304, 0.1211, 0.1758, 0.2020/ + 0.5304, 0.5304, 0.1211, 0.1758, 0.2020/ DATA a2 /0.0, 0.0, 2.608e-3, -3.6246e-3, 0.316e-3, & - -0.942e-3, 0.0, 0.0, -0.321e-3, -2.647e-3, -3.042e-3/ + -0.942e-3, 0.0, 0.0, -0.321e-3, -2.647e-3, -3.042e-3/ DATA b0 /-3.08e-3, 1.13e-3, -2.84e-3, -5.13e-3, -4.53e-3, & - -3.91e-3, -11.76e-3, -11.76e-3, -2.67e-3, -5.15e-3, & - -4.08e-3/ + -3.91e-3, -11.76e-3, -11.76e-3, -2.67e-3, -5.15e-3, & + -4.08e-3/ DATA b1 /0.0877e-3, -0.1475e-3, 0.0, 0.0794e-3, 0.09e-3, & - 0.054e-3, 0.3692e-3, 0.3692e-3, 0.0427e-3, & - 0.09e-3, 0.0714e-3/ + 0.054e-3, 0.3692e-3, 0.3692e-3, 0.0427e-3, & + 0.09e-3, 0.0714e-3/ DATA b2 /0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/ ! ----------------------------------------------------------------- ! Gas constant, value as used by Millero (1995) - real, parameter :: rgas = 83.131 - -END MODULE mo_chemcon +end module mo_chemcon diff --git a/hamocc/mo_clim_swa.F90 b/hamocc/mo_clim_swa.F90 index 96fb4910..f460866c 100644 --- a/hamocc/mo_clim_swa.F90 +++ b/hamocc/mo_clim_swa.F90 @@ -17,86 +17,68 @@ module mo_clim_swa + !****************************************************************************** - ! - ! MODULE mo_clim_swa - Variables and routines for climatology short-wave fields + ! Variables and routines for climatology short-wave fields + ! -Declaration, memory allocation, and routines related to swa_clim fields ! ! J.Tjiputra, *NORCE Climate, Bergen* 2021-04-15 - ! - ! Modified - ! -------- - ! - ! Purpose - ! ------- - ! Declaration, memory allocation, and routines related to swa_clim fields - ! !****************************************************************************** - implicit none + implicit none private - public :: ini_swa_clim, swaclimfile, swa_clim - ! File name (incl. full path) for input data, set through namelist - ! in hamocc_init.F - character(len=512), save :: swaclimfile='' - ! Array to store swa flux after reading from file - real, allocatable, save :: swa_clim(:,:,:) + ! Routines + public :: ini_swa_clim + ! Module variables -contains - !****************************************************************************** + ! File name (incl. full path) for input data, set through namelist in hamocc_init.F + character(len=512), public :: swaclimfile='' + ! Array to store swa flux after reading from file + real, allocatable, public :: swa_clim(:,:,:) +contains subroutine ini_swa_clim(kpie,kpje,omask) + !****************************************************************************** - ! - ! INI_SWA_CLIM - initialise the climatology SWA field module. + ! Initialise the climatology SWA field module. + ! Initialise the climatology swa module, read in the swa (short-wave radiation) + ! data set. ! ! J.Tjiputra *NORCE Climate, Bergen* 2021-04-15 - ! - ! Purpose - ! ------- - ! Initialise the climatology swa module, read in the swa (short-wave radiation) data set. - ! - ! Parameter list: - ! --------------- - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! *REAL* *omask* - land/ocean mask (1=ocean) - ! !****************************************************************************** + use netcdf, only: nf90_noerr,nf90_nowrite,nf90_close,nf90_open use mod_xc, only: mnproc,xchalt use mo_control_bgc, only: io_stdo_bgc use mo_read_netcdf_var, only: read_netcdf_var - implicit none - ! Arguments - integer, intent(in) :: kpie,kpje - real, intent(in) :: omask(kpie,kpje) + integer, intent(in) :: kpie ! 1st dimension of model grid. + integer, intent(in) :: kpje ! 2nd dimension of model grid. + real, intent(in) :: omask(kpie,kpje) ! land/ocean mask (1=ocean) ! Local variables integer :: i,j integer :: ncid,ncstat,ncvarid,errstat - ! allocate field to hold swa fields IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'***************************************************' - WRITE(io_stdo_bgc,*)'iHAMOCC: Initialization of module mo_clim_swa:' - WRITE(io_stdo_bgc,*)' ' + write(io_stdo_bgc,*)' ' + write(io_stdo_bgc,*)'***************************************************' + write(io_stdo_bgc,*)'iHAMOCC: Initialization of module mo_clim_swa:' + write(io_stdo_bgc,*)' ' ENDIF IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable swa_clim ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable swa_clim ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - - ALLOCATE (swa_clim(kpie,kpje,1),stat=errstat) + allocate (swa_clim(kpie,kpje,1),stat=errstat) if(errstat.ne.0) stop 'not enough memory swa_clim' swa_clim(:,:,1) = 0.0 @@ -104,7 +86,7 @@ subroutine ini_swa_clim(kpie,kpje,omask) IF(mnproc==1) THEN ncstat = NF90_OPEN(trim(swaclimfile),NF90_NOWRITE, ncid) IF (ncstat.NE.NF90_NOERR ) THEN - CALL xchalt('(ini_swa_clim: Problem with netCDF1)') + call xchalt('(ini_swa_clim: Problem with netCDF1)') stop '(ini_swa_clim: Problem with netCDF1)' END IF END IF @@ -116,7 +98,7 @@ subroutine ini_swa_clim(kpie,kpje,omask) IF(mnproc==1) THEN ncstat = NF90_CLOSE(ncid) IF ( ncstat .NE. NF90_NOERR ) THEN - CALL xchalt('(ini_swa_clim: Problem with netCDF200)') + call xchalt('(ini_swa_clim: Problem with netCDF200)') stop '(ini_swa_clim: Problem with netCDF200)' END IF END IF @@ -135,12 +117,6 @@ subroutine ini_swa_clim(kpie,kpje,omask) enddo enddo - - RETURN - - !****************************************************************************** end subroutine ini_swa_clim - - !****************************************************************************** end module mo_clim_swa diff --git a/hamocc/mo_control_bgc.F90 b/hamocc/mo_control_bgc.F90 index 38e69b6f..50fb4135 100644 --- a/hamocc/mo_control_bgc.F90 +++ b/hamocc/mo_control_bgc.F90 @@ -16,53 +16,51 @@ ! 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. + ! - declaration ! - !**** *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 - ! - ! + ! S.Legutke, *MPI-MaD, HH* 28.02.02 + ! Modified + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - removed unused variables !********************************************************************** + implicit none + public + + ! Routines + public :: get_bgc_namelist ! Logical unit number for I/O. - INTEGER :: io_stdo_bgc ! standard out. + integer :: io_stdo_bgc ! standard out. ! File containing namelists - CHARACTER(LEN=:), ALLOCATABLE, PROTECTED :: bgc_namelist + character(len=:), allocatable, protected :: bgc_namelist ! Control variables - REAL :: dtbgc ! time step length [sec]. - REAL :: dtb ! time step length [days]. - INTEGER :: ndtdaybgc ! time steps per day. + real :: dtbgc ! time step length [sec]. + real :: dtb ! time step length [days]. + integer :: ndtdaybgc ! time steps per day. - INTEGER :: ldtbgc ! time step number from bgc restart file - INTEGER :: ldtrunbgc ! actual time steps of run. + integer :: ldtbgc ! time step number from bgc restart file + integer :: ldtrunbgc ! actual time steps of run. - INTEGER :: sedspin_yr_s = -1 - INTEGER :: sedspin_yr_e = -1 - INTEGER :: sedspin_ncyc = -1 + integer :: sedspin_yr_s = -1 + integer :: sedspin_yr_e = -1 + integer :: sedspin_ncyc = -1 - REAL :: rmasks = 0.0 ! value at wet cells in sediment. - REAL :: rmasko = 99999.00 ! value at wet cells in ocean. + real :: rmasks = 0.0 ! value at wet cells in sediment. + real :: rmasko = 99999.00 ! value at wet cells in ocean. ! 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 :: 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 logical :: use_BROMO = .false. @@ -87,8 +85,6 @@ subroutine get_bgc_namelist use mod_config, only: inst_suffix use mod_xc, only: xchalt - implicit none - logical :: exists if (.not. allocated(bgc_namelist)) then @@ -109,4 +105,4 @@ subroutine get_bgc_namelist endif end subroutine get_bgc_namelist -END MODULE mo_control_bgc +end module mo_control_bgc diff --git a/hamocc/mo_cyano.F90 b/hamocc/mo_cyano.F90 index 084c31d4..ddf29eb8 100644 --- a/hamocc/mo_cyano.F90 +++ b/hamocc/mo_cyano.F90 @@ -16,58 +16,32 @@ ! 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_CYANO +module mo_cyano implicit none private - public :: CYANO + public :: cyano -CONTAINS +contains - SUBROUTINE CYANO(kpie,kpje,kpke,kbnd,pddpo,omask,ptho) + subroutine cyano(kpie,kpje,kpke,kbnd,pddpo,omask,ptho) !********************************************************************** + ! Nitrogen-fixation by cyano bacteria, followed by remineralisation + ! and nitrification ! - !**** *CYANO* - . - ! - ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 - ! - ! Modified - ! -------- - ! S.Legutke, *MPI-MaD, HH* 10.04.01 - ! - included : surface reduction of gaseous nitrogen - ! - ! I.Kriest, *GEOMAR, Kiel* 2016-08-11 - ! - included T-dependence of cyanobacteria growth - ! - modified oxygen stoichiometry for N2-Fixation - ! - ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 - ! - moved accumulation of all output fields to seperate subroutine, - ! related code-restructuring - ! - added reduction of alkalinity through N-fixation - ! - ! Purpose - ! ------- - ! Nitrogen-fixation by cyano bacteria, followed by remineralisation - ! and nitrification - ! - ! Method: - ! ------ - ! - ! - !** Interface to ocean model (parameter list): - ! ----------------------------------------- - ! - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. - ! *INTEGER* *kbnd* - nb of halo grid points - ! *REAL* *ptho* - potential temperature. - ! - ! Externals - ! --------- - ! . + ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 + ! Modified + ! S.Legutke, *MPI-MaD, HH* 10.04.01 + ! - included : surface reduction of gaseous nitrogen + ! I.Kriest, *GEOMAR, Kiel* 2016-08-11 + ! - included T-dependence of cyanobacteria growth + ! - modified oxygen stoichiometry for N2-Fixation + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - moved accumulation of all output fields to seperate subroutine, + ! related code-restructuring + ! - added reduction of alkalinity through N-fixation !********************************************************************** use mo_vgrid, only: kmle @@ -78,10 +52,13 @@ SUBROUTINE CYANO(kpie,kpje,kpke,kbnd,pddpo,omask,ptho) use mo_control_bgc, only: use_natDIC ! Arguments - integer, intent(in) :: kpie,kpje,kpke,kbnd + integer, intent(in) :: kpie ! 1st dimension of model grid. + integer, intent(in) :: kpje ! 2nd dimension of model grid. + integer, intent(in) :: kpke ! 3rd (vertical) dimension of model grid. + integer, intent(in) :: kbnd ! nb of halo grid points real, intent(in) :: pddpo(kpie,kpje,kpke) real, intent(in) :: omask(kpie,kpje) - real, intent(in) :: ptho(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) + real, intent(in) :: ptho(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) ! potential temperature. ! Local variables integer :: i,j,k @@ -131,6 +108,6 @@ SUBROUTINE CYANO(kpie,kpje,kpke,kbnd,pddpo,omask,ptho) ENDDO ENDDO - END SUBROUTINE CYANO + end subroutine cyano -END MODULE MO_CYANO +end module mo_cyano diff --git a/hamocc/mo_dipowa.F90 b/hamocc/mo_dipowa.F90 index 129029fb..0de0d01b 100644 --- a/hamocc/mo_dipowa.F90 +++ b/hamocc/mo_dipowa.F90 @@ -16,78 +16,53 @@ ! 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_DIPOWA +module mo_dipowa implicit none private - public :: DIPOWA + public :: dipowa -CONTAINS +contains - SUBROUTINE DIPOWA(kpie,kpje,kpke,omask,lspin) + subroutine dipowa(kpie,kpje,kpke,omask,lspin) !********************************************************************** + ! diffusion of pore water + ! vertical diffusion of sediment pore water tracers + ! calculate vertical diffusion of sediment pore water properties + ! and diffusive flux through the ocean/sediment interface. + ! method is implicit formulation; + ! constant diffusion coefficient : 1.e-9 set in ini_sedmnt in mo_sedmnt + ! diffusion coefficient : zcoefsu/zcoeflo for upper/lower + ! sediment layer boundary. ! - !**** *DIPOWA* - 'diffusion of pore water' - ! vertical diffusion of sediment pore water tracers - ! - ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 - ! - ! Modified - ! -------- - ! S.Legutke, *MPI-MaD, HH* 10.04.01 - ! - all npowtra-1 properties are diffused in 1 go. - ! js: not mass conserving check c13/powtra/ocetra - ! - ! Purpose - ! ------- - ! calculate vertical diffusion of sediment pore water properties - ! and diffusive flux through the ocean/sediment interface. - ! integration. - ! - ! Method - ! ------- - ! implicit formulation; - ! constant diffusion coefficient : 1.e-9 set in ini_sedmnt in mo_sedmnt - ! diffusion coefficient : zcoefsu/zcoeflo for upper/lower - ! sediment layer boundary. - ! - !** Interface. - ! ---------- - ! - ! *CALL* *DIPOWA* - ! - ! Externals - ! --------- - ! none. - ! + ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 + ! Modified + ! S.Legutke, *MPI-MaD, HH* 10.04.01 + ! - all npowtra-1 properties are diffused in 1 go. + ! js: not mass conserving check c13/powtra/ocetra !********************************************************************** - use mo_carbch, only: ocetra, sedfluxo - use mo_sedmnt, only: powtra,porwat,porwah,seddw,zcoefsu,zcoeflo - use mo_param1_bgc, only: ks,npowtra,map_por2octra - use mo_vgrid, only: kbo,bolay - ! cisonew - use mo_param1_bgc, only: ipowc13,ipowc14,isco213,isco214 - ! natDIC - use mo_param1_bgc, only: ialkali,inatalkali,inatsco212,isco212 + use mo_carbch, only: ocetra, sedfluxo + use mo_sedmnt, only: powtra,porwat,porwah,seddw,zcoefsu,zcoeflo + use mo_param1_bgc, only: ks,npowtra,map_por2octra + use mo_vgrid, only: kbo,bolay + use mo_param1_bgc, only: ipowc13,ipowc14,isco213,isco214 + use mo_param1_bgc, only: ialkali,inatalkali,inatsco212,isco212 use mo_control_bgc, only: use_natDIC - implicit none - + ! Arguments integer, intent(in) :: kpie, kpje, kpke real, intent(in) :: omask(kpie,kpje) logical, intent(in) :: lspin ! Local variables integer :: i,j,k,l,iv - integer :: iv_oc ! index of ocetra in powtra loop - - real :: sedb1(kpie,0:ks,npowtra) ! ???? - real :: tredsy(kpie,0:kpke,3) ! redsy for 'reduced system'? - real :: aprior ! start value of oceanic tracer in bottom layer - + integer :: iv_oc ! index of ocetra in powtra loop + real :: sedb1(kpie,0:ks,npowtra) ! ???? + real :: tredsy(kpie,0:kpke,3) ! redsy for 'reduced system'? + real :: aprior ! start value of oceanic tracer in bottom layer !$OMP PARALLEL DO & !$OMP&PRIVATE(i,k,iv,l,tredsy,sedb1,aprior,iv_oc) @@ -207,6 +182,6 @@ SUBROUTINE DIPOWA(kpie,kpje,kpke,omask,lspin) enddo j_loop - END SUBROUTINE DIPOWA + end subroutine dipowa -END MODULE MO_DIPOWA +end module mo_dipowa diff --git a/hamocc/mo_get_cfc.F90 b/hamocc/mo_get_cfc.F90 index fb0b250d..e7513e87 100644 --- a/hamocc/mo_get_cfc.F90 +++ b/hamocc/mo_get_cfc.F90 @@ -15,24 +15,22 @@ ! 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_GET_CFC +module mo_get_cfc implicit none private - public :: GET_CFC + public :: get_cfc -CONTAINS +contains - SUBROUTINE GET_CFC(kplyear,atm_cfc11_nh,atm_cfc12_nh,atm_sf6_nh, & + subroutine get_cfc(kplyear,atm_cfc11_nh,atm_cfc12_nh,atm_sf6_nh, & atm_cfc11_sh,atm_cfc12_sh,atm_sf6_sh) - ! + !********************************************************************** - ! - !**** *GET_CFC* - . - ! ! Jerry Tjiputra *BCCR* 05.12.2012 - ! + !********************************************************************** + use mo_control_bgc, only: io_stdo_bgc use mod_xc, only: mnproc @@ -194,6 +192,6 @@ SUBROUTINE GET_CFC(kplyear,atm_cfc11_nh,atm_cfc12_nh,atm_sf6_nh, & kplyear_old = kplyear ENDIF - END SUBROUTINE get_cfc + end subroutine get_cfc -END MODULE MO_GET_CFC +end module mo_get_cfc diff --git a/hamocc/mo_hamocc4bcm.F90 b/hamocc/mo_hamocc4bcm.F90 index bef23145..999e9303 100644 --- a/hamocc/mo_hamocc4bcm.F90 +++ b/hamocc/mo_hamocc4bcm.F90 @@ -16,80 +16,40 @@ ! 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_HAMOCC4BCM +module mo_hamocc4bcm implicit none private public :: HAMOCC4BCM -CONTAINS +contains - SUBROUTINE HAMOCC4BCM(kpie,kpje,kpke,kbnd,kplyear,kplmon,kplday,kldtday,& + subroutine hamocc4bcm(kpie,kpje,kpke,kbnd,kplyear,kplmon,kplday,kldtday,& pdlxp,pdlyp,pddpo,prho,pglat,omask, & dust,rivin,ndep,oafx,pi_ph, & pfswr,psicomo,ppao,pfu10,ptho,psao, & patmco2,pflxco2,pflxdms,patmbromo,pflxbromo) !****************************************************************************** - ! - ! HAMOCC4BGC - main routine of iHAMOCC. - ! - ! Modified - ! -------- + ! main routine of iHAMOCC. + ! Modified: ! J.Schwinger *GFI, Bergen* 2013-10-21 ! - added GNEWS2 option for riverine input of carbon and nutrients ! - code cleanup - ! ! J.Schwinger *GFI, Bergen* 2014-05-21 ! - moved copying of tracer field to ocetra to micom2hamocc ! and hamocc2micom - ! ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 ! - moved accumulation of all output fields to seperate subroutine, ! related code-restructuring ! - added sediment bypass preprocessor option - ! ! J.Schwinger, *NORCE Climate, Bergen* 2020-05-28 ! - restructuring of iHAMOCC code, cleanup parameter list ! - boundary conditions (dust, riverinput, N-deposition) are now passed as ! an argument - ! - ! Parameter list: - ! --------------- - ! - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. - ! *INTEGER* *kbnd* - nb of halo grid points. - ! *INTEGER* *kplyear* - current year. - ! *INTEGER* *kplmon* - current month. - ! *INTEGER* *kplday* - current day. - ! *INTEGER* *kldtday* - number of time step in current day. - ! *REAL* *pdlxp* - size of grid cell (longitudinal) [m]. - ! *REAL* *pdlyp* - size of grid cell (latitudinal) [m]. - ! *REAL* *pddpo* - size of grid cell (depth) [m]. - ! *REAL* *prho* - density [kg/m^3]. - ! *REAL* *pglat* - latitude of grid cells [deg north]. - ! *REAL* *omask* - land/ocean mask. - ! *REAL* *dust* - dust deposition flux [kg/m2/month]. - ! *REAL* *rivin* - riverine input [kmol m-2 yr-1]. - ! *REAL* *ndep* - nitrogen deposition [kmol m-2 yr-1]. - ! *REAL* *oaflx* - alkalinity flux from alkalinization [kmol m-2 yr-1] - ! *REAL* *pfswr* - solar radiation [W/m**2]. - ! *REAL* *psicomo* - sea ice concentration - ! *REAL* *ppao* - sea level pressure [Pascal]. - ! *REAL* *pfu10* - absolute wind speed at 10m height [m/s] - ! *REAL* *ptho* - potential temperature [deg C]. - ! *REAL* *psao* - salinity [psu.]. - ! *REAL* *patmco2* - atmospheric CO2 concentration [ppm] used in - ! fully coupled mode (prognostic/diagnostic CO2). - ! *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. - ! !****************************************************************************** + use mod_xc, only: mnproc 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 @@ -115,30 +75,36 @@ SUBROUTINE HAMOCC4BCM(kpie,kpje,kpke,kbnd,kplyear,kplmon,kplday,kldtday,& use mo_carchm, only: carchm ! Arguments - integer, intent(in) :: kpie,kpje,kpke,kbnd - integer, intent(in) :: kplyear,kplmon,kplday,kldtday - real, intent(in) :: pdlxp (kpie,kpje) - real, intent(in) :: pdlyp (kpie,kpje) - real, intent(in) :: pddpo (kpie,kpje,kpke) - real, intent(in) :: prho (kpie,kpje,kpke) - real, intent(in) :: pglat (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - real, intent(in) :: omask (kpie,kpje) - real, intent(in) :: dust (kpie,kpje) - real, intent(in) :: rivin (kpie,kpje,nriv) - real, intent(in) :: ndep (kpie,kpje) + integer, intent(in) :: kpie ! 1st dimension of model grid. + integer, intent(in) :: kpje ! 2nd dimension of model grid. + integer, intent(in) :: kpke ! 3rd (vertical) dimension of model grid. + integer, intent(in) :: kbnd ! number of halo grid points. + integer, intent(in) :: kplyear ! current year. + integer, intent(in) :: kplmon ! current month. + integer, intent(in) :: kplday ! current day. + integer, intent(in) :: kldtday ! number of time step in current day. + real, intent(in) :: pdlxp (kpie,kpje) ! size of grid cell (longitudinal) [m]. + real, intent(in) :: pdlyp (kpie,kpje) ! size of grid cell (latitudinal) [m]. + real, intent(in) :: pddpo (kpie,kpje,kpke) ! size of grid cell (depth) [m]. + real, intent(in) :: prho (kpie,kpje,kpke) ! density [kg/m^3]. + real, intent(in) :: pglat (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) ! latitude of grid cells [deg north]. + real, intent(in) :: omask (kpie,kpje) ! land/ocean mask. + real, intent(in) :: dust (kpie,kpje) ! dust deposition flux [kg/m2/month]. + real, intent(in) :: rivin (kpie,kpje,nriv) ! riverine input [kmol m-2 yr-1]. + real, intent(in) :: ndep (kpie,kpje) ! nitrogen deposition [kmol m-2 yr-1]. real, intent(in) :: oafx (kpie,kpje) - real, intent(in) :: pi_ph (kpie,kpje) - real, intent(in) :: pfswr (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - real, intent(in) :: psicomo(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - real, intent(in) :: ppao (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - real, intent(in) :: pfu10 (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - real, intent(in) :: ptho (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) - 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(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) + real, intent(in) :: pi_ph (kpie,kpje) ! alkalinity flux from alkalinization [kmol m-2 yr-1] + real, intent(in) :: pfswr (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) ! solar radiation [W/m**2]. + real, intent(in) :: psicomo(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) ! sea ice concentration + real, intent(in) :: ppao (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) ! sea level pressure [Pascal]. + real, intent(in) :: pfu10 (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) ! absolute wind speed at 10m height [m/s] + real, intent(in) :: ptho (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) ! potential temperature [deg C]. + real, intent(in) :: psao (1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) ! salinity [psu.]. + real, intent(in) :: patmco2(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) ! atmospheric CO2 concentration [ppm] used in fully coupled mode + real, intent(out) :: pflxco2(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) ! CO2 flux [kg/m^2/s]. + real, intent(inout) :: pflxdms(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) ! DMS flux [kg/m^2/s]. + real, intent(in) :: patmbromo(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) ! atmospheric bromoform concentration [ppt] used in fully coupled mode. + real, intent(inout) :: pflxbromo(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) ! Bromoform flux [kg/m^2/s]. ! Local variables integer :: i,j,k,l @@ -149,7 +115,6 @@ SUBROUTINE HAMOCC4BCM(kpie,kpje,kpke,kbnd,kplyear,kplmon,kplday,kldtday,& write(io_stdo_bgc,*) 'iHAMOCC',KLDTDAY,LDTRUNBGC,NDTDAYBGC ENDIF - !-------------------------------------------------------------------- ! Increment bgc time step counter of run (initialized in HAMOCC_INIT). ! @@ -213,8 +178,8 @@ SUBROUTINE HAMOCC4BCM(kpie,kpje,kpke,kbnd,kplyear,kplmon,kplday,kldtday,& if (use_PBGC_CK_TIMESTEP) then IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'before BGC: call INVENTORY' + 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 @@ -233,13 +198,12 @@ SUBROUTINE HAMOCC4BCM(kpie,kpje,kpke,kbnd,kplyear,kplmon,kplday,kldtday,& if (use_PBGC_CK_TIMESTEP ) then IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'after OCPROD: call INVENTORY' + 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 - do l=1,nocetra do K=1,kpke !$OMP PARALLEL DO PRIVATE(i) @@ -256,8 +220,8 @@ SUBROUTINE HAMOCC4BCM(kpie,kpje,kpke,kbnd,kplyear,kplmon,kplday,kldtday,& if (use_PBGC_CK_TIMESTEP ) then IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'after LIMIT: call INVENTORY' + 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 @@ -266,8 +230,8 @@ SUBROUTINE HAMOCC4BCM(kpie,kpje,kpke,kbnd,kplyear,kplmon,kplday,kldtday,& if (use_PBGC_CK_TIMESTEP ) then IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'after CYANO: call INVENTORY' + 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 @@ -277,8 +241,8 @@ SUBROUTINE HAMOCC4BCM(kpie,kpje,kpke,kbnd,kplyear,kplmon,kplday,kldtday,& if (use_PBGC_CK_TIMESTEP ) then IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'after CARCHM: call INVENTORY' + 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 @@ -288,8 +252,8 @@ SUBROUTINE HAMOCC4BCM(kpie,kpje,kpke,kbnd,kplyear,kplmon,kplday,kldtday,& if (use_PBGC_CK_TIMESTEP ) then IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'after N deposition: call INVENTORY' + 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 @@ -299,8 +263,8 @@ SUBROUTINE HAMOCC4BCM(kpie,kpje,kpke,kbnd,kplyear,kplmon,kplday,kldtday,& if (use_PBGC_CK_TIMESTEP ) then IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'after river input: call INVENTORY' + 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 @@ -310,8 +274,8 @@ SUBROUTINE HAMOCC4BCM(kpie,kpje,kpke,kbnd,kplyear,kplmon,kplday,kldtday,& if (use_PBGC_CK_TIMESTEP ) then IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'after ocean alkalinization: call INVENTORY' + 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 @@ -323,8 +287,8 @@ SUBROUTINE HAMOCC4BCM(kpie,kpje,kpke,kbnd,kplyear,kplmon,kplday,kldtday,& if (use_PBGC_CK_TIMESTEP ) then IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'after ATMOTR: call INVENTORY' + 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 @@ -364,8 +328,8 @@ SUBROUTINE HAMOCC4BCM(kpie,kpje,kpke,kbnd,kplyear,kplmon,kplday,kldtday,& if (use_PBGC_CK_TIMESTEP ) then IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'after POWACH: call INVENTORY' + write(io_stdo_bgc,*)' ' + write(io_stdo_bgc,*)'after POWACH: call INVENTORY' ENDIF call inventory_bgc(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) endif @@ -373,8 +337,8 @@ SUBROUTINE HAMOCC4BCM(kpie,kpje,kpke,kbnd,kplyear,kplmon,kplday,kldtday,& ! Sediment is shifted once a day (on both time levels!) IF(KLDTDAY .EQ. 1 .OR. KLDTDAY .EQ. 2) THEN IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*) 'Sediment shifting ...' + write(io_stdo_bgc,*)' ' + write(io_stdo_bgc,*) 'Sediment shifting ...' ENDIF call sedshi(kpie,kpje,omask) ENDIF @@ -383,8 +347,8 @@ SUBROUTINE HAMOCC4BCM(kpie,kpje,kpke,kbnd,kplyear,kplmon,kplday,kldtday,& if (use_PBGC_CK_TIMESTEP ) then IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'after BGC: call INVENTORY' + write(io_stdo_bgc,*)' ' + write(io_stdo_bgc,*)'after BGC: call INVENTORY' ENDIF call inventory_bgc(kpie,kpje,kpke,pdlxp,pdlyp,pddpo,omask,0) endif @@ -428,6 +392,6 @@ SUBROUTINE HAMOCC4BCM(kpie,kpje,kpke,kbnd,kplyear,kplmon,kplday,kldtday,& !$OMP END PARALLEL DO !-------------------------------------------------------------------- - END SUBROUTINE HAMOCC4BCM + end subroutine hamocc4bcm -END MODULE MO_HAMOCC4BCM +end module mo_hamocc4bcm diff --git a/hamocc/mo_hamocc_init.F90 b/hamocc/mo_hamocc_init.F90 index 943d441b..8d3bca85 100644 --- a/hamocc/mo_hamocc_init.F90 +++ b/hamocc/mo_hamocc_init.F90 @@ -16,36 +16,25 @@ ! 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_HAMOCC_INIT +module mo_hamocc_init implicit none private - public :: HAMOCC_INIT + public :: hamocc_init -CONTAINS +contains subroutine HAMOCC_INIT(read_rest,rstfnm_hamocc) !****************************************************************************** - ! - ! HAMOCC_INIT - initialize HAMOCC and its interface to BLOM. - ! + ! Initialize HAMOCC and its interface to BLOM. + ! Interface to ocean model (parameter list): + ! - HAMOCC intialization when coupled to BLOM. ! ! J.Schwinger, *NORCE Climate, Bergen* 2020-05-25 - ! - ! - ! Purpose - ! ------- - ! - HAMOCC intialization when coupled to BLOM. - ! - ! - ! Interface to ocean model (parameter list): - ! ----------------------------------------- - ! *INTEGER* *read_rest* - flag indicating whether to read restart files. - ! *INTEGER* *rstfnm_hamocc* - restart filename. - ! !****************************************************************************** + use mod_time, only: date,baclin use mod_xc, only: ii,jj,kk,idm,jdm,kdm,nbdy,isp,ifp,ilp, & mnproc,lp,nfu,xchalt @@ -81,8 +70,8 @@ subroutine HAMOCC_INIT(read_rest,rstfnm_hamocc) use mo_aufr_bgc, only: aufr_bgc ! Arguments - integer, intent(in) :: read_rest - character(len=*), intent(in) :: rstfnm_hamocc + integer, intent(in) :: read_rest ! flag indicating whether to read restart files. + character(len=*), intent(in) :: rstfnm_hamocc ! restart filename. ! Local variables integer :: i,j,k,l,nt @@ -108,7 +97,7 @@ subroutine HAMOCC_INIT(read_rest,rstfnm_hamocc) if (mnproc.eq.1) then write(io_stdo_bgc,*) - WRITE(io_stdo_bgc,*)'********************************************' + write(io_stdo_bgc,*)'********************************************' write(io_stdo_bgc,*) 'iHAMOCC: initialisation' write(io_stdo_bgc,*) write(io_stdo_bgc,*) 'restart',read_rest @@ -142,16 +131,16 @@ subroutine HAMOCC_INIT(read_rest,rstfnm_hamocc) ENDIF ! init the index-mapping between pore water and ocean tracers - CALL init_por2octra_mapping() + call init_por2octra_mapping() ! ! --- Memory allocation ! - CALL ALLOC_MEM_INTFCBLOM(idm,jdm,kdm) - CALL ALLOC_MEM_BGCMEAN(idm,jdm,kdm) - CALL ALLOC_MEM_VGRID(idm,jdm,kdm) - CALL ALLOC_MEM_BIOMOD(idm,jdm,kdm) - CALL ALLOC_MEM_SEDMNT(idm,jdm) - CALL ALLOC_MEM_CARBCH(idm,jdm,kdm) + call alloc_mem_intfcblom(idm,jdm,kdm) + call alloc_mem_bgcmean(idm,jdm,kdm) + call alloc_mem_vgrid(idm,jdm,kdm) + call alloc_mem_biomod(idm,jdm,kdm) + call alloc_mem_sedmnt(idm,jdm) + call alloc_mem_carbch(idm,jdm,kdm) ! ! --- initialise trc array (two time levels) ! @@ -185,31 +174,31 @@ subroutine HAMOCC_INIT(read_rest,rstfnm_hamocc) ! ! --- Initialize parameters ! - CALL ini_parambgc(idm,jdm) + call ini_parambgc(idm,jdm) ! --- Initialize atmospheric fields with (updated) parameter values call ini_fields_atm(idm,jdm) ! --- Initialize sediment and ocean tracers - CALL ini_fields_ocean(read_rest,idm,jdm,kdm,nbdy,bgc_dp,bgc_rho,omask,plon,plat) + call ini_fields_ocean(read_rest,idm,jdm,kdm,nbdy,bgc_dp,bgc_rho,omask,plon,plat) ! --- Initialize sediment layering ! First, read the porosity and potentially apply it in ini_sedimnt - CALL read_sedpor(idm,jdm,ks,omask,sed_por) - CALL ini_sedmnt(idm,jdm,kdm,omask,sed_por) + call read_sedpor(idm,jdm,ks,omask,sed_por) + call ini_sedmnt(idm,jdm,kdm,omask,sed_por) ! ! --- Initialise reading of input data (dust, n-deposition, river, etc.) ! - CALL ini_read_fedep(idm,jdm,omask) + call ini_read_fedep(idm,jdm,omask) - CALL ini_read_ndep(idm,jdm) + call ini_read_ndep(idm,jdm) - CALL ini_read_rivin(idm,jdm,omask) + call ini_read_rivin(idm,jdm,omask) - CALL ini_read_oafx(idm,jdm,bgc_dx,bgc_dy,plat,omask) + call ini_read_oafx(idm,jdm,bgc_dx,bgc_dy,plat,omask) if (use_BROMO) then - CALL ini_swa_clim(idm,jdm,omask) + call ini_swa_clim(idm,jdm,omask) endif call ini_pi_ph(idm,jdm,omask) @@ -220,7 +209,7 @@ subroutine HAMOCC_INIT(read_rest,rstfnm_hamocc) ! two-time-level counterpart ! IF(read_rest.eq.1) THEN - CALL AUFR_BGC(idm,jdm,kdm,ntr,ntrbgc,itrbgc,trc, & + call AUFR_BGC(idm,jdm,kdm,ntr,ntrbgc,itrbgc,trc, & & date%year,date%month,date%day,omask,rstfnm_hamocc) ELSE trc(1:idm,1:jdm,1:kdm, itrbgc:itrbgc+ntrbgc-1) = & @@ -243,12 +232,11 @@ subroutine HAMOCC_INIT(read_rest,rstfnm_hamocc) if (mnproc.eq.1) then write(io_stdo_bgc,*) - WRITE(io_stdo_bgc,*)'********************************************' + write(io_stdo_bgc,*)'********************************************' write(io_stdo_bgc,*) 'iHAMOCC: finished initialisation' write(io_stdo_bgc,*) endif - !****************************************************************************** - END SUBROUTINE HAMOCC_INIT + end subroutine hamocc_init -END MODULE MO_HAMOCC_INIT +end module mo_hamocc_init diff --git a/hamocc/mo_hamocc_step.F90 b/hamocc/mo_hamocc_step.F90 index 0b66c1fd..6312489f 100644 --- a/hamocc/mo_hamocc_step.F90 +++ b/hamocc/mo_hamocc_step.F90 @@ -15,16 +15,16 @@ ! 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_HAMOCC_STEP +module mo_hamocc_step implicit none private - public :: HAMOCC_STEP + public :: hamocc_step -CONTAINS +contains - SUBROUTINE HAMOCC_STEP(m,n,mm,nn,k1m,k1n) + subroutine hamocc_step(m,n,mm,nn,k1m,k1n) ! ! --- ------------------------------------------------------------------ ! --- perform one HAMOCC step @@ -96,6 +96,6 @@ SUBROUTINE HAMOCC_STEP(m,n,mm,nn,k1m,k1n) call hamocc2blom(m,n,mm,nn) - END SUBROUTINE HAMOCC_STEP + end subroutine hamocc_step -END MODULE MO_HAMOCC_STEP +end module mo_hamocc_step diff --git a/hamocc/mo_ini_fields.F90 b/hamocc/mo_ini_fields.F90 index af8e7850..e34e2513 100644 --- a/hamocc/mo_ini_fields.F90 +++ b/hamocc/mo_ini_fields.F90 @@ -17,35 +17,33 @@ ! 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_INI_FIELDS +module mo_ini_fields implicit none private - public :: INI_FIELDS_OCEAN - public :: INI_FIELDS_ATM + public :: ini_fields_ocean + public :: ini_fields_atm contains - !******************************************************************************* - SUBROUTINE INI_FIELDS_ATM(kpie,kpje) + subroutine ini_fields_atm(kpie,kpje) use mo_control_bgc, only: use_natDIC,use_cisonew,use_BROMO use mo_param1_bgc, only: iatmco2,iatmo2,iatmn2,iatmnco2,iatmc13,iatmc14,iatmbromo use mo_param_bgc, only: atm_o2,atm_n2,atm_co2_nat,atm_c13,atm_c14,c14fac,atm_bromo use mo_carbch, only: atm,atm_co2 - implicit none - - ! ! Initialise atmosphere fields. We use a 2D representation of atmospheric ! 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. - ! - INTEGER, intent(in) :: kpie,kpje - INTEGER :: i,j + ! Arguments + integer, intent(in) :: kpie,kpje + + ! local variables + integer :: i,j DO j=1,kpje DO i=1,kpie @@ -66,41 +64,17 @@ SUBROUTINE INI_FIELDS_ATM(kpie,kpje) ENDDO END SUBROUTINE INI_FIELDS_ATM - ! =============================================================================== SUBROUTINE INI_FIELDS_OCEAN(kpaufr,kpie,kpje,kpke,kbnd,pddpo,prho,omask,pglon,pglat) !****************************************************************************** - ! - ! BELEG_VARS - initialize bgc variables. + ! Initialize bgc variables. + ! - set initial values for bgc variables. ! ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 - ! ! Modified - ! -------- ! J.Schwinger, *NORCE Climate, Bergen* 2020-05-19 - ! -split the original BELEG_BGC in two parts, BELEG_PARM (NOW MO_PARAM_BGC) and BELEG_VARS - ! - ! - ! Purpose - ! ------- - ! - set initial values for bgc variables. - ! - ! - ! Parameter list: - ! --------------- - ! *INTEGER* *kpaufr* - 1/0 flag, 1 indicating a restart run - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. - ! *INTEGER* *kbnd* - nb of halo grid points - ! *REAL* *pddpo* - size of grid cell (3rd dimension) [m]. - ! *REAL* *prho* - density [g/cm^3]. - ! *REAL* *omask* - ocean mask. - ! *REAL* *pglon* - longitude of grid cell [deg]. - ! *REAL* *pglat* - latitude of grid cell [deg]. - ! - ! + ! -split the original BELEG_BGC in two parts, BELEG_PARM (NOW MO_PARAM_BGC) and BELEG_VARS !****************************************************************************** use mo_carbch, only: co2star,co3,hi,ocetra @@ -120,12 +94,16 @@ SUBROUTINE INI_FIELDS_OCEAN(kpaufr,kpie,kpje,kpke,kbnd,pddpo,prho,omask,pglon,pg use mo_profile_gd, only: profile_gd ! Arguments - integer, intent(in) :: kpaufr,kpie,kpje,kpke,kbnd - real, intent(in) :: pddpo(kpie,kpje,kpke) - real, intent(in) :: prho (kpie,kpje,kpke) - real, intent(in) :: omask(kpie,kpje) - real, intent(in) :: pglon(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) - real, intent(in) :: pglat(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) + integer, intent(in) :: kpaufr ! 1/0 flag, 1 indicating a restart run + integer, intent(in) :: kpie ! 1st dimension of model grid. + integer, intent(in) :: kpje ! 2nd dimension of model grid. + integer, intent(in) :: kpke ! 3rd (vertical) dimension of model grid. + integer, intent(in) :: kbnd ! nb of halo grid points + real, intent(in) :: pddpo(kpie,kpje,kpke) ! size of grid cell (3rd dimension) [m]. + real, intent(in) :: prho (kpie,kpje,kpke) ! density [g/cm^3]. + real, intent(in) :: omask(kpie,kpje) ! ocean mask. + real, intent(in) :: pglon(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) ! longitude of grid cell [deg]. + real, intent(in) :: pglat(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd) ! latitude of grid cell [deg]. ! local variables integer :: i,j,k,l @@ -323,6 +301,6 @@ SUBROUTINE INI_FIELDS_OCEAN(kpaufr,kpie,kpje,kpke,kbnd,pddpo,prho,omask,pglon,pg ENDDO endif - END SUBROUTINE INI_FIELDS_OCEAN + end subroutine ini_fields_ocean -END MODULE MO_INI_FIELDS +end module mo_ini_fields diff --git a/hamocc/mo_intfcblom.F90 b/hamocc/mo_intfcblom.F90 index c618f07a..cf112eb0 100644 --- a/hamocc/mo_intfcblom.F90 +++ b/hamocc/mo_intfcblom.F90 @@ -17,233 +17,185 @@ module mo_intfcblom + !****************************************************************************** - ! - ! MODULE mo_intfcblom - Variables for BLOM-iHAMOCC interface + ! Variables for BLOM-iHAMOCC interface + ! - Declaration and memory allocation related to the BLOM-iHAMOCC interface. + ! - This includes 2-time-level copies of sediment and amospheric fields. ! ! J.Schwinger, *NORCE Climate, Bergen* 2020-05-19 - ! - ! Modified - ! -------- - ! - ! Purpose - ! ------- - ! Declaration and memory allocation related to the BLOM-iHAMOCC interface. - ! This includes 2-time-level copies of sediment and amospheric fields. - ! - ! Description: - ! ------------ - ! Public routines and variable of this module: - ! - ! -subroutine alloc_mem_intfcblom - ! Allocate memory for BLOM interface variables - ! - ! -subroutine blom2hamocc - ! Transfer fields from BLOM to HAMOCC - ! - ! -subroutine hamocc2blom - ! Transfer fields from HAMOCC to BLOM - ! - ! - ! *nphys* *INTEGER* - number of bgc timesteps per ocean timestep. - ! *bgc_dx* *REAL* - size of grid cell (longitudinal) [m]. - ! *bgc_dx* *REAL* - size of grid cell (latitudinal) [m]. - ! *bgc_dp* *REAL* - size of grid cell (depth) [m]. - ! *bgc_rho* *REAL* - sea water density [kg/m^3]. - ! *omask* *REAL* - land ocean mask. - ! - ! The following arrays are used to keep a two time-level copy of sediment - ! and prognostic atmosphere fields. These arrays are copied back and forth - ! in blom2hamocc.F and hamocc2blom.F in the same manner as the tracer field. - ! Also, they written/read to and from restart files: - ! - ! *sedlay2* *REAL* - two time-level copy of sedlay - ! *powtra2* *REAL* - two time-level copy of powtra - ! *burial2* *REAL* - two time-level copy of burial - ! *atm2* *REAL* - two time-level copy of atm - ! !****************************************************************************** + use mo_control_bgc, only: use_sedbypass,use_BOXATM implicit none + private - integer, parameter :: nphys=2 + ! Routines - real, allocatable :: bgc_dx(:,:),bgc_dy(:,:) - real, allocatable :: bgc_dp(:,:,:) - real, allocatable :: bgc_rho(:,:,:) - real, allocatable :: omask(:,:) + public :: alloc_mem_intfcblom ! Allocate memory for BLOM interface variables + public :: blom2hamocc ! Transfer fields from BLOM to HAMOCC + public :: hamocc2blom ! Transfer fields from HAMOCC to BLOM - ! Two time-level copy of sediment fields - real, allocatable :: sedlay2(:,:,:,:) - real, allocatable :: powtra2(:,:,:,:) - real, allocatable :: burial2(:,:,:,:) + ! Module variables - ! Two time level copy of prognostic atmosphere field - ! used if BOXATM is activated - real, allocatable :: atm2(:,:,:,:) + integer, parameter, public :: nphys=2 ! number of bgc timesteps per ocean timestep. -contains - !****************************************************************************** + real, allocatable, public :: bgc_dx(:,:) ! size of grid cell (longitudinal) [m]. + real, allocatable, public :: bgc_dy(:,:) ! size of grid cell (latitudinal) [m]. + real, allocatable, public :: bgc_dp(:,:,:) ! size of grid cell (depth) [m]. + real, allocatable, public :: bgc_rho(:,:,:) ! sea water density [kg/m^3]. + + real, allocatable, public :: omask(:,:) ! land ocean mask. + + ! The following arrays are used to keep a two time-level copy of sediment + ! and prognostic atmosphere fields. These arrays are copied back and forth + ! in blom2hamocc.F and hamocc2blom.F in the same manner as the tracer field. + ! Also, they written/read to and from restart files: + + ! Two time-level copy of sediment fields + real, allocatable, public :: sedlay2(:,:,:,:) + real, allocatable, public :: powtra2(:,:,:,:) + real, allocatable, public :: burial2(:,:,:,:) + ! Two time level copy of prognostic atmosphere field used if BOXATM is activated + real, allocatable, public :: atm2(:,:,:,:) +contains subroutine alloc_mem_intfcblom(kpie,kpje,kpke) + !****************************************************************************** + ! Allocate variables in this module ! - ! ALLOC_MEM_VGRID - Allocate variables in this module - ! - ! J.Schwinger *NORCE Climate, Bergen* 2020-05-19 - ! + ! J.Schwinger *NORCE Climate, Bergen* 2020-05-19 !****************************************************************************** + use mod_xc, only: mnproc use mo_control_bgc, only: io_stdo_bgc use mo_param1_bgc, only: ks,nsedtra,npowtra,natm - INTEGER, intent(in) :: kpie,kpje,kpke - INTEGER :: errstat + ! Arguments + integer, intent(in) :: kpie,kpje,kpke + ! Local variables + integer :: errstat IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'***************************************************' - WRITE(io_stdo_bgc,*)'Memory allocation for module mo_intfcblom :' - WRITE(io_stdo_bgc,*)' ' + write(io_stdo_bgc,*)' ' + write(io_stdo_bgc,*)'***************************************************' + write(io_stdo_bgc,*)'Memory allocation for module mo_intfcblom :' + write(io_stdo_bgc,*)' ' ENDIF - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable bgc_dx, bgc_dy ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable bgc_dx, bgc_dy ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - - ALLOCATE (bgc_dx(kpie,kpje),stat=errstat) - ALLOCATE (bgc_dy(kpie,kpje),stat=errstat) + allocate (bgc_dx(kpie,kpje),stat=errstat) + allocate (bgc_dy(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory bgc_dx, bgc_dy' bgc_dx(:,:) = 0.0 bgc_dy(:,:) = 0.0 - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable bgc_dp ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',kpke + write(io_stdo_bgc,*)'Memory allocation for variable bgc_dp ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Third dimension : ',kpke ENDIF - - ALLOCATE (bgc_dp(kpie,kpje,kpke),stat=errstat) + allocate (bgc_dp(kpie,kpje,kpke),stat=errstat) if(errstat.ne.0) stop 'not enough memory bgc_dp' bgc_dp(:,:,:) = 0.0 - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable bgc_rho ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',kpke + write(io_stdo_bgc,*)'Memory allocation for variable bgc_rho ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Third dimension : ',kpke ENDIF - - ALLOCATE (bgc_rho(kpie,kpje,kpke),stat=errstat) + allocate (bgc_rho(kpie,kpje,kpke),stat=errstat) if(errstat.ne.0) stop 'not enough memory bgc_dp' bgc_rho(:,:,:) = 0.0 - IF(mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable omask ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable omask ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - - ALLOCATE(omask(kpie,kpje),stat=errstat) + allocate(omask(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory omask' omask(:,:) = 0.0 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 + 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) + 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 + 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) + 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 + 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) + allocate (burial2(kpie,kpje,2,nsedtra),stat=errstat) if(errstat.ne.0) stop 'not enough memory burial2' burial2(:,:,:,:) = 0.0 endif 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 + 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) + allocate (atm2(kpie,kpje,2,natm),stat=errstat) if(errstat.ne.0) stop 'not enough memory atm2' atm2(:,:,:,:) = 0.0 endif end subroutine alloc_mem_intfcblom - !****************************************************************************** - subroutine blom2hamocc(m,n,mm,nn) + !****************************************************************************** + ! Interface between BLOM and HAMOCC. ! - !**** *SUBROUTINE blom2hammoc* - Interface between BLOM and HAMOCC. - ! - ! K. Assmann *GFI, UiB initial version - ! J. Schwinger *GFI, UiB 2013-04-22 - ! - - ! - ! Modified - ! -------- - ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 - ! - removed inverse of layer thickness - ! - added sediment bypass preprocessor option - ! - ! M. Bentsen, *NORCE, Bergen* 2020-05-03 - ! - changed ocean model from MICOM to BLOM - ! - ! T. Torsvik, *University of Bergen* 2021-08-26 - ! - integrate subroutine into module mo_intfcblom - ! - ! Purpose - ! ------- - ! - - ! + ! K. Assmann *GFI, UiB initial version + ! J. Schwinger *GFI, UiB 2013-04-22 + ! Modified: + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - removed inverse of layer thickness + ! - added sediment bypass preprocessor option + ! M. Bentsen, *NORCE, Bergen* 2020-05-03 + ! - changed ocean model from MICOM to BLOM + ! T. Torsvik, *University of Bergen* 2021-08-26 + ! - integrate subroutine into module mo_intfcblom !****************************************************************************** - ! + use mod_constants, only: onem use mod_xc, only: ii,jdm,jj,kdm,kk,ifp,isp,ilp,idm use mod_grid, only: scpx,scpy @@ -256,13 +208,13 @@ subroutine blom2hamocc(m,n,mm,nn) use mo_sedmnt, only: sedlay,powtra,sedhpl,burial use mo_vgrid, only: kmle, kmle_static - implicit none - + ! Arguments integer, intent(in) :: m,n,mm,nn - integer :: i,j,k,l,nns,kn - real :: p1,p2,ldp,th,s,pa - real :: rp(idm,jdm,kdm+1) + ! Local variables + integer :: i,j,k,l,nns,kn + real :: p1,p2,ldp,th,s,pa + real :: rp(idm,jdm,kdm+1) nns=(n-1)*ks @@ -406,41 +358,30 @@ subroutine blom2hamocc(m,n,mm,nn) endif end subroutine blom2hamocc - !****************************************************************************** - subroutine hamocc2blom(m,n,mm,nn) + !****************************************************************************** + ! Interface between BLOM and HAMOCC. + ! Pass flux and tracer fields back from HAMOCC to BLOM. + ! The local HAMOCC arrays are copied back in the appropriate + ! time-level of the tracer field. Note that also sediment fields + ! are copied back, since a two time-level copy of sediment fields + ! is kept outside HAMOCC. For the sediment fields the same time- + ! smothing as for the tracer field (i.e. analog to tmsmt2.F) is + ! performed to avoid a seperation of the two time levels. ! - !**** *SUBROUTINE hamocc2blom* - Interface between BLOM and HAMOCC. - ! - ! J. Schwinger *GFI, UiB 2014-05-21 initial version - ! - - ! - ! Modified - ! -------- - ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 - ! - added sediment bypass preprocessor option - ! - ! M. Bentsen, *NORCE, Bergen* 2020-05-03 - ! - changed ocean model from MICOM to BLOM - ! - ! T. Torsvik, *University of Bergen* 2021-08-26 - ! - integrate subroutine into module mo_intfcblom - ! - ! Purpose - ! ------- - ! Pass flux and tracer fields back from HAMOCC to BLOM. - ! The local HAMOCC arrays are copied back in the appropriate - ! time-level of the tracer field. Note that also sediment fields - ! are copied back, since a two time-level copy of sediment fields - ! is kept outside HAMOCC. For the sediment fields the same time- - ! smothing as for the tracer field (i.e. analog to tmsmt2.F) is - ! performed to avoid a seperation of the two time levels. - ! + ! J. Schwinger *GFI, UiB 2014-05-21 initial version + ! Modified: + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - added sediment bypass preprocessor option + ! M. Bentsen, *NORCE, Bergen* 2020-05-03 + ! - changed ocean model from MICOM to BLOM + ! T. Torsvik, *University of Bergen* 2021-08-26 + ! - integrate subroutine into module mo_intfcblom !****************************************************************************** - ! + use mod_xc, only: ii,jj,kk,ifp,ilp,isp use mod_tracers, only: ntrbgc,itrbgc,trc use mod_tmsmt, only: wts1, wts2 @@ -448,10 +389,11 @@ subroutine hamocc2blom(m,n,mm,nn) use mo_param1_bgc, only: ks,nsedtra,npowtra,natm use mo_sedmnt, only: sedlay,powtra,sedhpl,burial - implicit none - + ! Arguments integer, intent(in) :: m,n,mm,nn - integer :: i,j,k,l,nns,mms,kn,km + + ! Local variables + integer :: i,j,k,l,nns,mms,kn,km ! --- ------------------------------------------------------------------ ! --- pass tracer fields to ocean model; convert kmol/m^3 -> mol/kg @@ -524,10 +466,10 @@ subroutine hamocc2blom(m,n,mm,nn) if (use_BOXATM) then !$OMP PARALLEL DO PRIVATE(i) do j=1,jj - do i=1,ii ! time smoothing (analog to tmsmt2.F) + 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 + + wts2*atm2(i,j,n,:) & ! old timelevel + + wts2*atm(i,j,:) ! new timelevel enddo enddo !$OMP END PARALLEL DO @@ -542,6 +484,5 @@ subroutine hamocc2blom(m,n,mm,nn) endif end subroutine hamocc2blom - !****************************************************************************** end module mo_intfcblom diff --git a/hamocc/mo_inventory_bgc.F90 b/hamocc/mo_inventory_bgc.F90 index 79ef2311..ecee3909 100644 --- a/hamocc/mo_inventory_bgc.F90 +++ b/hamocc/mo_inventory_bgc.F90 @@ -16,51 +16,26 @@ ! 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_INVENTORY_BGC +module mo_inventory_bgc implicit none private - public :: INVENTORY_BGC + public :: inventory_bgc -CONTAINS +contains - SUBROUTINE INVENTORY_BGC(kpie,kpje,kpke,dlxp,dlyp,ddpo,omask,iogrp) + subroutine inventory_bgc(kpie,kpje,kpke,dlxp,dlyp,ddpo,omask,iogrp) !******************************************************************* + ! Calculate the BGC inventory. ! - !**** *INVENTORY_BGC* - calculate the BGC inventory. - ! - ! P.Wetzel, *MPI-Met, HH* 29.07.02 - ! - ! Modified - ! -------- - ! T. Torsvik *UiB* 22.02.22 - ! Include option for writing inventory to netCDF file. - ! - ! Purpose - ! ------- - ! - calculate the BGC inventory. - ! - ! Method - ! ------- - ! - - ! - !** Interface. - ! ---------- - ! - ! *CALL* *INVENTORY_BGC* - ! - ! - !** Interface to ocean model (parameter list): - ! ----------------------------------------- - ! - ! - ! Externals - ! --------- - ! none. - ! + ! P.Wetzel, *MPI-Met, HH* 29.07.02 + ! Modified + ! T. Torsvik *UiB* 22.02.22 + ! Include option for writing inventory to netCDF file. !********************************************************************** + use mod_xc, only: mnproc,ips,nbdy,xcsum use mo_carbch, only: atm,atmflx,co3,hi,ndepflx,rivinflx,ocetra,sedfluxo use mo_sedmnt, only: prcaca,prorca,silpro @@ -156,7 +131,7 @@ SUBROUTINE INVENTORY_BGC(kpie,kpje,kpke,dlxp,dlyp,ddpo,omask,iogrp) ENDDO ENDDO - CALL xcsum(zsedtotvol,ztmp1,ips) + call xcsum(zsedtotvol,ztmp1,ips) DO l=1,npowtra ztmp1(:,:)=0.0 @@ -169,7 +144,7 @@ SUBROUTINE INVENTORY_BGC(kpie,kpje,kpke,dlxp,dlyp,ddpo,omask,iogrp) ENDDO ENDDO - CALL xcsum(zpowtratot(l),ztmp1,ips) + call xcsum(zpowtratot(l),ztmp1,ips) zpowtratoc(l) = zpowtratot(l)/zsedtotvol ENDDO @@ -188,7 +163,7 @@ SUBROUTINE INVENTORY_BGC(kpie,kpje,kpke,dlxp,dlyp,ddpo,omask,iogrp) ENDDO ENDDO - CALL xcsum(zsedlayto(l),ztmp1,ips) + call xcsum(zsedlayto(l),ztmp1,ips) ENDDO ztmp1(:,:)=0.0 @@ -201,7 +176,7 @@ SUBROUTINE INVENTORY_BGC(kpie,kpje,kpke,dlxp,dlyp,ddpo,omask,iogrp) ENDDO ENDDO - CALL xcsum(zsedhplto,ztmp1,ips) + call xcsum(zsedhplto,ztmp1,ips) endif ! not sedbypass @@ -223,7 +198,7 @@ SUBROUTINE INVENTORY_BGC(kpie,kpje,kpke,dlxp,dlyp,ddpo,omask,iogrp) ENDDO ENDDO - CALL xcsum(ztotvol,ztmp1,ips) + call xcsum(ztotvol,ztmp1,ips) DO l=1,nocetra ztmp1(:,:)=0.0 @@ -234,14 +209,14 @@ SUBROUTINE INVENTORY_BGC(kpie,kpje,kpke,dlxp,dlyp,ddpo,omask,iogrp) vol = dlxp(i,j)*dlyp(i,j)*ddpo(i,j,k) ztmp1(i,j) = ztmp1(i,j) + omask(i,j)*ocetra(i,j,k,l)*vol ! if (ocetra(i,j,k,l).lt.0.0) then - ! WRITE(io_stdo_bgc,*) 'ocetra -ve', l,ocetra(i,j,k,l) + ! write(io_stdo_bgc,*) 'ocetra -ve', l,ocetra(i,j,k,l) ! endif ENDIF ENDDO ENDDO ENDDO - CALL xcsum(zocetratot(l),ztmp1,ips) + call xcsum(zocetratot(l),ztmp1,ips) zocetratoc(l) = zocetratot(l)/ztotvol ENDDO @@ -264,8 +239,8 @@ SUBROUTINE INVENTORY_BGC(kpie,kpje,kpke,dlxp,dlyp,ddpo,omask,iogrp) ENDDO ENDDO - CALL xcsum(zhito ,ztmp1,ips) - CALL xcsum(zco3to,ztmp2,ips) + call xcsum(zhito ,ztmp1,ips) + call xcsum(zco3to,ztmp2,ips) !=== alkalinity of the first layer !-------------------------------------------------------------------- @@ -282,8 +257,8 @@ SUBROUTINE INVENTORY_BGC(kpie,kpje,kpke,dlxp,dlyp,ddpo,omask,iogrp) ENDDO ENDDO - CALL xcsum(zvoltop,ztmp1,ips) - CALL xcsum(zalkali,ztmp2,ips) + call xcsum(zvoltop,ztmp1,ips) + call xcsum(zalkali,ztmp2,ips) !=== atmosphere flux and atmospheric CO2 !-------------------------------------------------------------------- @@ -304,7 +279,7 @@ SUBROUTINE INVENTORY_BGC(kpie,kpje,kpke,dlxp,dlyp,ddpo,omask,iogrp) ztmp1(i,j) = dlxp(i,j)*dlyp(i,j) ENDDO ENDDO - CALL xcsum(ztotarea,ztmp1,ips) + call xcsum(ztotarea,ztmp1,ips) if (use_PBGC_CK_TIMESTEP) then ! only consider instantaneous fluxes in debugging mode @@ -521,138 +496,138 @@ subroutine write_stdout if (.not. use_sedbypass) then !=== aqueous sediment tracer !------------------------------------------------------------------ - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*)'Global inventory of aqueous sediment tracer' - WRITE(io_stdo_bgc,*)'-------------------------------------------' - WRITE(io_stdo_bgc,*) ' total[kmol] concentration[mol/L]' + write(io_stdo_bgc,*) ' ' + write(io_stdo_bgc,*)'Global inventory of aqueous sediment tracer' + write(io_stdo_bgc,*)'-------------------------------------------' + write(io_stdo_bgc,*) ' total[kmol] concentration[mol/L]' DO l=1,npowtra - WRITE(io_stdo_bgc,*)'No. ',l,' ',zpowtratot(l), & + write(io_stdo_bgc,*)'No. ',l,' ',zpowtratot(l), & & ' ',zpowtratoc(l),' ',zsedtotvol ENDDO - WRITE(io_stdo_bgc,*) ' ' + write(io_stdo_bgc,*) ' ' !=== non aqueous sediment tracer !------------------------------------------------------------------ - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) & + write(io_stdo_bgc,*) ' ' + write(io_stdo_bgc,*) & & 'Global inventory of solid sediment constituents' - WRITE(io_stdo_bgc,*) & + write(io_stdo_bgc,*) & & '----------------------------------------------------' - WRITE(io_stdo_bgc,*) ' [kmol]' + write(io_stdo_bgc,*) ' [kmol]' DO l=1,nsedtra - WRITE(io_stdo_bgc,*) 'Sediment No. ',l,' ', zsedlayto(l) - WRITE(io_stdo_bgc,*) 'Burial No. ',l,' ', zburial(l) + write(io_stdo_bgc,*) 'Sediment No. ',l,' ', zsedlayto(l) + write(io_stdo_bgc,*) 'Burial No. ',l,' ', zburial(l) ENDDO - WRITE(io_stdo_bgc,*) 'hpl ', zsedhplto - WRITE(io_stdo_bgc,*) ' ' + write(io_stdo_bgc,*) 'hpl ', zsedhplto + write(io_stdo_bgc,*) ' ' endif !=== oceanic tracers !------------------------------------------------------------------ - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Global inventory of advected ocean tracers' - WRITE(io_stdo_bgc,*) '------------------------------------------' - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) ' total[kmol] concentration[kmol/m^3]' - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'ztotvol',ztotvol + write(io_stdo_bgc,*) ' ' + write(io_stdo_bgc,*) 'Global inventory of advected ocean tracers' + write(io_stdo_bgc,*) '------------------------------------------' + write(io_stdo_bgc,*) ' ' + write(io_stdo_bgc,*) ' total[kmol] concentration[kmol/m^3]' + write(io_stdo_bgc,*) ' ' + write(io_stdo_bgc,*) 'ztotvol',ztotvol DO l=1,nocetra - WRITE(io_stdo_bgc,*) 'No. ',l, zocetratot(l), zocetratoc(l) + write(io_stdo_bgc,*) 'No. ',l, zocetratot(l), zocetratoc(l) ENDDO !=== additional ocean tracer !------------------------------------------------------------------ - ! WRITE(io_stdo_bgc,*) ' ' - ! WRITE(io_stdo_bgc,*) 'Glob. inventory of additional ocean tracer' - ! WRITE(io_stdo_bgc,*) '------------------------------------------' - ! WRITE(io_stdo_bgc,*) ' total[kmol] concentration[kmol/m^3]' - ! WRITE(io_stdo_bgc,*) ' ' - ! WRITE(io_stdo_bgc,*) ' hi', zhito, zhito/ztotvol - ! WRITE(io_stdo_bgc,*) ' co3', zco3to, zco3to/ztotvol - ! WRITE(io_stdo_bgc,*) ' ' + ! write(io_stdo_bgc,*) ' ' + ! write(io_stdo_bgc,*) 'Glob. inventory of additional ocean tracer' + ! write(io_stdo_bgc,*) '------------------------------------------' + ! write(io_stdo_bgc,*) ' total[kmol] concentration[kmol/m^3]' + ! write(io_stdo_bgc,*) ' ' + ! write(io_stdo_bgc,*) ' hi', zhito, zhito/ztotvol + ! write(io_stdo_bgc,*) ' co3', zco3to, zco3to/ztotvol + ! write(io_stdo_bgc,*) ' ' !=== alkalinity of the first layer !------------------------------------------------------------------ - ! WRITE(io_stdo_bgc,*) ' ' - ! WRITE(io_stdo_bgc,*) 'Global inventory of first layer alkalinity' - ! WRITE(io_stdo_bgc,*) '------------------------------------------' - ! WRITE(io_stdo_bgc,*) ' ' - ! WRITE(io_stdo_bgc,*) ' total[kmol] concentration[kmol/m^3]' - ! WRITE(io_stdo_bgc,*) ' ' - ! WRITE(io_stdo_bgc,*) zalkali, zalkali/zvoltop + ! write(io_stdo_bgc,*) ' ' + ! write(io_stdo_bgc,*) 'Global inventory of first layer alkalinity' + ! write(io_stdo_bgc,*) '------------------------------------------' + ! write(io_stdo_bgc,*) ' ' + ! write(io_stdo_bgc,*) ' total[kmol] concentration[kmol/m^3]' + ! write(io_stdo_bgc,*) ' ' + ! write(io_stdo_bgc,*) zalkali, zalkali/zvoltop !=== atmosphere flux and atmospheric CO2 !------------------------------------------------------------------ - ! WRITE(io_stdo_bgc,*) ' ' - ! WRITE(io_stdo_bgc,*) 'Global fluxes into atmosphere' - ! WRITE(io_stdo_bgc,*) '-----------------------------' - ! WRITE(io_stdo_bgc,*) ' [kmol]' - ! WRITE(io_stdo_bgc,*) ' ' - ! WRITE(io_stdo_bgc,*) 'CO2Flux :',co2flux - ! WRITE(io_stdo_bgc,*) 'O2 Flux :',so2flux - ! WRITE(io_stdo_bgc,*) 'N2 Flux :',sn2flux - ! WRITE(io_stdo_bgc,*) 'N2O Flux :',sn2oflux - ! WRITE(io_stdo_bgc,*) ' ' + ! write(io_stdo_bgc,*) ' ' + ! write(io_stdo_bgc,*) 'Global fluxes into atmosphere' + ! write(io_stdo_bgc,*) '-----------------------------' + ! write(io_stdo_bgc,*) ' [kmol]' + ! write(io_stdo_bgc,*) ' ' + ! write(io_stdo_bgc,*) 'CO2Flux :',co2flux + ! write(io_stdo_bgc,*) 'O2 Flux :',so2flux + ! write(io_stdo_bgc,*) 'N2 Flux :',sn2flux + ! write(io_stdo_bgc,*) 'N2O Flux :',sn2oflux + ! write(io_stdo_bgc,*) ' ' if (use_BOXATM) then - ! WRITE(io_stdo_bgc,*) 'global atm. CO2[ppm] / kmol: ', & + ! write(io_stdo_bgc,*) 'global atm. CO2[ppm] / kmol: ', & ! & zatmco2/ztotarea,zatmco2*ppm2con - ! WRITE(io_stdo_bgc,*) 'global atm. O2[ppm] / kmol : ', & + ! write(io_stdo_bgc,*) 'global atm. O2[ppm] / kmol : ', & ! & zatmo2/ztotarea,zatmo2*ppm2con - ! WRITE(io_stdo_bgc,*) 'global atm. N2[ppm] / kmol : ', & + ! write(io_stdo_bgc,*) 'global atm. N2[ppm] / kmol : ', & ! & zatmn2/ztotarea,zatmn2*ppm2con endif - ! WRITE(io_stdo_bgc,*) ' ' - ! WRITE(io_stdo_bgc,*) 'Should be zero at the end: ' - ! WRITE(io_stdo_bgc,*) 'prorca, prcaca, silpro ', & + ! write(io_stdo_bgc,*) ' ' + ! write(io_stdo_bgc,*) 'Should be zero at the end: ' + ! write(io_stdo_bgc,*) 'prorca, prcaca, silpro ', & ! & zprorca, zprcaca, zsilpro - ! WRITE(io_stdo_bgc,*) ' ' + ! write(io_stdo_bgc,*) ' ' - IF(do_ndep) WRITE(io_stdo_bgc,*) 'NdepFlux :',sndepflux + IF(do_ndep) write(io_stdo_bgc,*) 'NdepFlux :',sndepflux ! riverine fluxes !------------------------------------------------------------------ IF(do_rivinpt)THEN - WRITE(io_stdo_bgc,*) 'Riverine fluxes:' + write(io_stdo_bgc,*) 'Riverine fluxes:' DO l=1,nriv - WRITE(io_stdo_bgc,*) 'No. ',l,srivflux(l) + write(io_stdo_bgc,*) 'No. ',l,srivflux(l) ENDDO ENDIF !=== Sum of inventory !------------------------------------------------------------------ ! Units in P have a C:P Ratio of 122:1 - WRITE(io_stdo_bgc,*) 'Global total[kmol] of carbon : ', totalcarbon - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Global total[kmol] of phosph. : ', totalphos - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Global total[kmol] of silicate : ', totalsil - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Global total[kmol] of nitrogen. : ', totalnitr - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Global total[kmol] of oxygen. : ', totaloxy + write(io_stdo_bgc,*) 'Global total[kmol] of carbon : ', totalcarbon + write(io_stdo_bgc,*) ' ' + write(io_stdo_bgc,*) 'Global total[kmol] of phosph. : ', totalphos + write(io_stdo_bgc,*) ' ' + write(io_stdo_bgc,*) 'Global total[kmol] of silicate : ', totalsil + write(io_stdo_bgc,*) ' ' + write(io_stdo_bgc,*) 'Global total[kmol] of nitrogen. : ', totalnitr + write(io_stdo_bgc,*) ' ' + write(io_stdo_bgc,*) 'Global total[kmol] of oxygen. : ', totaloxy !=== Write sediment fluxes !------------------------------------------------------------------ - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Global fluxes into and out of the sediment' - WRITE(io_stdo_bgc,*) '------------------------------------------' - WRITE(io_stdo_bgc,*) ' [kmol]' - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Detritus, Calcium Carbonate, Silicate ', & + write(io_stdo_bgc,*) ' ' + write(io_stdo_bgc,*) 'Global fluxes into and out of the sediment' + write(io_stdo_bgc,*) '------------------------------------------' + write(io_stdo_bgc,*) ' [kmol]' + write(io_stdo_bgc,*) ' ' + write(io_stdo_bgc,*) 'Detritus, Calcium Carbonate, Silicate ', & & sum_zprorca, sum_zprcaca, sum_zsilpro - WRITE(io_stdo_bgc,*) ' ' + write(io_stdo_bgc,*) ' ' DO l=1,npowtra - WRITE(io_stdo_bgc,*) 'No. ',l,' ',sum_sedfluxo(l) + write(io_stdo_bgc,*) 'No. ',l,' ',sum_sedfluxo(l) ENDDO - WRITE(io_stdo_bgc,*) ' ' - WRITE(io_stdo_bgc,*) 'Global total export production' - WRITE(io_stdo_bgc,*) '------------------------------' - WRITE(io_stdo_bgc,*) ' [kmol]' - WRITE(io_stdo_bgc,*) 'carbon : ',sum_expoor - WRITE(io_stdo_bgc,*) 'carbonate: ',sum_expoca - WRITE(io_stdo_bgc,*) 'silicate : ',sum_exposi - WRITE(io_stdo_bgc,*) ' ' + write(io_stdo_bgc,*) ' ' + write(io_stdo_bgc,*) 'Global total export production' + write(io_stdo_bgc,*) '------------------------------' + write(io_stdo_bgc,*) ' [kmol]' + write(io_stdo_bgc,*) 'carbon : ',sum_expoor + write(io_stdo_bgc,*) 'carbonate: ',sum_expoca + write(io_stdo_bgc,*) 'silicate : ',sum_exposi + write(io_stdo_bgc,*) ' ' end subroutine write_stdout @@ -1499,7 +1474,7 @@ subroutine write_netcdf(iogrp) !=== Open existing netCDF file write(io_stdo_bgc,*) 'Write BGC inventory to file : ', & & trim(fname_inv(iogrp)) - call nccheck( NF90_OPEN(trim(fname_inv(iogrp)), NF90_WRITE, ncid) ) + call nccheck( NF90_OPEN(trim(fname_inv(iogrp)), NF90_write, ncid) ) !--- Inquire dimid call nccheck( NF90_INQ_DIMID(ncid, "time", time_dimid) ) if (.not. use_sedbypass) then @@ -1904,7 +1879,6 @@ subroutine nccheck(status) endif end subroutine nccheck + end subroutine inventory_bgc - END SUBROUTINE INVENTORY_BGC - -END MODULE MO_INVENTORY_BGC +end module mo_inventory_bgc diff --git a/hamocc/mo_ncout_hamocc.F90 b/hamocc/mo_ncout_hamocc.F90 index 868b776f..4863dc60 100644 --- a/hamocc/mo_ncout_hamocc.F90 +++ b/hamocc/mo_ncout_hamocc.F90 @@ -16,16 +16,16 @@ ! 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_NCWRT_BGC +module mo_ncwrt_bgc implicit none private - public :: NCWRT_BGC + public :: ncwrt_bgc -CONTAINS +contains - SUBROUTINE NCWRT_BGC(iogrp) + subroutine ncwrt_bgc(iogrp) ! ! --- ------------------------------------------- ! --- output routine for HAMOCC diagnostic fields @@ -1410,4 +1410,4 @@ subroutine hamoccvardef(iogrp,timeunits,calendar,cmpflg) end subroutine hamoccvardef -END MODULE MO_NCWRT_BGC +end module mo_ncwrt_bgc diff --git a/hamocc/mo_netcdf_def_vardb.F90 b/hamocc/mo_netcdf_def_vardb.F90 index 38294fcc..e9f212e9 100644 --- a/hamocc/mo_netcdf_def_vardb.F90 +++ b/hamocc/mo_netcdf_def_vardb.F90 @@ -16,88 +16,45 @@ ! 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_NETCDF_DEF_VARDB +module mo_netcdf_def_vardb implicit none private - public :: NETCDF_DEF_VARDB + public :: netcdf_def_vardb -CONTAINS +contains - SUBROUTINE NETCDF_DEF_VARDB & - (kcid,kshort,yshort,kdims,kcdims,kcvarid, & - kunitl,yunit,klong,ylong,pmissing,klabel,kunit) + subroutine netcdf_def_vardb (kcid,kshort,yshort,kdims,kcdims,kcvarid, & + kunitl,yunit,klong,ylong,pmissing,klabel,kunit) ! **************************************************************** + ! Interface to NETCDF routines - define NetCDF variable. ! - ! **** *NETCDF_DEF_VAR* - define NetCDF variable. - ! - ! S.Legutke, *MPI-MaD, HH* 10.10.01 - ! - ! Modified - ! -------- - ! - ! Purpose - ! ------- - ! Interface to NETCDF routines. - ! - ! Method - ! ------- - ! - ! - !** Interface. - ! ---------- - ! - ! *CALL* *NETCDF_DEF_VARDB(kcid,kshort,yshort,kdims,kcdims,kcvarid, - ! kunitl,yunit,klong,ylong,pmissing,klabel,kunit)* - ! - ! - ! ** Interface to calling routine (parameter list): - ! ---------------------------------------------- - ! - ! *INTEGER* *kcid* - file ID. - ! *INTEGER* *kshort* - length of short name. - ! *INTEGER* *kdims* - number of dimensions. - ! *INTEGER* *kcdims* - dimensions. - ! *INTEGER* *kcvarid* - variable ID. - ! *INTEGER* *kunitl* - length of unit string. - ! *INTEGER* *klong* - length of long name. - ! *INTEGER* *klabel* - label for abort identification. - ! *INTEGER* *kunit* - stdout unit. - ! *REAL* *pmissing* - missing value. - ! *CHARACTER* *yshort* - short name. - ! *CHARACTER* *yunit* - unit string. - ! *CHARACTER* *ylong* - long name. - ! - ! - ! Externals - ! --------- - ! none. - ! + ! S.Legutke, *MPI-MaD, HH* 10.10.01 ! ************************************************************************** + use netcdf, only: nf90_double,nf90_noerr,nf90_put_att,nf90_def_var use mod_xc, only: mnproc,xchalt use mod_dia, only: iotype - #ifdef PNETCDF #include #include #endif ! Arguments - integer, intent(in) :: kcid - integer, intent(in) :: kshort - integer, intent(in) :: kdims - integer, intent(in) :: kcdims(kdims) - integer, intent(out) :: kcvarid - integer, intent(in) :: kunitl - integer, intent(in) :: klong - integer, intent(in) :: klabel - integer, intent(in) :: kunit - character(len=*), intent(in) :: yshort - character(len=*), intent(in) :: yunit - character(len=*), intent(in) :: ylong + integer, intent(in) :: kcid ! file ID. + integer, intent(in) :: kshort ! length of short name. + integer, intent(in) :: kdims ! number of dimensions. + integer, intent(in) :: kcdims(kdims) ! dimensions. + integer, intent(out) :: kcvarid ! variable ID. + integer, intent(in) :: kunitl ! length of unit string. + integer, intent(in) :: klong ! length of long name. + integer, intent(in) :: klabel ! label for abort identification. + integer, intent(in) :: kunit ! stdout unit. + character(len=*), intent(in) :: yshort ! short name. + character(len=*), intent(in) :: yunit ! unit string. + character(len=*), intent(in) :: ylong ! long name. ! Local variables integer :: k @@ -116,16 +73,16 @@ SUBROUTINE NETCDF_DEF_VARDB & IF(mnproc==1 .AND. IOTYPE==0) THEN ncstat = NF90_DEF_VAR(kcid,yshort(1:kshort),NF90_DOUBLE,kcdims,kcvarid) IF ( ncstat .NE. NF90_NOERR ) THEN - WRITE(kunit,*) 'Problems with definition of NetCDF variable:' - WRITE(kunit,*) 'kcid : ',kcid - WRITE(kunit,*) 'kshort : ',kshort - WRITE(kunit,*) 'yshort(kshort) : ',yshort(1:kshort),'---' - WRITE(kunit,*) 'kdims : ',kdims - WRITE(kunit,*) 'kcdims : ',(kcdims(k),k=1,kdims) - WRITE(kunit,*) 'kcvarid : ',kcvarid - WRITE(ystring(22:24),'(I3)') klabel - WRITE(kunit,*) ystring - CALL xchalt('(netcdf_def_vardb)') + write(kunit,*) 'Problems with definition of NetCDF variable:' + write(kunit,*) 'kcid : ',kcid + write(kunit,*) 'kshort : ',kshort + write(kunit,*) 'yshort(kshort) : ',yshort(1:kshort),'---' + write(kunit,*) 'kdims : ',kdims + write(kunit,*) 'kcdims : ',(kcdims(k),k=1,kdims) + write(kunit,*) 'kcvarid : ',kcvarid + write(ystring(22:24),'(I3)') klabel + write(kunit,*) ystring + call xchalt('(netcdf_def_vardb)') stop '(netcdf_def_vardb)' ENDIF ! @@ -133,14 +90,14 @@ SUBROUTINE NETCDF_DEF_VARDB & ! ncstat = NF90_PUT_ATT(kcid,kcvarid,'units',yunit(1:kunitl)) IF ( ncstat .NE. NF90_NOERR ) THEN - WRITE(kunit,*) 'Problems with definition of unit:' - WRITE(kunit,*) 'kcid : ',kcid - WRITE(kunit,*) 'kcvarid : ',kcvarid - WRITE(kunit,*) 'kunitl : ',kunitl - WRITE(kunit,*) 'yunit(kunitl) : ',yunit(1:kunitl),'---' - WRITE(ystring(22:24),'(I3)') klabel - WRITE(kunit,*) ystring - CALL xchalt('(netcdf_def_vardb)') + write(kunit,*) 'Problems with definition of unit:' + write(kunit,*) 'kcid : ',kcid + write(kunit,*) 'kcvarid : ',kcvarid + write(kunit,*) 'kunitl : ',kunitl + write(kunit,*) 'yunit(kunitl) : ',yunit(1:kunitl),'---' + write(ystring(22:24),'(I3)') klabel + write(kunit,*) ystring + call xchalt('(netcdf_def_vardb)') stop '(netcdf_def_vardb)' ENDIF ! @@ -148,14 +105,14 @@ SUBROUTINE NETCDF_DEF_VARDB & ! ncstat = NF90_PUT_ATT(kcid,kcvarid,'long_name',ylong(1:klong)) IF ( ncstat .NE. NF90_NOERR ) THEN - WRITE(kunit,*) 'Problems with definition of long name:' - WRITE(kunit,*) 'kcid : ',kcid - WRITE(kunit,*) 'kcvarid : ',kcvarid - WRITE(kunit,*) 'klong : ',klong - WRITE(kunit,*) 'ylong(klong) : ',ylong(1:klong),'---' - WRITE(ystring(22:24),'(I3)') klabel - WRITE(kunit,*) ystring - CALL xchalt('(netcdf_def_vardb)') + write(kunit,*) 'Problems with definition of long name:' + write(kunit,*) 'kcid : ',kcid + write(kunit,*) 'kcvarid : ',kcvarid + write(kunit,*) 'klong : ',klong + write(kunit,*) 'ylong(klong) : ',ylong(1:klong),'---' + write(ystring(22:24),'(I3)') klabel + write(kunit,*) ystring + call xchalt('(netcdf_def_vardb)') stop '(netcdf_def_vardb)' ENDIF ! @@ -163,13 +120,13 @@ SUBROUTINE NETCDF_DEF_VARDB & ! ncstat = NF90_PUT_ATT(kcid,kcvarid,'missing_value',pmissing) IF ( ncstat .NE. NF90_NOERR ) THEN - WRITE(kunit,*) 'Problems with definition of missing value:' - WRITE(kunit,*) 'kcid : ',kcid - WRITE(kunit,*) 'kcvarid : ',kcvarid - WRITE(kunit,*) 'pmissing : ',pmissing - WRITE(ystring(22:24),'(I3)') klabel - WRITE(kunit,*) ystring - CALL xchalt('(netcdf_def_vardb)') + write(kunit,*) 'Problems with definition of missing value:' + write(kunit,*) 'kcid : ',kcid + write(kunit,*) 'kcvarid : ',kcvarid + write(kunit,*) 'pmissing : ',pmissing + write(ystring(22:24),'(I3)') klabel + write(kunit,*) ystring + call xchalt('(netcdf_def_vardb)') stop '(netcdf_def_vardb)' ENDIF ELSE IF(IOTYPE==1) THEN @@ -179,16 +136,16 @@ SUBROUTINE NETCDF_DEF_VARDB & ! ncstat = nfmpi_def_var(kcid,yshort(1:kshort),nf_double,kdims,kcdims,kcvarid) IF ( ncstat .NE. NF_NOERR ) THEN - WRITE(kunit,*) 'Problems with definition of NetCDF variable:' - WRITE(kunit,*) 'kcid : ',kcid - WRITE(kunit,*) 'kshort : ',kshort - WRITE(kunit,*) 'yshort(kshort) : ',yshort(1:kshort),'---' - WRITE(kunit,*) 'kdims : ',kdims - WRITE(kunit,*) 'kcdims : ',(kcdims(k),k=1,kdims) - WRITE(kunit,*) 'kcvarid : ',kcvarid - WRITE(ystring(22:24),'(I3)') klabel - WRITE(kunit,*) ystring - CALL xchalt('(pnetcdf_def_vardb)') + write(kunit,*) 'Problems with definition of NetCDF variable:' + write(kunit,*) 'kcid : ',kcid + write(kunit,*) 'kshort : ',kshort + write(kunit,*) 'yshort(kshort) : ',yshort(1:kshort),'---' + write(kunit,*) 'kdims : ',kdims + write(kunit,*) 'kcdims : ',(kcdims(k),k=1,kdims) + write(kunit,*) 'kcvarid : ',kcvarid + write(ystring(22:24),'(I3)') klabel + write(kunit,*) ystring + call xchalt('(pnetcdf_def_vardb)') stop '(pnetcdf_def_vardb)' ENDIF ! @@ -197,14 +154,14 @@ SUBROUTINE NETCDF_DEF_VARDB & clen=len(trim(yunit(1:kunitl))) ncstat = NFMPI_PUT_ATT_TEXT(kcid,kcvarid,'units',clen,yunit(1:kunitl)) IF ( ncstat .NE. NF_NOERR ) THEN - WRITE(kunit,*) 'Problems with definition of unit:' - WRITE(kunit,*) 'kcid : ',kcid - WRITE(kunit,*) 'kcvarid : ',kcvarid - WRITE(kunit,*) 'kunitl : ',kunitl - WRITE(kunit,*) 'yunit(kunitl) : ',yunit(1:kunitl),'---' - WRITE(ystring(22:24),'(I3)') klabel - WRITE(kunit,*) ystring - CALL xchalt('(pnetcdf_def_vardb)') + write(kunit,*) 'Problems with definition of unit:' + write(kunit,*) 'kcid : ',kcid + write(kunit,*) 'kcvarid : ',kcvarid + write(kunit,*) 'kunitl : ',kunitl + write(kunit,*) 'yunit(kunitl) : ',yunit(1:kunitl),'---' + write(ystring(22:24),'(I3)') klabel + write(kunit,*) ystring + call xchalt('(pnetcdf_def_vardb)') stop '(pnetcdf_def_vardb)' ENDIF ! @@ -213,14 +170,14 @@ SUBROUTINE NETCDF_DEF_VARDB & clen=len(trim(ylong(1:klong))) ncstat = NFMPI_PUT_ATT_TEXT(kcid,kcvarid,'long_name',clen,ylong(1:klong)) IF ( ncstat .NE. NF_NOERR ) THEN - WRITE(kunit,*) 'Problems with definition of long name:' - WRITE(kunit,*) 'kcid : ',kcid - WRITE(kunit,*) 'kcvarid : ',kcvarid - WRITE(kunit,*) 'klong : ',klong - WRITE(kunit,*) 'ylong(klong) : ',ylong(1:klong),'---' - WRITE(ystring(22:24),'(I3)') klabel - WRITE(kunit,*) ystring - CALL xchalt('(pnetcdf_def_vardb)') + write(kunit,*) 'Problems with definition of long name:' + write(kunit,*) 'kcid : ',kcid + write(kunit,*) 'kcvarid : ',kcvarid + write(kunit,*) 'klong : ',klong + write(kunit,*) 'ylong(klong) : ',ylong(1:klong),'---' + write(ystring(22:24),'(I3)') klabel + write(kunit,*) ystring + call xchalt('(pnetcdf_def_vardb)') stop '(pnetcdf_def_vardb)' ENDIF ! @@ -229,18 +186,18 @@ SUBROUTINE NETCDF_DEF_VARDB & clen=1 ncstat = NFMPI_PUT_ATT_DOUBLE(kcid,kcvarid,'missing_value',NF_DOUBLE,clen,pmissing) IF ( ncstat .NE. NF_NOERR ) THEN - WRITE(kunit,*) 'Problems with definition of missing value:' - WRITE(kunit,*) 'kcid : ',kcid - WRITE(kunit,*) 'kcvarid : ',kcvarid - WRITE(kunit,*) 'pmissing : ',pmissing - WRITE(ystring(22:24),'(I3)') klabel - WRITE(kunit,*) ystring - CALL xchalt('(pnetcdf_def_vardb)') + write(kunit,*) 'Problems with definition of missing value:' + write(kunit,*) 'kcid : ',kcid + write(kunit,*) 'kcvarid : ',kcvarid + write(kunit,*) 'pmissing : ',pmissing + write(ystring(22:24),'(I3)') klabel + write(kunit,*) ystring + call xchalt('(pnetcdf_def_vardb)') stop '(pnetcdf_def_vardb)' ENDIF #endif ENDIF - END SUBROUTINE NETCDF_DEF_VARDB + end subroutine netcdf_def_vardb -END MODULE MO_NETCDF_DEF_VARDB +end module mo_netcdf_def_vardb diff --git a/hamocc/mo_ocprod.F90 b/hamocc/mo_ocprod.F90 index 455af772..aeabd5f4 100644 --- a/hamocc/mo_ocprod.F90 +++ b/hamocc/mo_ocprod.F90 @@ -17,78 +17,51 @@ ! 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_OCPROD +module mo_ocprod implicit none private - public :: OCPROD + public :: ocprod -CONTAINS +contains - SUBROUTINE OCPROD(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) + subroutine ocprod(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) !****************************************************************************** + ! Biological production, remineralization and particle sinking. + ! compute biological production, settling of debris, and related biogeochemistry ! - ! OCPROD - biological production, remineralization and particle sinking. - ! - ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 - ! - ! Modified - ! -------- - ! S.Legutke, *MPI-MaD, HH* 2010-04-01 - ! - ! J.Schwinger, *GFI, UiB* 2013-04-22 - ! - Corrected bug in light penetration formulation - ! - Cautious code clean-up - ! - ! J.Tjiputra, *UNI-RESEARCH* 2015-11-25 - ! - Implemented natural DIC/ALK/CALC - ! - ! I.Kriest, *GEOMAR* 2016-08-11 - ! - Modified stoichiometry for denitrification (affects NO3, N2, Alk) - ! - ! J.Schwinger, *UNI-RESEARCH* 2017-08-30 - ! - Removed split of the layer that only partly falls into the - ! euphotic zone. Loops are now calculated over - ! (1) layers that are completely or partly in the euphotoc zone - ! (2) layers that do not lie within the euphotic zone. - ! - Moved the accumulation of global fields for output to routine - ! hamocc4bgc. The accumulation of local fields has been moved to - ! the end of this routine. - ! - ! A.Moree, *GFI, Bergen* 2018-04-12 - ! - new version of carbon isotope code - ! - ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 - ! - moved accumulation of all output fields to seperate subroutine, - ! related code-restructuring - ! - added sediment bypass preprocessor option and related code - ! - ! J.Schwinger, *NORCE Climate, Bergen* 2020-05-29 - ! - Cleaned up parameter list - ! - Dust deposition field now passed as an argument - ! - ! Purpose - ! ------- - ! compute biological production, settling of debris, and related - ! biogeochemistry - ! - ! - ! - ! Parameter list: - ! --------------- - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. - ! *INTEGER* *kbnd* - nb of halo grid points - ! *REAL* *pdlxp* - size of scalar grid cell (1st dimension) [m]. - ! *REAL* *pdlyp* - size of scalar grid cell (2nd dimension) [m]. - ! *REAL* *pddpo* - size of scalar grid cell (3rd dimension) [m]. - ! *REAL* *omask* - land/ocean mask (1=ocean) - ! *REAL* *ptho* - potential temperature [deg C]. + ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 + ! Modified + ! S.Legutke, *MPI-MaD, HH* 2010-04-01 + ! J.Schwinger, *GFI, UiB* 2013-04-22 + ! - Corrected bug in light penetration formulation + ! - Cautious code clean-up + ! J.Tjiputra, *UNI-RESEARCH* 2015-11-25 + ! - Implemented natural DIC/ALK/CALC + ! I.Kriest, *GEOMAR* 2016-08-11 + ! - Modified stoichiometry for denitrification (affects NO3, N2, Alk) + ! J.Schwinger, *UNI-RESEARCH* 2017-08-30 + ! - Removed split of the layer that only partly falls into the + ! euphotic zone. Loops are now calculated over + ! (1) layers that are completely or partly in the euphotoc zone + ! (2) layers that do not lie within the euphotic zone. + ! - Moved the accumulation of global fields for output to routine + ! hamocc4bgc. The accumulation of local fields has been moved to + ! the end of this routine. + ! A.Moree, *GFI, Bergen* 2018-04-12 + ! - new version of carbon isotope code + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - moved accumulation of all output fields to seperate subroutine, + ! related code-restructuring + ! - added sediment bypass preprocessor option and related code ! + ! J.Schwinger, *NORCE Climate, Bergen* 2020-05-29 + ! - Cleaned up parameter list + ! - Dust deposition field now passed as an argument !****************************************************************************** + use mod_xc, only: mnproc use mo_carbch, only: ocetra,satoxy,hi,co2star use mo_sedmnt, only: prcaca,produs,prorca,silpro,pror13,pror14,prca13,prca14 @@ -116,16 +89,19 @@ SUBROUTINE OCPROD(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) use mo_clim_swa, only: swa_clim use mo_inventory_bgc, only: inventory_bgc - ! Arguments - integer, intent(in) :: kpie,kpje,kpke,kbnd - real, intent(in) :: pdlxp(kpie,kpje),pdlyp(kpie,kpje) - real, intent(in) :: pddpo(kpie,kpje,kpke) - real, intent(in) :: omask(kpie,kpje) - real, intent(in) :: ptho(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) + integer, intent(in) :: kpie ! 1st dimension of model grid. + integer, intent(in) :: kpje ! 2nd dimension of model grid. + integer, intent(in) :: kpke ! 3rd (vertical) dimension of model grid. + integer, intent(in) :: kbnd ! nb of halo grid points + real, intent(in) :: pdlxp(kpie,kpje) ! size of scalar grid cell (1st dimension) [m]. + real, intent(in) :: pdlyp(kpie,kpje) ! size of scalar grid cell (2nd dimension) [m]. + real, intent(in) :: pddpo(kpie,kpje,kpke) ! size of scalar grid cell (3rd dimension) [m]. + real, intent(in) :: omask(kpie,kpje) ! land/ocean mask (1=ocean) + real, intent(in) :: ptho(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) ! potential temperature [deg C]. real, intent(in) :: pi_ph(kpie,kpje) - ! Local varaibles + ! Local variables integer, parameter :: nsinkmax = 12 integer :: i,j,k,l integer :: is,kdonor @@ -1449,4 +1425,4 @@ SUBROUTINE OCPROD(kpie,kpje,kpke,kbnd,pdlxp,pdlyp,pddpo,omask,ptho,pi_ph) end subroutine ocprod -END MODULE MO_OCPROD +end module mo_ocprod diff --git a/hamocc/mo_param1_bgc.F90 b/hamocc/mo_param1_bgc.F90 index b62c475a..72a6dbb1 100644 --- a/hamocc/mo_param1_bgc.F90 +++ b/hamocc/mo_param1_bgc.F90 @@ -16,35 +16,27 @@ ! 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_param1_bgc -MODULE mo_param1_bgc !****************************************************************************** - ! - ! MODULE mo_param1_bgc - bgc tracer parameters. + ! bgc tracer parameters. + ! - To facilitate easier use of 'only-lists' in use statements, make indices + ! always defined also in case they are inside a #ifdef directive. + ! - definition of indices in tracer arrays ! ! 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 - ! 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_cisonew, use_PBGC_OCNP_TIMESTEP, use_PBGC_CK_TIMESTEP, & + use_FB_BGC_OCE, use_BOXATM, use_sedbypass implicit none 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) + 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 @@ -437,5 +429,4 @@ subroutine init_indices() 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 f4cf03d1..feaf703e 100644 --- a/hamocc/mo_param_bgc.F90 +++ b/hamocc/mo_param_bgc.F90 @@ -18,58 +18,54 @@ ! along with BLOM. If not, see https://www.gnu.org/licenses/. module mo_param_bgc + !****************************************************************************** - ! ! BELEG_PARM - now mo_param_bgc - initialize bgc parameters. + ! - set bgc parameter values. ! - ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 + ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 ! - ! Modified - ! -------- - ! J.Schwinger, *NORCE Climate, Bergen* 2020-05-19 + ! Modified + ! J.Schwinger, *NORCE Climate, Bergen* 2020-05-19 ! -split the original BELEG_BGC in two parts, BELEG_PARM and BELEG_VARS - ! jmaerz + ! jmaerz ! - rename beleg_parm to mo_param_bgc - ! - ! Purpose - ! ------- - ! - set bgc parameter values. - ! - ! - ! Parameter list: - ! --------------- - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! !****************************************************************************** use mo_carbch, only: atm_co2 - use mo_control_bgc, only: io_stdo_bgc,bgc_namelist,use_AGG,use_natDIC,use_BROMO,use_cisonew,use_WLIN,use_FB_BGC_OCE, & - & do_ndep,do_oalk,do_rivinpt,do_sedspinup,l_3Dvarsedpor,use_BOXATM,use_CFC,use_PBGC_CK_TIMESTEP, & - & use_sedbypass,with_dmsph,use_PBGC_OCNP_TIMESTEP,ocn_co2_type + use mo_control_bgc, only: io_stdo_bgc,bgc_namelist,use_AGG,use_natDIC, & + use_BROMO,use_cisonew,use_WLIN,use_FB_BGC_OCE, & + do_ndep,do_oalk,do_rivinpt,do_sedspinup,l_3Dvarsedpor, & + use_BOXATM,use_CFC,use_PBGC_CK_TIMESTEP, & + use_sedbypass,with_dmsph,use_PBGC_OCNP_TIMESTEP,ocn_co2_type use mod_xc, only: mnproc implicit none - private - !--------------------------------------------------------------------------------------------------------------------------------- - !--------------------------------------------------------------------------------------------------------------------------------- - !Model parameters - public :: ini_parambgc + ! Routines + public :: ini_parambgc + private :: ini_aggregation + private :: read_bgcnamelist + private :: calc_param_atm + private :: calc_param_biol + private :: rates_2_timestep + + ! Model parameters public :: ro2ut,rcar,rnit,rnoi,riron,rdnit0,rdnit1,rdnit2,rdn2o1,rdn2o2,atm_n2,atm_o2,atm_co2_nat,atm_bromo,re1312, & - re14to,prei13,prei14,ctochl,atten_w,atten_c,atten_uv,atten_f,fetune,perc_diron,fesoly,relaxfe,phytomi,pi_alpha,bkphy, & - dyphy,bluefix,tf2,tf1,tf0,tff,bifr13,bifr14,c14_t_half,rbro,fbro1,fbro2,grami,bkzoo,grazra,spemor,gammap,gammaz,ecan, & - zinges,epsher,bkopal,rcalc,ropal,calmax,remido,drempoc,dremopal,dremn2o,dremsul,wpoc,wcal,wopal,wmin,wmax,wlin, & - dustd1,dustd2,dustd3,dustsink,wdust,SinkExp, FractDim, Stick, cellmass, cellsink, fsh, fse,alow1, alow2,alow3,alar1, & - alar2,alar3,TSFac,TMFac,vsmall,safe,pupper,plower,zdis,nmldmin,beta13,alpha14,atm_c13,atm_c14,c14fac,c14dec, & - sedict,silsat,disso_poc,disso_sil,disso_caco3,sed_denit,calcwei,opalwei,orgwei,calcdens,opaldens,orgdens,claydens, & - dmsp1,dmsp2,dmsp3,dmsp4,dmsp5,dmsp6,dms_gamma + re14to,prei13,prei14,ctochl,atten_w,atten_c,atten_uv,atten_f,fetune,perc_diron,fesoly,relaxfe,phytomi,pi_alpha,bkphy, & + dyphy,bluefix,tf2,tf1,tf0,tff,bifr13,bifr14,c14_t_half,rbro,fbro1,fbro2,grami,bkzoo,grazra,spemor,gammap,gammaz,ecan, & + zinges,epsher,bkopal,rcalc,ropal,calmax,remido,drempoc,dremopal,dremn2o,dremsul,wpoc,wcal,wopal,wmin,wmax,wlin, & + dustd1,dustd2,dustd3,dustsink,wdust,SinkExp, FractDim, Stick, cellmass, cellsink, fsh, fse,alow1, alow2,alow3,alar1, & + alar2,alar3,TSFac,TMFac,vsmall,safe,pupper,plower,zdis,nmldmin,beta13,alpha14,atm_c13,atm_c14,c14fac,c14dec, & + sedict,silsat,disso_poc,disso_sil,disso_caco3,sed_denit,calcwei,opalwei,orgwei,calcdens,opaldens,orgdens,claydens, & + dmsp1,dmsp2,dmsp3,dmsp4,dmsp5,dmsp6,dms_gamma !................................................................................................................................. !................................................................................................................................. ! Stoichiometry and fixed parameters !................................................................................................................................. + ! extended redfield ratio declaration ! Note: stoichiometric ratios are based on Takahashi etal. (1985) ! P:N:C:-O2 + 1:16:122:172 @@ -296,22 +292,21 @@ subroutine ini_parambgc(kpie,kpje) ! adjust rates to 'per time step' ! Eventually write out the used parameters to the log file ! + ! Arguments + integer, intent(in) :: kpie ! 1st dimension of model grid. + integer, intent(in) :: kpje ! 2nd dimension of model grid. - implicit none - - INTEGER, intent(in) :: kpie,kpje - - call ini_param_biol() ! initialize biological parameters + call ini_param_biol() ! initialize biological parameters if (use_AGG) then - call ini_aggregation() ! Initialize aggregation module of Iris Kriest (no NML read thus far) + call ini_aggregation() ! Initialize aggregation module of Iris Kriest (no NML read thus far) endif - call read_bgcnamelist() ! read the BGCPARAMS namelist - call calc_param_atm() ! calculate atmospheric parameters after updating parameters via nml - call calc_param_biol() ! potentially readjust namlist parameter-dependent parameters - call rates_2_timestep() ! Converting rates from /d... to /dtb + call read_bgcnamelist() ! read the BGCPARAMS namelist + call calc_param_atm() ! calculate atmospheric parameters after updating parameters via nml + call calc_param_biol() ! 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.. + call write_parambgc() ! write out used parameters and calculate back rates from /dtb to /d.. end subroutine ini_parambgc !--------------------------------------------------------------------------------------------------------------------------------- @@ -340,7 +335,6 @@ subroutine ini_param_biol() ! BEFORE reading the namelist: ! Default parameters that depend on use case ! - !******************************************************************** ! Zooplankton parameters !******************************************************************** @@ -382,8 +376,9 @@ subroutine read_bgcnamelist() ! 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, & + namelist /bgcparams/ bkphy,dyphy,bluefix,bkzoo,grazra,spemor,gammap,gammaz, & + ecan,zinges,epsher,bkopal,rcalc,ropal, & + remido,drempoc,dremopal,dremn2o,dremsul,fetune,relaxfe, & wmin,wmax,wlin,wpoc,wcal,wopal open (newunit=iounit, file=bgc_namelist, status='old',action='read') @@ -410,9 +405,9 @@ subroutine calc_param_biol() perc_diron = fetune * 0.035 * 0.01 / 55.85 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) !m/d + dustsink = (9.81 * 86400. / 18. & ! g * sec per day / 18. + * (claydens - 1025.) / 1.567 * 1000. & ! excess density / dyn. visc. + * dustd2 * 1.e-4) ! m/d end subroutine calc_param_biol @@ -553,120 +548,120 @@ subroutine write_parambgc() dtbgcinv = 1./dtbgc IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*) '****************************************************************' - WRITE(io_stdo_bgc,*) '* ' - WRITE(io_stdo_bgc,*) '* Configuration: ' - WRITE(io_stdo_bgc,*) '* use_BROMO = ',use_BROMO - WRITE(io_stdo_bgc,*) '* use_AGG = ',use_AGG - WRITE(io_stdo_bgc,*) '* use_WLIN = ',use_WLIN - WRITE(io_stdo_bgc,*) '* use_natDIC = ',use_natDIC - WRITE(io_stdo_bgc,*) '* use_CFC = ',use_CFC - WRITE(io_stdo_bgc,*) '* use_cisonew = ',use_cisonew - WRITE(io_stdo_bgc,*) '* use_PBGC_OCNP_TIMESTEP = ',use_PBGC_OCNP_TIMESTEP - WRITE(io_stdo_bgc,*) '* use_PBGC_CK_TIMESTEP = ',use_PBGC_CK_TIMESTEP - WRITE(io_stdo_bgc,*) '* use_FB_BGC_OCE BROMO = ',use_FB_BGC_OCE - WRITE(io_stdo_bgc,*) '* use_BOXATM = ',use_BOXATM - WRITE(io_stdo_bgc,*) '* use_sedbypass = ',use_sedbypass - WRITE(io_stdo_bgc,*) '* ocn_co2_type = ',ocn_co2_type - WRITE(io_stdo_bgc,*) '* do_ndep = ',do_ndep - WRITE(io_stdo_bgc,*) '* do_rivinpt = ',do_rivinpt - WRITE(io_stdo_bgc,*) '* do_oalk = ',do_oalk - WRITE(io_stdo_bgc,*) '* with_dmsph = ',with_dmsph - WRITE(io_stdo_bgc,*) '* do_sedspinup = ',do_sedspinup - WRITE(io_stdo_bgc,*) '* l_3Dvarsedpor = ',l_3Dvarsedpor - WRITE(io_stdo_bgc,*) '* ' - WRITE(io_stdo_bgc,*) '* Values of MO_PARAM_BGC variables : ' - WRITE(io_stdo_bgc,*) '* atm_co2 = ',atm_co2 + write(io_stdo_bgc,*) '****************************************************************' + write(io_stdo_bgc,*) '* ' + write(io_stdo_bgc,*) '* Configuration: ' + write(io_stdo_bgc,*) '* use_BROMO = ',use_BROMO + write(io_stdo_bgc,*) '* use_AGG = ',use_AGG + write(io_stdo_bgc,*) '* use_WLIN = ',use_WLIN + write(io_stdo_bgc,*) '* use_natDIC = ',use_natDIC + write(io_stdo_bgc,*) '* use_CFC = ',use_CFC + write(io_stdo_bgc,*) '* use_cisonew = ',use_cisonew + write(io_stdo_bgc,*) '* use_PBGC_OCNP_TIMESTEP = ',use_PBGC_OCNP_TIMESTEP + write(io_stdo_bgc,*) '* use_PBGC_CK_TIMESTEP = ',use_PBGC_CK_TIMESTEP + write(io_stdo_bgc,*) '* use_FB_BGC_OCE BROMO = ',use_FB_BGC_OCE + write(io_stdo_bgc,*) '* use_BOXATM = ',use_BOXATM + write(io_stdo_bgc,*) '* use_sedbypass = ',use_sedbypass + write(io_stdo_bgc,*) '* ocn_co2_type = ',ocn_co2_type + write(io_stdo_bgc,*) '* do_ndep = ',do_ndep + write(io_stdo_bgc,*) '* do_rivinpt = ',do_rivinpt + write(io_stdo_bgc,*) '* do_oalk = ',do_oalk + write(io_stdo_bgc,*) '* with_dmsph = ',with_dmsph + write(io_stdo_bgc,*) '* do_sedspinup = ',do_sedspinup + write(io_stdo_bgc,*) '* l_3Dvarsedpor = ',l_3Dvarsedpor + write(io_stdo_bgc,*) '* ' + write(io_stdo_bgc,*) '* Values of MO_PARAM_BGC variables : ' + 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 + 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,*) '* phytomi = ',phytomi - WRITE(io_stdo_bgc,*) '* grami = ',grami - WRITE(io_stdo_bgc,*) '* remido = ',remido*dtbinv - WRITE(io_stdo_bgc,*) '* dyphy = ',dyphy*dtbinv - WRITE(io_stdo_bgc,*) '* zinges = ',zinges - WRITE(io_stdo_bgc,*) '* epsher = ',epsher - WRITE(io_stdo_bgc,*) '* grazra = ',grazra*dtbinv - 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,*) '* 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,*) '* 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,*) '* rnit = ',rnit - WRITE(io_stdo_bgc,*) '* rnoi = ',rnoi - WRITE(io_stdo_bgc,*) '* rdnit0 = ',rdnit0 - WRITE(io_stdo_bgc,*) '* rdnit1 = ',rdnit1 - WRITE(io_stdo_bgc,*) '* rdnit2 = ',rdnit2 - WRITE(io_stdo_bgc,*) '* rdn2o1 = ',rdn2o1 - WRITE(io_stdo_bgc,*) '* rdn2o2 = ',rdn2o2 - WRITE(io_stdo_bgc,*) '* rcalc = ',rcalc - WRITE(io_stdo_bgc,*) '* ropal = ',ropal - WRITE(io_stdo_bgc,*) '* ctochl = ',ctochl - WRITE(io_stdo_bgc,*) '* atten_w = ',atten_w - WRITE(io_stdo_bgc,*) '* atten_c = ',atten_c - WRITE(io_stdo_bgc,*) '* atten_f = ',atten_f - WRITE(io_stdo_bgc,*) '* atten_uv = ',atten_uv - WRITE(io_stdo_bgc,*) '* fetune = ',fetune - WRITE(io_stdo_bgc,*) '* perc_diron = ',perc_diron - WRITE(io_stdo_bgc,*) '* riron = ',riron - WRITE(io_stdo_bgc,*) '* fesoly = ',fesoly - WRITE(io_stdo_bgc,*) '* relaxfe = ',relaxfe*dtbinv - WRITE(io_stdo_bgc,*) '* dmsp1 = ',dmsp1 - WRITE(io_stdo_bgc,*) '* dmsp2 = ',dmsp2 - WRITE(io_stdo_bgc,*) '* dmsp3 = ',dmsp3 - WRITE(io_stdo_bgc,*) '* dmsp4 = ',dmsp4 - WRITE(io_stdo_bgc,*) '* dmsp5 = ',dmsp5 - WRITE(io_stdo_bgc,*) '* dmsp6 = ',dmsp6 + 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 + write(io_stdo_bgc,*) '* dyphy = ',dyphy*dtbinv + write(io_stdo_bgc,*) '* zinges = ',zinges + write(io_stdo_bgc,*) '* epsher = ',epsher + write(io_stdo_bgc,*) '* grazra = ',grazra*dtbinv + 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,*) '* 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,*) '* 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,*) '* rnit = ',rnit + write(io_stdo_bgc,*) '* rnoi = ',rnoi + write(io_stdo_bgc,*) '* rdnit0 = ',rdnit0 + write(io_stdo_bgc,*) '* rdnit1 = ',rdnit1 + write(io_stdo_bgc,*) '* rdnit2 = ',rdnit2 + write(io_stdo_bgc,*) '* rdn2o1 = ',rdn2o1 + write(io_stdo_bgc,*) '* rdn2o2 = ',rdn2o2 + write(io_stdo_bgc,*) '* rcalc = ',rcalc + write(io_stdo_bgc,*) '* ropal = ',ropal + write(io_stdo_bgc,*) '* ctochl = ',ctochl + write(io_stdo_bgc,*) '* atten_w = ',atten_w + write(io_stdo_bgc,*) '* atten_c = ',atten_c + write(io_stdo_bgc,*) '* atten_f = ',atten_f + write(io_stdo_bgc,*) '* atten_uv = ',atten_uv + write(io_stdo_bgc,*) '* fetune = ',fetune + write(io_stdo_bgc,*) '* perc_diron = ',perc_diron + write(io_stdo_bgc,*) '* riron = ',riron + write(io_stdo_bgc,*) '* fesoly = ',fesoly + write(io_stdo_bgc,*) '* relaxfe = ',relaxfe*dtbinv + write(io_stdo_bgc,*) '* dmsp1 = ',dmsp1 + write(io_stdo_bgc,*) '* dmsp2 = ',dmsp2 + write(io_stdo_bgc,*) '* dmsp3 = ',dmsp3 + write(io_stdo_bgc,*) '* dmsp4 = ',dmsp4 + write(io_stdo_bgc,*) '* dmsp5 = ',dmsp5 + write(io_stdo_bgc,*) '* dmsp6 = ',dmsp6 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 + 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 (use_WLIN .and. .not. use_AGG) then - WRITE(io_stdo_bgc,*) '* wmin = ',wmin*dtbinv - WRITE(io_stdo_bgc,*) '* wmax = ',wmax*dtbinv - WRITE(io_stdo_bgc,*) '* wlin = ',wlin*dtbinv + write(io_stdo_bgc,*) '* wmin = ',wmin*dtbinv + write(io_stdo_bgc,*) '* wmax = ',wmax*dtbinv + write(io_stdo_bgc,*) '* wlin = ',wlin*dtbinv endif if (.not. use_AGG) then - WRITE(io_stdo_bgc,*) '* dustd1 = ',dustd1 - WRITE(io_stdo_bgc,*) '* dustd2 = ',dustd2 - WRITE(io_stdo_bgc,*) '* dustsink = ',dustsink*dtbinv - WRITE(io_stdo_bgc,*) '* wdust = ',wdust*dtbinv + write(io_stdo_bgc,*) '* dustd1 = ',dustd1 + write(io_stdo_bgc,*) '* dustd2 = ',dustd2 + write(io_stdo_bgc,*) '* dustsink = ',dustsink*dtbinv + write(io_stdo_bgc,*) '* wdust = ',wdust*dtbinv else write(io_stdo_bgc,*) write(io_stdo_bgc,*) '****************************************************************' @@ -703,22 +698,22 @@ subroutine write_parambgc() write(io_stdo_bgc,*) ' dust sinking speed (m/d)', dustsink / dtb write(io_stdo_bgc,*) '****************************************************************' endif - WRITE(io_stdo_bgc,*) '* ' - WRITE(io_stdo_bgc,*) '* Values of MO_PARAM_BGC sediment variables : ' - WRITE(io_stdo_bgc,*) '* sedict = ',sedict * dtbgcinv - WRITE(io_stdo_bgc,*) '* disso_poc = ',disso_poc * dtbgcinv - WRITE(io_stdo_bgc,*) '* disso_sil = ',disso_sil * dtbgcinv - WRITE(io_stdo_bgc,*) '* disso_caco3 = ',disso_caco3 * dtbgcinv - WRITE(io_stdo_bgc,*) '* sed_denit = ',sed_denit * dtbgcinv - WRITE(io_stdo_bgc,*) '* silsat = ',silsat - WRITE(io_stdo_bgc,*) '* orgwei = ',orgwei - WRITE(io_stdo_bgc,*) '* opalwei = ',opalwei - WRITE(io_stdo_bgc,*) '* calcwei = ',calcwei - WRITE(io_stdo_bgc,*) '* orgdens = ',orgdens - WRITE(io_stdo_bgc,*) '* opaldens = ',opaldens - WRITE(io_stdo_bgc,*) '* calcdens = ',calcdens - WRITE(io_stdo_bgc,*) '* claydens = ',claydens - WRITE(io_stdo_bgc,*) '****************************************************************' + write(io_stdo_bgc,*) '* ' + write(io_stdo_bgc,*) '* Values of MO_PARAM_BGC sediment variables : ' + write(io_stdo_bgc,*) '* sedict = ',sedict * dtbgcinv + write(io_stdo_bgc,*) '* disso_poc = ',disso_poc * dtbgcinv + write(io_stdo_bgc,*) '* disso_sil = ',disso_sil * dtbgcinv + write(io_stdo_bgc,*) '* disso_caco3 = ',disso_caco3 * dtbgcinv + write(io_stdo_bgc,*) '* sed_denit = ',sed_denit * dtbgcinv + write(io_stdo_bgc,*) '* silsat = ',silsat + write(io_stdo_bgc,*) '* orgwei = ',orgwei + write(io_stdo_bgc,*) '* opalwei = ',opalwei + write(io_stdo_bgc,*) '* calcwei = ',calcwei + write(io_stdo_bgc,*) '* orgdens = ',orgdens + write(io_stdo_bgc,*) '* opaldens = ',opaldens + write(io_stdo_bgc,*) '* calcdens = ',calcdens + write(io_stdo_bgc,*) '* claydens = ',claydens + write(io_stdo_bgc,*) '****************************************************************' ENDIF end subroutine write_parambgc diff --git a/hamocc/mo_powach.F90 b/hamocc/mo_powach.F90 index 9452362a..6f13fdfc 100644 --- a/hamocc/mo_powach.F90 +++ b/hamocc/mo_powach.F90 @@ -16,75 +16,44 @@ ! 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_POWACH +module mo_powach implicit none private - public :: POWACH + public :: powach -CONTAINS +contains subroutine powach(kpie,kpje,kpke,kbnd,prho,omask,psao,lspin) !****************************************************************************** - ! - !**** *POWACH* - . - ! - ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 - ! - ! Modified - ! -------- - ! S.Legutke, *MPI-MaD, HH* 10.04.01 - ! - ! Purpose - ! ------- - ! . - ! - ! Method - ! ------- - ! . - ! - !** Interface. - ! ---------- - ! - ! *CALL* *POWACH* - ! - ! *COMMON* *PARAM1_BGC.h* - declaration of ocean/sediment tracer. - ! - !** Interface to ocean model (parameter list): - ! ----------------------------------------- - ! - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. - ! *INTEGER* *kbnd* - nb of halo grid points - ! *REAL* *prho* - seawater density [g/cm^3]. - ! *REAL* *psao* - salinity [psu]. - ! *REAL* *omask* - land/ocean mask - ! - ! Externals - ! --------- - ! none. - ! + ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 + ! Modified: S.Legutke, *MPI-MaD, HH* 10.04.01 !****************************************************************************** + 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, & + use mo_param1_bgc, only: ioxygen,ipowaal,ipowaic,ipowaox,ipowaph,ipowasi,ipown2,ipowno3,& + isilica,isssc12,issso12,issssil, & issster,ks,ipowc13,ipowc14,isssc13,isssc14,issso13,issso14,safediv use mo_carbch, only: co3,keqb,ocetra,sedfluxo use mo_chemcon, only: calcon use mo_param_bgc, only: rnit,ro2ut,disso_sil,silsat,disso_poc,sed_denit,disso_caco3 - use mo_sedmnt, only: porwat,porsol,powtra,produs,prcaca,prorca,seddw,sedhpl,sedlay,silpro,pror13,pror14,prca13,prca14 + use mo_sedmnt, only: porwat,porsol,powtra,produs,prcaca,prorca,& + seddw,sedhpl,sedlay,silpro,pror13,pror14,prca13,prca14 use mo_vgrid, only: kbo,bolay use mo_powadi, only: powadi use mo_carchm, only: carchm_solve use mo_dipowa, only: dipowa ! Arguments - integer, intent(in) :: kpie,kpje,kpke,kbnd - real, intent(in) :: prho(kpie,kpje,kpke) - real, intent(in) :: omask(kpie,kpje) - real, intent(in) :: psao(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) + integer, intent(in) :: kpie ! 1st dimension of model grid. + integer, intent(in) :: kpje ! 2nd dimension of model grid. + integer, intent(in) :: kpke ! 3rd (vertical) dimension of model grid. + integer, intent(in) :: kbnd ! nb of halo grid points + real, intent(in) :: prho(kpie,kpje,kpke) ! seawater density [g/cm^3]. + real, intent(in) :: omask(kpie,kpje) ! salinity [psu]. + real, intent(in) :: psao(1-kbnd:kpie+kbnd,1-kbnd:kpje+kbnd,kpke) ! land/ocean mask logical, intent(in) :: lspin ! Local variables @@ -101,9 +70,9 @@ subroutine powach(kpie,kpje,kpke,kbnd,prho,omask,psao,lspin) real :: ratc13, ratc14, rato13, rato14, poso13, poso14 integer, parameter :: niter = 5 ! number of iterations for carchm_solve - !****************************************************************************** - ! Set array for saving diffusive sediment-water-column fluxes to zero + !******************************************************************** + sedfluxo(:,:,:) = 0.0 ! A LOOP OVER J @@ -374,7 +343,6 @@ subroutine powach(kpie,kpje,kpke,kbnd,prho,omask,psao,lspin) ! Calculate CaCO3-CO3 cycle and simultaneous CO3-undersaturation diffusion !************************************************************************* - ! Compute new powcar, carbonate ion concentration in the sediment ! from changed alkalinity (nitrate production during remineralisation) ! and DIC gain. Iterate 5 times. This changes pH (sedhpl) of sediment. @@ -548,4 +516,4 @@ subroutine powach(kpie,kpje,kpke,kbnd,prho,omask,psao,lspin) end subroutine powach -END MODULE MO_powach +end module mo_powach diff --git a/hamocc/mo_powadi.F90 b/hamocc/mo_powadi.F90 index a3b8b277..4b6b9d65 100644 --- a/hamocc/mo_powadi.F90 +++ b/hamocc/mo_powadi.F90 @@ -17,53 +17,23 @@ ! along with BLOM. If not, see https://www.gnu.org/licenses/. -MODULE MO_POWADI +module mo_powadi implicit none private public :: powadi -CONTAINS +contains - SUBROUTINE POWADI(j,kpie,kpje,solrat,sedb1,sediso,omask) + subroutine powadi(j,kpie,kpje,solrat,sedb1,sediso,omask) !********************************************************************** + ! vertical diffusion with simultaneous dissolution. ! - !**** *POWADI* - vertical diffusion with simultaneous dissolution. - ! - ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 - ! - ! Modified - ! -------- - ! S.Legutke, *MPI-MaD, HH* 10.04.01 - ! - ! Purpose - ! ------- - ! . - ! - ! Method - ! ------- - ! implicit discretisation. - ! - !** Interface. - ! ---------- - ! - ! *CALL* *POWADI(j,solrat,sedb1,sediso)* - ! - ! Input solrat : dissolution rate - ! ===== j : zonal grid index - ! sedb1 : tracer at entry - ! - ! Output: sediso: diffused tracer at exit - ! ====== - ! - ! *PARAMETER* *PARAM1_BGC.h* - declaration of ocean/sediment tracer. - ! - ! Externals - ! --------- - ! none. - ! + ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 + ! Modified: S.Legutke, *MPI-MaD, HH* 10.04.01 + ! Method: implicit discretisation. !********************************************************************** use mo_sedmnt, only: porwah,porwat,seddw,seddzi @@ -72,9 +42,12 @@ SUBROUTINE POWADI(j,kpie,kpje,solrat,sedb1,sediso,omask) use mo_vgrid, only: bolay ! Arguments - integer, intent(in) :: j, kpie, kpje - real, dimension(kpie,ks), intent(in) :: solrat - real, dimension(kpie,0:ks), intent(inout) :: sedb1, sediso + integer, intent(in) :: j ! j zonal grid index + integer, intent(in) :: kpie + integer, intent(in) :: kpje + real, dimension(kpie,ks), intent(in) :: solrat ! dissolution rate + real, dimension(kpie,0:ks), intent(inout) :: sedb1 ! tracer at entry + real, dimension(kpie,0:ks), intent(inout) :: sediso ! diffused tracer at exit real, dimension(kpie,kpje), intent(in) :: omask ! Local variables @@ -82,8 +55,6 @@ SUBROUTINE POWADI(j,kpie,kpje,solrat,sedb1,sediso,omask) real :: asu, alo real, dimension(kpie,0:ks,3) :: tredsy - !********************************************************************** - do k = 1, ks do i = 1, kpie asu = sedict * seddzi(k) * porwah(i,j,k) @@ -142,4 +113,4 @@ SUBROUTINE POWADI(j,kpie,kpje,solrat,sedb1,sediso,omask) end subroutine powadi -END MODULE MO_POWADI +end module mo_powadi diff --git a/hamocc/mo_preftrc.F90 b/hamocc/mo_preftrc.F90 index d61a1617..0204e7b0 100644 --- a/hamocc/mo_preftrc.F90 +++ b/hamocc/mo_preftrc.F90 @@ -15,41 +15,26 @@ ! 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_PREFTRC +module mo_preftrc implicit none private - public :: PREFTRC + public :: preftrc -CONTAINS +contains - SUBROUTINE PREFTRC(kpie,kpje,omask) + subroutine preftrc(kpie,kpje,omask) !**************************************************************** + ! update preformed tracers in the mixed layer. + ! Preformed tracers are set to the value of their full counterparts + ! in the mixed layer. ! - !**** *PREFTRC* - update preformed tracers in the mixed layer. - ! - ! J. Tjiputra, J.Schwinger, *BCCR, Bergen* 2015-01-23 - ! - ! Modified - ! -------- - ! J.Tjiputra, *Uni Research, Bergen* 2018-04-12 - ! - added preformed DIC tracer - ! - ! - ! Method - ! ------- - ! Preformed tracers are set to the value of their full counterparts - ! in the mixed layer. - ! - ! - !** Interface to ocean model (parameter list): - ! ----------------------------------------- - ! - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! + ! J. Tjiputra, J.Schwinger, *BCCR, Bergen* 2015-01-23 + ! Modified + ! J.Tjiputra, *Uni Research, Bergen* 2018-04-12 + ! - added preformed DIC tracer !************************************************************************** use mo_carbch, only: ocetra @@ -57,7 +42,8 @@ SUBROUTINE PREFTRC(kpie,kpje,omask) use mo_vgrid, only: kmle ! Arguments - integer :: kpie,kpje + integer :: kpie ! 1st dimension of model grid. + integer :: kpje ! 2nd dimension of model grid. real :: omask(kpie,kpje) ! Local variables @@ -74,7 +60,6 @@ SUBROUTINE PREFTRC(kpie,kpje,omask) enddo enddo + end subroutine preftrc - END SUBROUTINE PREFTRC - -END MODULE MO_PREFTRC +end module mo_preftrc diff --git a/hamocc/mo_profile_gd.F90 b/hamocc/mo_profile_gd.F90 index 396bef92..0bb4fd44 100644 --- a/hamocc/mo_profile_gd.F90 +++ b/hamocc/mo_profile_gd.F90 @@ -16,39 +16,32 @@ ! along with BLOM. If not, see https://www.gnu.org/licenses/. -MODULE MO_PROFILE_GD +module mo_profile_gd implicit none private - public :: PROFILE_GD + public :: profile_gd -CONTAINS +contains - SUBROUTINE PROFILE_GD(kpie,kpje,kpke,kbnd,pglon,pglat,omask) + subroutine profile_gd(kpie,kpje,kpke,kbnd,pglon,pglat,omask) !******************************************************************************* - ! J.Schwinger, *Gfi, Bergen* 2011-05-19 - ! - ! Modified - ! -------- - ! J.Schwinger, *Uni Climate, BCCR* 2017-07-07 - ! - moved conversion from mumol to mol to mod_gdata_read - ! - changed linear interpolation from data-levels to model levels to propper - ! mapping of data profile to model-levels - ! - ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 - ! - adaptions for reading c-isotope initial values as d13C and d14C - ! - ! Purpose - ! ------- - ! - initialise HAMOCC fields with gridded (1x1 deg) WOA and GLODAP - ! data using the module mo_Gdata_read. Note that the routine get_profile - ! returns the mean of all data profiles within a rectangular region - ! ("smoothing region") of dxy x dxy degrees extent, where dxy is an - ! adjustable parameter. - ! + ! Initialise HAMOCC fields with gridded (1x1 deg) WOA and GLODAP + ! data using the module mo_Gdata_read. Note that the routine get_profile + ! returns the mean of all data profiles within a rectangular region + ! ("smoothing region") of dxy x dxy degrees extent, where dxy is an + ! adjustable parameter. ! + ! J.Schwinger, *Gfi, Bergen* 2011-05-19 + ! Modified + ! J.Schwinger, *Uni Climate, BCCR* 2017-07-07 + ! - moved conversion from mumol to mol to mod_gdata_read + ! - changed linear interpolation from data-levels to model levels to propper + ! mapping of data profile to model-levels + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - adaptions for reading c-isotope initial values as d13C and d14C !******************************************************************************* use mod_xc, only: xchalt @@ -183,7 +176,6 @@ SUBROUTINE PROFILE_GD(kpie,kpje,kpke,kbnd,pglon,pglat,omask) enddo ! Loop over fields - !******************************************************************************** - END SUBROUTINE profile_gd + end subroutine profile_gd -END MODULE MO_PROFILE_GD +end module mo_profile_gd diff --git a/hamocc/mo_read_fedep.F90 b/hamocc/mo_read_fedep.F90 index cbaff598..44d3caa2 100644 --- a/hamocc/mo_read_fedep.F90 +++ b/hamocc/mo_read_fedep.F90 @@ -19,69 +19,38 @@ module mo_read_fedep !****************************************************************************** - ! - ! MODULE mo_read_fedep - routines for reading iron deposition data - ! + ! Routines for reading iron deposition data + ! Declaration, memory allocation, and routines related to reading iron + ! deposition input data ! ! J.Schwinger, *NORCE Climate, Bergen* 2020-05-27 - ! ! Modified - ! -------- ! J. Schwinger, *NORCE climate, Bergen* 2022-06-02 ! -revise structure of this module, split into a module for reading the ! data (mo_read_fedep) and a module that applies the fluxes in core ! hamocc (mo_apply_fedep) - ! - ! Purpose - ! ------- - ! Declaration, memory allocation, and routines related to reading iron - ! deposition input data - ! - ! Description: - ! ------------ - ! Public routines and variable of this module: - ! - ! -subroutine ini_read_fedep - ! Initialise the module for reading iron deposition data - ! - ! -subroutine get_fedep - ! Get the iron (dust) deposition for a given month - ! - ! !****************************************************************************** - implicit none + implicit none private - public :: ini_read_fedep,get_fedep,fedepfile - ! File name (incl. full path) for input data, set through namelist - ! in hamocc_init.F - character(len=512), save :: fedepfile='' + public :: ini_read_fedep ! Initialise the module for reading iron deposition data + public :: get_fedep ! Get the iron (dust) deposition for a given month + + ! File name (incl. full path) for input data, set through namelist in hamocc_init + character(len=512), public :: fedepfile='' ! Array to store dust deposition flux after reading from file - real, allocatable, save :: dustflx(:,:,:) + real, allocatable, public :: dustflx(:,:,:) contains subroutine ini_read_fedep(kpie,kpje,omask) !****************************************************************************** + ! Initialise the iron deposition module, read in the iron (dust) data set. ! - ! INI_FEDEP - initialise the iron deposition module. - ! - ! - ! J.Schwinger *NORCE Climate, Bergen* 2020-05-19 - ! - ! Purpose - ! ------- - ! Initialise the iron deposition module, read in the iron (dust) data set. - ! - ! Parameter list: - ! --------------- - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! *REAL* *omask* - land/ocean mask (1=ocean) - ! + ! J.Schwinger *NORCE Climate, Bergen* 2020-05-19 !****************************************************************************** use netcdf, only: nf90_noerr,nf90_nowrite,nf90_close,nf90_open @@ -89,12 +58,10 @@ subroutine ini_read_fedep(kpie,kpje,omask) use mo_control_bgc, only: io_stdo_bgc use mo_read_netcdf_var, only: read_netcdf_var - implicit none - ! Arguments - integer, intent(in) :: kpie - integer, intent(in) :: kpje - real, intent(in) :: omask(kpie,kpje) + integer, intent(in) :: kpie ! 1st dimension of model grid. + integer, intent(in) :: kpje ! 2nd dimension of model grid. + real, intent(in) :: omask(kpie,kpje) ! land/ocean mask (1=ocean) ! Local variables integer :: i,j,l @@ -102,20 +69,20 @@ subroutine ini_read_fedep(kpie,kpje,omask) ! allocate field to hold iron deposition fluxes IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'***************************************************' - WRITE(io_stdo_bgc,*)'iHAMOCC: Initialization of module mo_fedep:' - WRITE(io_stdo_bgc,*)' ' + write(io_stdo_bgc,*)' ' + write(io_stdo_bgc,*)'***************************************************' + write(io_stdo_bgc,*)'iHAMOCC: Initialization of module mo_fedep:' + write(io_stdo_bgc,*)' ' ENDIF IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable dustflx ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : 12' + write(io_stdo_bgc,*)'Memory allocation for variable dustflx ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Third dimension : 12' ENDIF - ALLOCATE (dustflx(kpie,kpje,12),stat=errstat) + allocate (dustflx(kpie,kpje,12),stat=errstat) if(errstat.ne.0) stop 'not enough memory dustflx' dustflx(:,:,:) = 0.0 @@ -123,7 +90,7 @@ subroutine ini_read_fedep(kpie,kpje,omask) IF(mnproc==1) THEN ncstat = NF90_OPEN(trim(fedepfile),NF90_NOWRITE, ncid) IF (ncstat.NE.NF90_NOERR ) THEN - CALL xchalt('(get_dust: Problem with netCDF1)') + call xchalt('(get_dust: Problem with netCDF1)') stop '(get_dust: Problem with netCDF1)' END IF END IF @@ -135,7 +102,7 @@ subroutine ini_read_fedep(kpie,kpje,omask) IF(mnproc==1) THEN ncstat = NF90_CLOSE(ncid) IF ( ncstat .NE. NF90_NOERR ) THEN - CALL xchalt('(get_dust: Problem with netCDF200)') + call xchalt('(get_dust: Problem with netCDF200)') stop '(get_dust: Problem with netCDF200)' END IF END IF @@ -156,43 +123,25 @@ subroutine ini_read_fedep(kpie,kpje,omask) enddo enddo - - RETURN - - !****************************************************************************** end subroutine ini_read_fedep subroutine get_fedep(kpie,kpje,kplmon,dust) + !****************************************************************************** - ! - ! GET_FEDEP - get iron (dust) deposition for current month - ! + ! Get iron (dust) deposition for current month + ! Initialise the iron deposition module, read in the iron (dust) data set. ! ! J.Schwinger *NORCE Climate, Bergen* 2020-05-19 - ! - ! Purpose - ! ------- - ! Initialise the iron deposition module, read in the iron (dust) data set. - ! - ! Parameter list: - ! --------------- - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! *INTEGER* *kplmon* - current month. - ! *REAL* *dust* - dust flux for current month - - ! !****************************************************************************** - integer, intent(in) :: kpie,kpje,kplmon - real, intent(out) :: dust(kpie,kpje) - dust = dustflx(:,:,kplmon) + integer, intent(in) :: kpie ! 1st dimension of model grid + integer, intent(in) :: kpje ! 2nd dimension of model grid + integer, intent(in) :: kplmon ! current month. + real, intent(out) :: dust(kpie,kpje) ! dust flux for current month + dust = dustflx(:,:,kplmon) - !****************************************************************************** end subroutine get_fedep - - !****************************************************************************** end module mo_read_fedep diff --git a/hamocc/mo_read_ndep.F90 b/hamocc/mo_read_ndep.F90 index 6a0ab105..b80ffc2a 100644 --- a/hamocc/mo_read_ndep.F90 +++ b/hamocc/mo_read_ndep.F90 @@ -19,86 +19,54 @@ module mo_read_ndep !****************************************************************************** + ! Routines for reading nitrogen deposition fluxes from netcdf files + ! The routine get_ndep reads nitrogen deposition from file. The n-deposition + ! field is then passed to hamocc4bcm where it is applied to the top-most model + ! layer by a call to apply_ndep (mo_apply_ndep). + ! N deposition is activated through a logical switch 'do_ndep' read from + ! HAMOCC's bgcnml namelist. If N deposition is acitvated, a valid filename + ! (including the full path) needs to be provided via HAMOCC's bgcnml namelist + ! (variable ndepfile). If the input file is not found, an error will be issued. + ! The input data must be already pre-interpolated to the ocean grid. ! - ! S.Gao *Gfi, Bergen* 2017-08-19 - ! + ! S.Gao *Gfi, Bergen* 2017-08-19 ! Modified - ! -------- ! J. Tjiputra, *Uni Research, Bergen* 2017-09-18 ! -add 1 mol [H+], per mol [NO3] deposition, to alkalinity (minus 1 mol) - ! ! J. Schwinger, *Uni Research, Bergen* 2018-04-12 ! -re-organised this module into an initialisation routine and a routine that ! does the deposition; introduced logical switch to activate N deposition. - ! ! J. Schwinger, *NORCE climate, Bergen* 2020-05-27 ! -put reading of a time-slice of n-deposition data into own subroutine ! -removed default file name - ! ! J. Schwinger, *NORCE climate, Bergen* 2022-06-02 ! -revise structure of this module, split into a module for reading the ! data (mo_read_ndep) and a module that applies the fluxes in core ! hamocc (mo_apply_ndep) ! - ! - ! Purpose - ! ------- - ! -Routines for reading nitrogen deposition fluxes from netcdf files - ! - ! - ! Description: - ! ------------ - ! - ! The routine get_ndep reads nitrogen deposition from file. The n-deposition - ! field is then passed to hamocc4bcm where it is applied to the top-most model - ! layer by a call to apply_ndep (mo_apply_ndep). - ! - ! N deposition is activated through a logical switch 'do_ndep' read from - ! HAMOCC's bgcnml namelist. If N deposition is acitvated, a valid filename - ! (including the full path) needs to be provided via HAMOCC's bgcnml namelist - ! (variable ndepfile). If the input file is not found, an error will be issued. - ! The input data must be already pre-interpolated to the ocean grid. - ! - ! -subroutine ini_read_ndep - ! Initialise the module - ! - ! -subroutine get_ndep - ! Read and return n-deposition data for a given month. - ! !****************************************************************************** implicit none private - public :: ini_read_ndep - public :: get_ndep + public :: ini_read_ndep ! Initialise the module + public :: get_ndep ! Read and return n-deposition data for a given month. character(len=512), public :: ndepfile='' real, allocatable :: ndepread(:,:) integer :: startyear,endyear logical :: lini = .false. + integer :: oldmonth=0 contains subroutine ini_read_ndep(kpie,kpje) !****************************************************************************** + ! Initialise the module, check existence of input file, allocate array + ! for reading the data ! - ! S. Gao *Gfi, Bergen* 19.08.2017 - ! - ! Purpose - ! ------- - ! -Initialise the module, check existence of input file, allocate array - ! for reading the data - ! - ! Changes: - ! -------- - ! - ! Parameter list: - ! --------------- - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! + ! S. Gao *Gfi, Bergen* 19.08.2017 !****************************************************************************** use mod_xc, only: mnproc,xchalt @@ -107,10 +75,9 @@ subroutine ini_read_ndep(kpie,kpje) use mod_nctools, only: ncfopn,ncgeti,ncfcls use mo_read_netcdf_var, only: read_netcdf_var - implicit none - ! Arguments - integer, intent(in) :: kpie,kpje + integer, intent(in) :: kpie ! 1st dimension of model grid. + integer, intent(in) :: kpje ! 2nd dimension of model grid. ! Local variables integer :: errstat @@ -129,10 +96,10 @@ subroutine ini_read_ndep(kpie,kpje) if (.not. lini) then IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'***************************************************' - WRITE(io_stdo_bgc,*)'iHAMOCC: Initialization of module mo_read_ndep:' - WRITE(io_stdo_bgc,*)' ' + write(io_stdo_bgc,*)' ' + write(io_stdo_bgc,*)'***************************************************' + write(io_stdo_bgc,*)'iHAMOCC: Initialization of module mo_read_ndep:' + write(io_stdo_bgc,*)' ' ENDIF ! Check if nitrogen deposition file exists. If not, abort. @@ -146,12 +113,12 @@ subroutine ini_read_ndep(kpie,kpje) ! Allocate field to hold N-deposition fluxes IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable ndepread ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable ndepread ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - ALLOCATE (ndepread(kpie,kpje),stat=errstat) + allocate (ndepread(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory ndep' ndepread(:,:) = 0.0 @@ -176,22 +143,9 @@ end subroutine ini_read_ndep subroutine get_ndep(kpie,kpje,kplyear,kplmon,omask,ndep) !****************************************************************************** + ! Read and return CMIP6 n-deposition data for a given month. ! - ! S. Gao *Gfi, Bergen* 19.08.2017 - ! - ! Purpose - ! ------- - ! -Read and return CMIP6 n-deposition data for a given month. - ! - ! Parameter list: - ! --------------- - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! *INTEGER* *kplyear* - current year. - ! *INTEGER* *kplmon* - current month. - ! *REAL* *omask* - land/ocean mask (1=ocean) - ! *REAL* *ndep* - N-deposition field for current year and month - ! + ! S. Gao *Gfi, Bergen* 19.08.2017 !****************************************************************************** use mod_xc, only: mnproc @@ -199,21 +153,21 @@ subroutine get_ndep(kpie,kpje,kplyear,kplmon,omask,ndep) use mo_control_bgc, only: io_stdo_bgc,do_ndep use mo_read_netcdf_var, only: read_netcdf_var - implicit none - ! Arguments - integer, intent(in) :: kpie,kpje,kplyear,kplmon - real, intent(in) :: omask(kpie,kpje) - real, intent(out) :: ndep(kpie,kpje) + integer, intent(in) :: kpie ! 1st dimension of model grid. + integer, intent(in) :: kpje ! 2nd dimension of model grid. + integer, intent(in) :: kplyear ! current year. + integer, intent(in) :: kplmon ! current month. + real, intent(in) :: omask(kpie,kpje) ! land/ocean mask (1=ocean) + real, intent(out) :: ndep(kpie,kpje) ! N-deposition field for current year and month ! local variables - integer :: month_in_file,ncstat,ncid - integer, save :: oldmonth=0 + integer :: month_in_file, ncstat, ncid ! if N-deposition is switched off set ndep to zero and return if (.not. do_ndep) then ndep(:,:) = 0.0 - return + RETURN endif ! read ndep data from file diff --git a/hamocc/mo_read_netcdf_var.F90 b/hamocc/mo_read_netcdf_var.F90 index 26986216..95124a4e 100644 --- a/hamocc/mo_read_netcdf_var.F90 +++ b/hamocc/mo_read_netcdf_var.F90 @@ -15,23 +15,20 @@ ! 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_READ_NETCDF_VAR +module mo_read_netcdf_var implicit none private - public :: READ_NETCDF_VAR + public :: read_netcdf_var -CONTAINS +contains - SUBROUTINE READ_NETCDF_VAR(ncid,desc,arr,klev,time,typeio) + subroutine read_netcdf_var(ncid,desc,arr,klev,time,typeio) !************************************************************************** - ! ! Reads a variable from a NETCDF file and distributes it to all PEs - ! ! The NETCDF File is only accessed by mnproc=1 - ! !************************************************************************** use netcdf, only: nf90_noerr,nf90_inq_varid,nf90_strerror,nf90_get_var @@ -169,6 +166,6 @@ SUBROUTINE READ_NETCDF_VAR(ncid,desc,arr,klev,time,typeio) call xchalt('(read_pnetcdf_var) WRONG IOTYPE') ENDIF - END SUBROUTINE READ_NETCDF_VAR + end subroutine read_netcdf_var -END MODULE MO_READ_NETCDF_VAR +end module mo_read_netcdf_var diff --git a/hamocc/mo_read_oafx.F90 b/hamocc/mo_read_oafx.F90 index c7df6865..31eabff0 100644 --- a/hamocc/mo_read_oafx.F90 +++ b/hamocc/mo_read_oafx.F90 @@ -19,25 +19,7 @@ module mo_read_oafx !****************************************************************************** - ! - ! J.Schwinger *NORCE Climate, Bergen* 2022-08-24 - ! - ! Modified - ! -------- - ! T. Bourgeois, *NORCE climate, Bergen* 2023-01-31 - ! - add ramping-up scenario - ! - add ability to define parameters from BLOM namelist - ! - ! T. Bourgeois, *NORCE climate, Bergen* 2023-02-09 - ! - add ability to use an OA input file - ! - ! Purpose - ! ------- - ! -Routines for reading ocean alkalinization fluxes from netcdf files - ! - ! - ! Description: - ! ------------ + ! Routines for reading ocean alkalinization fluxes from netcdf files ! The routine get_oafx reads a flux of alkalinity from file (or, for simple ! cases, constructs an alkalinity flux field from scratch). The alkalinity ! flux is then passed to hamocc4bcm where it is applied to the top-most model @@ -64,22 +46,27 @@ module mo_read_oafx ! -'file': Read monthly 2D field in kmol ALK m-2 yr-1 from a file ! defined with the variable oalkfile. ! - ! -subroutine ini_read_oafx - ! Initialise the module - ! - ! -subroutine get_oafx - ! Gets the alkalinity flux to apply at a given time. - ! - ! + ! J.Schwinger *NORCE Climate, Bergen* 2022-08-24 + ! Modified: + ! T. Bourgeois, *NORCE climate, Bergen* 2023-01-31 + ! - add ramping-up scenario + ! - add ability to define parameters from BLOM namelist + ! T. Bourgeois, *NORCE climate, Bergen* 2023-02-09 + ! - add ability to use an OA input file !****************************************************************************** implicit none private - public :: ini_read_oafx,get_oafx,oalkscen,oalkfile,thrh_omegaa + ! Routines + + public :: ini_read_oafx ! Initialise the module + public :: get_oafx ! Gets the alkalinity flux to apply at a given time. - character(len=128), protected :: oalkscen ='' - character(len=512), protected :: oalkfile ='' + ! Module variables + + character(len=128), protected, public :: oalkscen ='' + character(len=512), protected, public :: oalkfile ='' real,allocatable, protected :: oalkflx(:,:) integer, protected :: startyear,endyear @@ -93,54 +80,33 @@ module mo_read_oafx ! ramp Linear increase of homogeneous addition from 0 to addalk ! Pmol ALK/yr-1 from year ramp_start to year ramp_end between ! latitude cdrmip_latmin and latitude cdrmip_latmax - ! - ! Values are read from namelist bgcoafx, which overwrites default values set - ! here - real, protected :: addalk = 0.135 ! Pmol alkalinity/yr added in the - ! scenarios. + + ! Values are read from namelist bgcoafx, which overwrites default values set here + real, protected :: addalk = 0.135 ! Pmol alkalinity/yr added in the scenarios. real, protected :: cdrmip_latmax = 70.0 ! Min and max latitude where - real, protected :: cdrmip_latmin = -60.0 ! alkalinity is added according - ! to the CDRMIP protocol. + real, protected :: cdrmip_latmin = -60.0 ! alkalinity is added according to the CDRMIP protocol. integer, protected :: ramp_start = 2025 ! In 'ramp' scenario, start at - integer, protected :: ramp_end = 2035 ! 0 Pmol/yr at ramp_start, and - ! arrive at addalk Pmol/yr in - ! year ramp_end + integer, protected :: ramp_end = 2035 ! 0 Pmol/yr at ramp_start, and arrive at addalk Pmol/yr + ! in year ramp_end ! Parameter used for ALL alkalinization scenarios, read through namelist ! namelist bgcoafx, which overwrites default values set here - real, protected :: thrh_omegaa =-1.0 ! Limit the input of alkalinity by - ! setting alkalinity-flux to zero - ! for grid cells where Omegaa > - ! thrh_omegaa (negative values mean - ! no threshold considered) + ! Limit the input of alkalinity by setting alkalinity-flux to zero + ! for grid cells where Omegaa > thrh_omegaa (negative values mean no threshold considered) + real, protected, public :: thrh_omegaa =-1.0 + logical :: lini = .false. - logical, save :: lini = .false. + integer :: oldmonth=0 contains subroutine ini_read_oafx(kpie,kpje,pdlxp,pdlyp,pglat,omask) !****************************************************************************** + ! Initialise the alkalinization module. ! - ! J.Schwinger *NORCE Climate, Bergen* 2021-11-15 - ! - ! Purpose - ! ------- - ! -Initialise the alkalinization module. - ! - ! Changes: - ! -------- - ! - ! Parameter list: - ! --------------- - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! *REAL* *pdlxp* - size of grid cell (longitudinal) [m]. - ! *REAL* *pdlyp* - size of grid cell (latitudinal) [m]. - ! *REAL* *pglat* - latitude grid cell centres [degree N]. - ! *REAL* *omask* - land/ocean mask. - ! + ! J.Schwinger *NORCE Climate, Bergen* 2021-11-15 !****************************************************************************** use mod_xc, only: xcsum,xchalt,mnproc,nbdy,ips @@ -149,15 +115,13 @@ subroutine ini_read_oafx(kpie,kpje,pdlxp,pdlyp,pglat,omask) use mo_control_bgc, only: io_stdo_bgc,do_oalk,bgc_namelist,get_bgc_namelist use mo_read_netcdf_var, only: read_netcdf_var - implicit none - ! Arguments - integer, intent(in) :: kpie - integer, intent(in) :: kpje - real, intent(in) :: pdlxp(kpie,kpje) - real, intent(in) :: pdlyp(kpie,kpje) - real, intent(in) :: pglat(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy) - real, intent(in) :: omask(kpie,kpje) + integer, intent(in) :: kpie ! 1st dimension of model grid. + integer, intent(in) :: kpje ! 2nd dimension of model grid. + real, intent(in) :: pdlxp(kpie,kpje) ! size of grid cell (longitudinal) [m]. + real, intent(in) :: pdlyp(kpie,kpje) ! size of grid cell (latitudinal) [m]. + real, intent(in) :: pglat(1-nbdy:kpie+nbdy,1-nbdy:kpje+nbdy) ! latitude grid cell centres [degree N]. + real, intent(in) :: omask(kpie,kpje) ! land/ocean mask. ! Local variables integer :: i,j,errstat @@ -194,8 +158,7 @@ subroutine ini_read_oafx(kpie,kpje,pdlxp,pdlyp,pglat,omask) write(io_stdo_bgc,*)' ' endif - if( trim(oalkscen)=='const' .or. trim(oalkscen)=='ramp' .or. & - trim(oalkscen)=='file' ) then + if( trim(oalkscen)=='const' .or. trim(oalkscen)=='ramp' .or. trim(oalkscen)=='file' ) then if(mnproc.eq.1) then write(io_stdo_bgc,*)'Using alkalinization scenario ', trim(oalkscen) @@ -222,7 +185,6 @@ subroutine ini_read_oafx(kpie,kpje,pdlxp,pdlyp,pglat,omask) write(io_stdo_bgc,*)'First dimension : ',kpie write(io_stdo_bgc,*)'Second dimension : ',kpje endif - allocate(oalkflx(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory oalkflx' oalkflx(:,:) = 0.0 @@ -242,7 +204,7 @@ subroutine ini_read_oafx(kpie,kpje,pdlxp,pdlyp,pglat,omask) do j=1,kpje do i=1,kpie if( omask(i,j).gt.0.5 .and. pglat(i,j)cdrmip_latmin ) then + .and. pglat(i,j)>cdrmip_latmin ) then ztmp1(i,j)=ztmp1(i,j)+pdlxp(i,j)*pdlyp(i,j) endif enddo @@ -270,7 +232,7 @@ subroutine ini_read_oafx(kpie,kpje,pdlxp,pdlyp,pglat,omask) do j=1,kpje do i=1,kpie if( omask(i,j).gt.0.5 .and. pglat(i,j)cdrmip_latmin ) then + .and. pglat(i,j)>cdrmip_latmin ) then oalkflx(i,j) = avflx endif enddo @@ -294,33 +256,15 @@ subroutine ini_read_oafx(kpie,kpje,pdlxp,pdlyp,pglat,omask) endif ! not lini - - !****************************************************************************** end subroutine ini_read_oafx subroutine get_oafx(kpie,kpje,kplyear,kplmon,omask,oafx) + !****************************************************************************** + ! Return ocean alkalinization flux. ! - ! J. Schwinger *NORCE Climate, Bergen* 2021-11-15 - ! - ! Purpose - ! ------- - ! -return ocean alkalinization flux. - ! - ! Changes: - ! -------- - ! - ! - ! Parameter list: - ! --------------- - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! *INTEGER* *kplyear* - current year. - ! *INTEGER* *kplmon* - current month. - ! *REAL* *omask* - land/ocean mask (1=ocean) - ! *REAL* *oaflx* - alkalinization flux [kmol m-2 yr-1] - ! + ! J. Schwinger *NORCE Climate, Bergen* 2021-11-15 !****************************************************************************** use mod_xc, only: xchalt,mnproc @@ -329,16 +273,16 @@ subroutine get_oafx(kpie,kpje,kplyear,kplmon,omask,oafx) use mod_time, only: nday_of_year use mo_read_netcdf_var, only: read_netcdf_var - implicit none - ! Arguments - integer, intent(in) :: kpie,kpje,kplyear,kplmon - real, intent(in) :: omask(kpie,kpje) - real, intent(out) :: oafx(kpie,kpje) + integer, intent(in) :: kpie ! 1st dimension of model grid. + integer, intent(in) :: kpje ! 2nd dimension of model grid. + integer, intent(in) :: kplyear ! current year. + integer, intent(in) :: kplmon ! current month. + real, intent(in) :: omask(kpie,kpje) ! land/ocean mask (1=ocean) + real, intent(out) :: oafx(kpie,kpje) ! alkalinization flux [kmol m-2 yr-1] ! local variables - integer :: month_in_file,ncstat,ncid,current_day - integer, save :: oldmonth=0 + integer :: month_in_file,ncstat,ncid,current_day if (.not. do_oalk) then oafx(:,:) = 0.0 @@ -397,10 +341,6 @@ subroutine get_oafx(kpie,kpje,kplyear,kplmon,omask,oafx) endif - !****************************************************************************** end subroutine get_oafx - - - !****************************************************************************** end module mo_read_oafx diff --git a/hamocc/mo_read_pi_ph.F90 b/hamocc/mo_read_pi_ph.F90 index 5d20a849..e9de315e 100644 --- a/hamocc/mo_read_pi_ph.F90 +++ b/hamocc/mo_read_pi_ph.F90 @@ -20,13 +20,23 @@ module mo_read_pi_ph implicit none private - public :: ini_pi_ph,get_pi_ph,pi_ph_file,pi_ph + ! Routines + + public :: ini_pi_ph + public :: get_pi_ph + public :: pi_ph_file + public :: pi_ph + + private :: alloc_pi_ph + private :: alloc_pi_ph_clim + + ! Module variables ! Path to input data, set through namelist in hamocc_init.F character(len=256) :: pi_ph_file = '' ! Length of surface PI pH record from file - ! - Current implementation only support monthly records. + ! Current implementation only support monthly records. integer, parameter :: pi_ph_record = 12 ! surface PI pH climatology @@ -35,23 +45,19 @@ module mo_read_pi_ph ! surface PI pH monthly data real, dimension(:,:), allocatable :: pi_ph -CONTAINS + integer :: oldmonth=0 + +contains subroutine ini_pi_ph(kpie,kpje,omask) - !********************************************************************** - ! PUBLIC SUBROUTINE : INI_PI_PH - ! ! Initialise the PI_PH field from climatology. - !********************************************************************** use mo_control_bgc, only: io_stdo_bgc,with_dmsph use netcdf, only: nf90_noerr,nf90_nowrite,nf90_close,nf90_open use mod_xc, only: mnproc,xchalt use mo_read_netcdf_var, only: read_netcdf_var - implicit none - ! Arguments integer, intent(in) :: kpie integer, intent(in) :: kpje @@ -76,7 +82,7 @@ subroutine ini_pi_ph(kpie,kpje,omask) ncstat = NF90_OPEN(trim(pi_ph_file), NF90_NOWRITE, ncid) write(io_stdo_bgc,*) 'HAMOCC: opening PI_PH climatology file' IF (ncstat.NE.NF90_NOERR ) THEN - CALL xchalt('(ini_pi_ph: Problem with netCDF1)') + call xchalt('(ini_pi_ph: Problem with netCDF1)') stop '(ini_pi_ph: Problem with netCDF1)' END IF END IF @@ -88,7 +94,7 @@ subroutine ini_pi_ph(kpie,kpje,omask) IF(mnproc==1) THEN ncstat = NF90_CLOSE(ncid) IF ( ncstat .NE. NF90_NOERR ) THEN - CALL xchalt('(ini_pi_ph: Problem with netCDF200)') + call xchalt('(ini_pi_ph: Problem with netCDF200)') stop '(ini_pi_ph: Problem with netCDF200)' END IF END IF @@ -109,19 +115,14 @@ subroutine ini_pi_ph(kpie,kpje,omask) end subroutine ini_pi_ph - - !********************************************************************** - ! PUBLIC SUBROUTINE : GET_PI_PH - ! - ! Return PI_PH field for a given month. !********************************************************************** subroutine get_pi_ph(kpie,kpje,kplmon) use mo_control_bgc, only: with_dmsph - implicit none + ! Return PI_PH field for a given month. + ! Arguments integer, intent(in) :: kpie,kpje,kplmon - integer, save :: oldmonth=0 ! Ensure that pi_ph is allocated if(.not. allocated(pi_ph)) call alloc_pi_ph(kpie,kpje) @@ -136,54 +137,47 @@ subroutine get_pi_ph(kpie,kpje,kplmon) end subroutine get_pi_ph - - !********************************************************************** - ! PRIVATE SUBROUTINE : ALLOC_PI_PH - ! - ! Allocate the PI_PH field. !********************************************************************** subroutine alloc_pi_ph(kpie,kpje) use mod_xc, only: mnproc use mo_control_bgc, only: io_stdo_bgc - implicit none + ! Arguments integer, intent(in) :: kpie,kpje - integer :: errstat + ! Local variables + integer :: errstat IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable pi_ph ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable pi_ph ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - ALLOCATE (pi_ph(kpie,kpje),stat=errstat) + allocate (pi_ph(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory pi_ph' pi_ph(:,:) = 0.0 end subroutine alloc_pi_ph - - !********************************************************************** - ! PRIVATE SUBROUTINE : ALLOC_PI_PH_CLIM - ! - ! Allocate the PI_PH_CLIM field. !********************************************************************** subroutine alloc_pi_ph_clim(kpie,kpje) use mod_xc, only: mnproc use mo_control_bgc, only: io_stdo_bgc - implicit none + ! Arguments integer, intent(in) :: kpie,kpje - integer :: errstat + + ! Local variables + integer :: errstat IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable pi_ph_clim ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',pi_ph_record + write(io_stdo_bgc,*)'Memory allocation for variable pi_ph_clim ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Third dimension : ',pi_ph_record ENDIF - ALLOCATE (pi_ph_clim(kpie,kpje,pi_ph_record),stat=errstat) + allocate (pi_ph_clim(kpie,kpje,pi_ph_record),stat=errstat) if(errstat.ne.0) stop 'not enough memory pi_ph_clim' pi_ph_clim(:,:,:) = 0.0 diff --git a/hamocc/mo_read_rivin.F90 b/hamocc/mo_read_rivin.F90 index c0d7289f..349aeedb 100644 --- a/hamocc/mo_read_rivin.F90 +++ b/hamocc/mo_read_rivin.F90 @@ -17,22 +17,9 @@ module mo_read_rivin + !******************************************************************************** - ! - ! S. Gao, *Gfi, Bergen* 19.08.2017 - ! - ! Purpose - ! ------- - ! - Routines for reading riverine nutrient and carbon input data - ! - ! - ! Description: - ! ------------ - ! Public routines and variable of this module: - ! - ! -subroutine ini_read_rivin - ! read gnews riverine nutrient and carbon data - ! + ! Routines for reading riverine nutrient and carbon input data ! ! BLOM_RIVER_NUTRIENTS must be set to TRUE in env_run.xml to activate ! riverine nutrients. @@ -51,93 +38,79 @@ module mo_read_rivin ! 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). ! + ! + ! S. Gao, *Gfi, Bergen* 19.08.2017 ! Changes: - ! -------- ! J. Schwinger, *NORCE climate, Bergen* 2020-05-27 ! - re-structured this module such that riverine input can be passed as an ! argument to iHAMOCC's main routine - ! ! J. Schwinger, *NORCE climate, Bergen* 2022-05-18 ! - re-structured and renamed this module such that reading and application of ! data are seperated into two distinct modules - ! !******************************************************************************** + use dimensions, only: idm,jdm use mod_xc , only: nbdy implicit none - private - public :: ini_read_rivin,rivinfile,rivflx - + ! Routines + public :: ini_read_rivin ! read gnews riverine nutrient and carbon data - ! File name (incl. full path) for input data, set through namelist - ! in hamocc_init.F - character(len=256),save :: rivinfile = '' - real,save,allocatable :: rivflx(:,:,:) ! holds input data as read from file + ! File name (incl. full path) for input data, set through namelist in mo_hamocc_init + character(len=256), public :: rivinfile = '' + real, allocatable, public :: rivflx(:,:,:) ! holds input data as read from file ! arrays for reading riverine inputs on the model grid - real,save,dimension(1-nbdy:idm+nbdy,1-nbdy:jdm+nbdy) :: riv_DIN2d, riv_DIP2d, & - riv_DSI2d, riv_DIC2d, & - riv_idet2d,riv_idoc2d, & - riv_DFe2d + real, dimension(1-nbdy:idm+nbdy,1-nbdy:jdm+nbdy) :: riv_DIN2d + real, dimension(1-nbdy:idm+nbdy,1-nbdy:jdm+nbdy) :: riv_DIP2d + real, dimension(1-nbdy:idm+nbdy,1-nbdy:jdm+nbdy) :: riv_DSI2d + real, dimension(1-nbdy:idm+nbdy,1-nbdy:jdm+nbdy) :: riv_DIC2d + real, dimension(1-nbdy:idm+nbdy,1-nbdy:jdm+nbdy) :: riv_DFe2d + real, dimension(1-nbdy:idm+nbdy,1-nbdy:jdm+nbdy) :: riv_idet2d + real, dimension(1-nbdy:idm+nbdy,1-nbdy:jdm+nbdy) :: riv_idoc2d - !******************************************************************************** contains - - subroutine ini_read_rivin(kpie,kpje,omask) !-------------------------------------------------------------------------------- - ! - ! Purpose: - ! -------- ! Initialise reading of riverine input data (GNEWS 2000) - ! - ! - ! Arguments: - ! ---------- - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! *REAL* *omask* - ocean mask - ! !-------------------------------------------------------------------------------- + use mod_xc, only: mnproc use mod_dia, only: iotype use mod_nctools, only: ncfopn,ncread,ncfcls use mo_control_bgc, only: io_stdo_bgc,do_rivinpt use mo_param1_bgc, only: nriv,irdin,irdip,irsi,iralk,iriron,irdoc,irdet - implicit none - - integer, intent(in) :: kpie,kpje - real, intent(in) :: omask(kpie,kpje) + ! Arguments + integer, intent(in) :: kpie ! 1st dimension of model grid. + integer , intent(in) :: kpje ! 2nd dimension of model grid. + real, intent(in) :: omask(kpie,kpje) ! ocean mask ! local variables integer :: i,j,errstat,dummymask(2) - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'***************************************************' - WRITE(io_stdo_bgc,*)'iHAMOCC: Initialization of module mo_read_rivin:' - WRITE(io_stdo_bgc,*)' ' + write(io_stdo_bgc,*)' ' + write(io_stdo_bgc,*)'***************************************************' + write(io_stdo_bgc,*)'iHAMOCC: Initialization of module mo_read_rivin:' + write(io_stdo_bgc,*)' ' ENDIF ! Allocate field to hold river fluxes IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable rivflx ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',nriv + write(io_stdo_bgc,*)'Memory allocation for variable rivflx ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Third dimension : ',nriv ENDIF - ALLOCATE (rivflx(kpie,kpje,nriv),stat=errstat) + allocate (rivflx(kpie,kpje,nriv),stat=errstat) if(errstat.ne.0) stop 'not enough memory rivflx' rivflx(:,:,:) = 0.0 - ! Return if riverine input is turned off if (.not. do_rivinpt) then if (mnproc.eq.1) then @@ -150,21 +123,18 @@ subroutine ini_read_rivin(kpie,kpje,omask) ! read riverine nutrient fluxes from file if (mnproc.eq.1) then write(io_stdo_bgc,*) '' - write(io_stdo_bgc,*) 'ini_read_rivin: read riverine nutrients from ', & - trim(rivinfile) + write(io_stdo_bgc,'(a)') 'ini_read_rivin: read riverine nutrients from ',trim(rivinfile) endif call ncfopn(trim(rivinfile),'r',' ',1,iotype) call ncread('DIN',riv_DIN2d,dummymask,0,0.) call ncread('DIP',riv_DIP2d,dummymask,0,0.) call ncread('DSi',riv_DSI2d,dummymask,0,0.) call ncread('DIC',riv_DIC2d,dummymask,0,0.) ! It is actually alkalinity that is observed - call ncread('Fe',riv_DFe2d,dummymask,0,0.) + call ncread('Fe' ,riv_DFe2d,dummymask,0,0.) call ncread('DOC',riv_idoc2d,dummymask,0,0.) call ncread('DET',riv_idet2d,dummymask,0,0.) call ncfcls - - DO j=1,kpje DO i=1,kpie IF(omask(i,j).GT.0.5) THEN @@ -181,10 +151,6 @@ subroutine ini_read_rivin(kpie,kpje,omask) ENDDO ENDDO - !-------------------------------------------------------------------------------- end subroutine ini_read_rivin - - - !******************************************************************************** end module mo_read_rivin diff --git a/hamocc/mo_read_sedpor.F90 b/hamocc/mo_read_sedpor.F90 index fbd60bce..09d21bef 100644 --- a/hamocc/mo_read_sedpor.F90 +++ b/hamocc/mo_read_sedpor.F90 @@ -18,34 +18,25 @@ module mo_read_sedpor !***************************************************************************** - ! Purpose - ! ------- - ! - Routine for reading sediment porosity from netcdf file + ! Routine for reading sediment porosity from netcdf file + ! L_SED_POR must be set to true in nml to activate + ! lon-lat variable sediment porosity. ! - ! Description - ! ----------- - ! Public routines and variable of this module: - ! - ! - subroutine ini_read_sedpor - ! read sediment porosity file - ! - ! L_SED_POR must be set to true in nml to activate - ! lon-lat variable sediment porosity. - ! - ! The model attempts to read lon-lat-sediment depth variable porosity - ! from the input file 'SEDPORFILE' (incl. full path) - ! - ! sed_por holds then the porosity that can be applied later - ! via mo_apply_sedpor + ! The model attempts to read lon-lat-sediment depth variable porosity + ! from the input file 'SEDPORFILE' (incl. full path) ! + ! sed_por holds then the porosity that can be applied later + ! via mo_apply_sedpor !***************************************************************************** implicit none private - public :: read_sedpor,sedporfile + ! Routintes + public :: read_sedpor ! read sediment porosity file - character(len=512),save :: sedporfile = '' + ! Module variables + character(len=512), public :: sedporfile = '' contains @@ -100,7 +91,7 @@ subroutine read_sedpor(kpie,kpje,ks,omask,sed_por) IF(mnproc==1) THEN ncstat = NF90_OPEN(trim(sedporfile),NF90_NOWRITE, ncid) IF (ncstat.NE.NF90_NOERR ) THEN - CALL xchalt('(read_sedpor: Problem with netCDF1)') + call xchalt('(read_sedpor: Problem with netCDF1)') stop '(read_sedpor: Problem with netCDF1)' END IF END IF @@ -112,7 +103,7 @@ subroutine read_sedpor(kpie,kpje,ks,omask,sed_por) IF(mnproc==1) THEN ncstat = NF90_CLOSE(ncid) IF ( ncstat .NE. NF90_NOERR ) THEN - CALL xchalt('(read_sedpor: Problem with netCDF200)') + call xchalt('(read_sedpor: Problem with netCDF200)') stop '(read_sedpor: Problem with netCDF200)' END IF END IF diff --git a/hamocc/mo_restart_hamoccwt.F90 b/hamocc/mo_restart_hamoccwt.F90 index cd00e024..f956da71 100644 --- a/hamocc/mo_restart_hamoccwt.F90 +++ b/hamocc/mo_restart_hamoccwt.F90 @@ -15,18 +15,18 @@ ! 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_restart_hamoccwt +module mo_restart_hamoccwt implicit none private - PUBLIC :: RESTART_HAMOCCWT + public :: restart_hamoccwt -CONTAINS +contains - SUBROUTINE RESTART_HAMOCCWT(rstfnm_ocn) + subroutine restart_hamoccwt(rstfnm_ocn) ! - ! write restart for HAMOCC + ! write restart for hamocc ! use mod_time, only: date,nstep use mod_xc, only: idm,jdm,kdm @@ -34,13 +34,13 @@ SUBROUTINE RESTART_HAMOCCWT(rstfnm_ocn) use mo_intfcblom, only: omask use mo_aufw_bgc, only: aufw_bgc - ! Arguments + ! arguments character(len=*) :: rstfnm_ocn call aufw_bgc(idm,jdm,kdm,ntr,ntrbgc,itrbgc,trc, & date%year,date%month,date%day,nstep,omask, & rstfnm_ocn) - END SUBROUTINE RESTART_HAMOCCWT + end subroutine restart_hamoccwt -END MODULE MO_RESTART_HAMOCCWT +end module mo_restart_hamoccwt diff --git a/hamocc/mo_sedmnt.F90 b/hamocc/mo_sedmnt.F90 index 0498abf2..dd25ec18 100644 --- a/hamocc/mo_sedmnt.F90 +++ b/hamocc/mo_sedmnt.F90 @@ -18,99 +18,70 @@ MODULE mo_sedmnt + !****************************************************************************** + ! Variables for sediment modules. + ! - declaration and memory allocation + ! - initialization of sediment ! - ! MODULE mo_sedmnt - Variables for sediment modules. - ! - ! S.Legutke, *MPI-MaD, HH* 31.10.01 - ! - ! Modified - ! -------- - ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 - ! - added sediment bypass preprocessor option - ! - ! Purpose - ! ------- - ! - declaration and memory allocation - ! - initialization of sediment - ! - ! Description: - ! ------------ - ! Public routines and variable of this module: - ! - ! -subroutine alloc_mem_sedmnt - ! Allocate memory for sediment variables - ! - ! *sedlay* *REAL* - . - ! *sedla1* *REAL* - . - ! *sedtot* *REAL* - . - ! *sedtoa* *REAL* - . - ! *seffel* *REAL* - . - ! *sedhpl* *REAL* - . - ! *powtra* *REAL* - . - ! *prorca* *REAL* - . - ! *prcaca* *REAL* - . - ! *silpro* *REAL* - . - ! *porwat* *REAL* - . - ! *porsol* *REAL* - . - ! *seddzi* *REAL* - . - ! *dzs* *REAL* - . - ! *porwah* *REAL* - . - ! *seddw* *REAL* - . - ! *calcon* *REAL* - . - ! - ! -subroutine ini_sedmnt - ! Initialize sediment parameters and sediment vertical grid - ! -subroutine ini_sedmnt_fields - ! Initialize 2D and 3D sediment fields - ! + ! S.Legutke, *MPI-MaD, HH* 31.10.01 + ! Modified: + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - added sediment bypass preprocessor option !****************************************************************************** + use mod_xc, only: mnproc use mo_param1_bgc, only: ks,ksp,nsedtra,npowtra - use mo_control_bgc, only: io_stdo_bgc - use mo_control_bgc, only: use_sedbypass,use_cisonew + use mo_control_bgc, only: io_stdo_bgc,use_sedbypass,use_cisonew implicit none - - REAL, protected :: dzs(ksp) = 0.0 - REAL, protected :: seddzi(ksp) = 0.0 - REAL, protected :: seddw(ks) = 0.0 - - REAL, DIMENSION (:,:,:,:), ALLOCATABLE :: sedlay - REAL, DIMENSION (:,:,:,:), ALLOCATABLE :: powtra - REAL, DIMENSION (:,:,:), ALLOCATABLE :: sedhpl - REAL, DIMENSION (:,:,:), ALLOCATABLE :: porsol - REAL, DIMENSION (:,:,:), ALLOCATABLE :: porwah - REAL, DIMENSION (:,:,:), ALLOCATABLE :: porwat - REAL, DIMENSION (:,:), ALLOCATABLE :: solfu - REAL, DIMENSION (:,:,:), ALLOCATABLE :: zcoefsu - REAL, DIMENSION (:,:,:), ALLOCATABLE :: zcoeflo - - REAL, DIMENSION (:,:), ALLOCATABLE :: silpro - REAL, DIMENSION (:,:), ALLOCATABLE :: prorca - REAL, DIMENSION (:,:), ALLOCATABLE :: pror13 - REAL, DIMENSION (:,:), ALLOCATABLE :: prca13 - REAL, DIMENSION (:,:), ALLOCATABLE :: pror14 - REAL, DIMENSION (:,:), ALLOCATABLE :: prca14 - REAL, DIMENSION (:,:), ALLOCATABLE :: prcaca - REAL, DIMENSION (:,:), ALLOCATABLE :: produs - REAL, DIMENSION (:,:,:), ALLOCATABLE :: burial - - real, protected :: calfa, oplfa, orgfa, clafa + private + + ! Routines + public :: ini_sedmnt ! Initialize sediment parameters and sediment vertical grid + public :: alloc_mem_sedmnt ! Allocate memory for sediment variables + private :: ini_sedmnt_por ! Initialize 2D and 3D sediment fields + + ! Module variables + real, protected, public :: dzs(ksp) = 0.0 + real, protected, public :: seddzi(ksp) = 0.0 + real, protected, public :: seddw(ks) = 0.0 + + real, dimension (:,:,:,:), allocatable, public :: sedlay + real, dimension (:,:,:,:), allocatable, public :: powtra + real, dimension (:,:,:), allocatable, public :: sedhpl + real, dimension (:,:,:), allocatable, public :: porsol + real, dimension (:,:,:), allocatable, public :: porwah + real, dimension (:,:,:), allocatable, public :: porwat + real, dimension (:,:), allocatable, public :: solfu + real, dimension (:,:,:), allocatable, public :: zcoefsu + real, dimension (:,:,:), allocatable, public :: zcoeflo + + real, dimension (:,:), allocatable, public :: silpro + real, dimension (:,:), allocatable, public :: prorca + real, dimension (:,:), allocatable, public :: pror13 + real, dimension (:,:), allocatable, public :: prca13 + real, dimension (:,:), allocatable, public :: pror14 + real, dimension (:,:), allocatable, public :: prca14 + real, dimension (:,:), allocatable, public :: prcaca + real, dimension (:,:), allocatable, public :: produs + real, dimension (:,:,:), allocatable, public :: burial + + real, protected, public :: calfa, oplfa, orgfa, clafa CONTAINS - !======================================================================== + !****************************************************************************** SUBROUTINE ini_sedmnt(kpie,kpje,kpke,omask,sed_por) - use mo_param_bgc, only: claydens,calcwei,calcdens,opalwei,opaldens,orgwei,orgdens,sedict - - implicit none + use mo_param_bgc, only: claydens,calcwei,calcdens,opalwei,opaldens,orgwei,orgdens,sedict + ! Arguments integer, intent(in) :: kpie,kpje,kpke real, intent(in) :: omask(kpie,kpje) real, intent(in) :: sed_por(kpie,kpje,ks) + ! Local variables integer :: k ! define volumes occupied by solid constituents [m3/kmol] @@ -150,24 +121,23 @@ SUBROUTINE ini_sedmnt(kpie,kpje,kpke,omask,sed_por) 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) + call ini_sedmnt_por(kpie,kpje,kpke,omask,sed_por) endif END SUBROUTINE ini_sedmnt - !======================================================================== + !****************************************************************************** SUBROUTINE ini_sedmnt_por(kpie,kpje,kpke,omask,sed_por) ! ! Initialization of: - ! - 3D porosity field (cell center and cell boundaries) - ! - solid volume fraction at cell center - ! - vertical molecular diffusion coefficients scaled with porosity + ! - 3D porosity field (cell center and cell boundaries) + ! - solid volume fraction at cell center + ! - vertical molecular diffusion coefficients scaled with porosity ! use mo_control_bgc, only: l_3Dvarsedpor use mo_param_bgc, only: sedict - implicit none - + ! Arguments integer, intent(in) :: kpie,kpje,kpke real, intent(in) :: omask(kpie,kpje) real, intent(in) :: sed_por(kpie,kpje,ks) @@ -246,195 +216,181 @@ SUBROUTINE ini_sedmnt_por(kpie,kpje,kpke,omask,sed_por) END SUBROUTINE ini_sedmnt_por + !****************************************************************************** + SUBROUTINE alloc_mem_sedmnt(kpie,kpje) + + ! ------------------------------------------------------ + ! Allocate variables in this module + ! ------------------------------------------------------ + + ! Arguments + integer, intent(in) :: kpie,kpje - !======================================================================== - SUBROUTINE ALLOC_MEM_SEDMNT(kpie,kpje) - !****************************************************************************** - ! ALLOC_MEM_SEDMNT - Allocate variables in this module - !****************************************************************************** - INTEGER, intent(in) :: kpie,kpje - INTEGER :: errstat + ! Local variables + integer :: errstat IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'***************************************************' - WRITE(io_stdo_bgc,*)'Memory allocation for sediment module :' - WRITE(io_stdo_bgc,*)' ' + write(io_stdo_bgc,*)' ' + write(io_stdo_bgc,*)'***************************************************' + write(io_stdo_bgc,*)'Memory allocation for sediment module :' + write(io_stdo_bgc,*)' ' ENDIF IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable silpro ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable silpro ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - - ALLOCATE (silpro(kpie,kpje),stat=errstat) + allocate (silpro(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory silpro' silpro(:,:) = 0.0 IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable prorca ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable prorca ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - - ALLOCATE (prorca(kpie,kpje),stat=errstat) + allocate (prorca(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory prorca' prorca(:,:) = 0.0 if (use_cisonew) then - ALLOCATE (pror13(kpie,kpje),stat=errstat) + allocate (pror13(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory pror13' pror13(:,:) = 0.0 - ALLOCATE (pror14(kpie,kpje),stat=errstat) + allocate (pror14(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory pror14' pror14(:,:) = 0.0 endif IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable prcaca ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable prcaca ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - - ALLOCATE (prcaca(kpie,kpje),stat=errstat) + allocate (prcaca(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory prcaca' prcaca(:,:) = 0.0 if (use_cisonew) then - ALLOCATE (prca13(kpie,kpje),stat=errstat) + allocate (prca13(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory prca13' prca13(:,:) = 0.0 - ALLOCATE (prca14(kpie,kpje),stat=errstat) + allocate (prca14(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory prca14' prca14(:,:) = 0.0 endif IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable produs ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable produs ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - - ALLOCATE (produs(kpie,kpje),stat=errstat) + allocate (produs(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory produs' produs(:,:) = 0.0 - 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 + 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) + 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 + 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) + 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 + 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) + 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 + 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) + 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 + 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) + 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 + 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) + 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 + 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) + 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 + 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) + 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 + 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) + 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 + 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) + allocate (powtra(kpie,kpje,ks,npowtra),stat=errstat) if(errstat.ne.0) stop 'not enough memory powtra' powtra(:,:,:,:) = 0.0 endif - - !****************************************************************************** - END SUBROUTINE ALLOC_MEM_SEDMNT + END SUBROUTINE alloc_mem_sedmnt END MODULE mo_sedmnt diff --git a/hamocc/mo_sedshi.F90 b/hamocc/mo_sedshi.F90 index 09d595df..903ee9ae 100644 --- a/hamocc/mo_sedshi.F90 +++ b/hamocc/mo_sedshi.F90 @@ -18,47 +18,25 @@ ! along with BLOM. If not, see https://www.gnu.org/licenses/. -MODULE MO_SEDSHI +module mo_sedshi implicit none private - public :: SEDSHI + public :: sedshi -CONTAINS +contains - SUBROUTINE SEDSHI(kpie,kpje,omask) + subroutine sedshi(kpie,kpje,omask) !********************************************************************** + ! Change specific weights for opal, CaCO3, POC include upward transport ! - !**** *SEDSHI* - . - ! - ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 - ! - ! Modified - ! -------- - ! S.Legutke, *MPI-MaD, HH* 10.04.01 - ! - rename ssssil(i,j,k)=sedlay(i,j,k,issssil) etc. - ! I. Kriest *MPI-Met, HH*, 27.05.03 - ! - change specific weights for opal, CaCO3, POC - ! - include upward transport - ! Purpose - ! ------- - ! . - ! - ! Method - ! ------- - ! . - ! - !** Interface. - ! ---------- - ! - ! *CALL* *SEDSHI* - ! - ! Externals - ! --------- - ! none. - ! + ! Ernst Maier-Reimer, *MPI-Met, HH* 10.04.01 + ! Modified: + ! S.Legutke, *MPI-MaD, HH* 10.04.01 + ! - rename ssssil(i,j,k)=sedlay(i,j,k,issssil) etc. + ! I. Kriest *MPI-Met, HH*, 27.05.03 !********************************************************************** use mo_sedmnt, only: burial,calfa,clafa,oplfa,orgfa,porsol,sedlay,seddw,solfu @@ -67,8 +45,6 @@ SUBROUTINE SEDSHI(kpie,kpje,omask) isssc13,isssc14,issso13,issso14 use mo_control_bgc, only: use_cisonew - implicit none - ! Arguments integer, intent(in) :: kpie integer, intent(in) :: kpje @@ -315,6 +291,6 @@ SUBROUTINE SEDSHI(kpie,kpje,omask) enddo !end k-loop - END SUBROUTINE SEDSHI + end subroutine sedshi -END MODULE MO_SEDSHI +end module mo_sedshi diff --git a/hamocc/mo_trc_limitc.F90 b/hamocc/mo_trc_limitc.F90 index 1d82e8a2..8196659b 100644 --- a/hamocc/mo_trc_limitc.F90 +++ b/hamocc/mo_trc_limitc.F90 @@ -15,41 +15,31 @@ ! 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_TRC_LIMITC +module mo_trc_limitc implicit none private - public :: TRC_LIMITC + public :: trc_limitc -CONTAINS +contains - SUBROUTINE TRC_LIMITC(nn) + subroutine trc_limitc(nn) !*********************************************************************** + ! Remove negative tracer values. + ! Remove negative tracer values in the first layer in a mass + ! conservative fashion (i.e. the mass deficit removed is + ! transfered to non-negative points by a multiplicative + ! correction). This is done since the virtual tracer fluxes + ! (applied in mxlayr.F directly before HAMOCC is called) can + ! cause negative tracer values in regions with low concentration + ! and strong precipitation. ! - !**** *SUBROUTINE trc_limitc* - remove negative tracer values. - ! - ! J. Schwinger *GFI, UiB initial version, 2014-06-17 - ! - - ! - ! Modified - ! -------- - ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 - ! - fixed a bug related to the 2 time-level scheme - ! - ! - ! - ! Purpose - ! ------- - ! Remove negative tracer values in the first layer in a mass - ! conservative fashion (i.e. the mass deficit removed is - ! transfered to non-negative points by a multiplicative - ! correction). This is done since the virtual tracer fluxes - ! (applied in mxlayr.F directly before HAMOCC is called) can - ! cause negative tracer values in regions with low concentration - ! and strong precipitation. - ! + ! J. Schwinger *GFI, UiB initial version, 2014-06-17 + ! Modified + ! J.Schwinger, *Uni Research, Bergen* 2018-04-12 + ! - fixed a bug related to the 2 time-level scheme !*********************************************************************** use mod_xc, only: ii,jj,ips,ifp,isp,ilp,xcsum @@ -140,4 +130,4 @@ SUBROUTINE TRC_LIMITC(nn) end subroutine trc_limitc -END MODULE MO_trc_limitc +end module mo_trc_limitc diff --git a/hamocc/mo_vgrid.F90 b/hamocc/mo_vgrid.F90 index 1c642780..817a703a 100644 --- a/hamocc/mo_vgrid.F90 +++ b/hamocc/mo_vgrid.F90 @@ -17,65 +17,50 @@ module mo_vgrid + !****************************************************************************** - ! - ! MODULE mo_vgrid - Variables and routines related to vertical grid - ! structure + ! Variables and routines related to vertical grid structure + ! Declaration, memory allocation, and routines related to the + ! vertical grid structure. These have to be recalculated every + ! time step when iHAMOCC is coupled to BLOM. ! ! J.Schwinger, *NORCE Climate, Bergen* 2020-05-19 - ! - ! Modified - ! -------- - ! - ! Purpose - ! ------- - ! Declaration, memory allocation, and routines related to the - ! vertical grid structure. These have to be recalculated every - ! time step when iHAMOCC is coupled to BLOM. - ! - ! Description: - ! ------------ - ! Public routines and variables of this module: - ! - ! -subroutine set_vgrid - ! Calculate variables related to the vertical grid structure. - ! - ! -subroutine alloc_mem_vgrid - ! Allocate memory for vertical grid variables - ! - ! *kbo* *INTEGER* - number of wet cells in column. - ! *kwrbioz* *INTEGER* - last k-index of euphotic zone. - ! *kxxxx* *INTEGER* - k-index of gridbox comprising xxxx m depth. - ! *bolay* *REAL* - height of bottom cell. - ! *ptiestu* *REAL* - depth of layer centres. - ! *ptiestw* *REAL* - depth of layer interfaces. - ! !****************************************************************************** + implicit none + private - INTEGER, PARAMETER :: kmle_static = 2 ! k-end index for layers that - ! represent the mixed layer in BLOM. - ! Default value used for isopycnic coordinates. - REAL, PARAMETER :: dp_ez = 100.0 ! depth of euphotic zone - REAL, PARAMETER :: dp_min = 1.0E-12 ! min layer thickness layers thinner - ! than this are ignored by HAMOCC - REAL, PARAMETER :: dp_min_sink = 1.0 ! min layer thickness for sinking (layers thinner than - ! this are ignored and set to the concentration of the - ! layer above). Note that the bottom layer index kbo(i,j) - ! is defined as the lowermost layer thicker than dp_min_sink. - - INTEGER, DIMENSION(:,:), ALLOCATABLE :: kmle - INTEGER, DIMENSION(:,:), ALLOCATABLE :: kbo - INTEGER, DIMENSION(:,:), ALLOCATABLE :: kwrbioz - INTEGER, DIMENSION(:,:), ALLOCATABLE :: k0100,k0500,k1000,k2000,k4000 - REAL, DIMENSION(:,:), ALLOCATABLE :: bolay - REAL, DIMENSION(:,:,:), ALLOCATABLE :: ptiestu - REAL, DIMENSION(:,:,:), ALLOCATABLE :: ptiestw + ! Routines -contains - !****************************************************************************** + public :: set_vgrid ! Calculate variables related to the vertical grid structure. + public :: alloc_mem_vgrid ! Allocate memory for vertical grid variables + ! Module variables + integer, parameter, public :: kmle_static = 2 ! k-end index for layers that represent the mixed layer in blom. + + ! Default value used for isopycnic coordinates. + real, parameter, public :: dp_ez = 100.0 ! depth of euphotic zone + real, parameter, public :: dp_min = 1.0e-12 ! min layer thickness layers thinner + ! than this are ignored by HAMOCC + real, parameter, public :: dp_min_sink = 1.0 ! min layer thickness for sinking (layers thinner than + ! this are ignored and set to the concentration of the + ! layer above). note that the bottom layer index kbo(i,j) + ! is defined as the lowermost layer thicker than dp_min_sink. + + integer, dimension(:,:), allocatable, public :: kmle + integer, dimension(:,:), allocatable, public :: kbo ! number of wet cells in column. + integer, dimension(:,:), allocatable, public :: kwrbioz ! last k-index of euphotic zone. + real, dimension(:,:), allocatable, public :: bolay ! height of bottom cell. + real, dimension(:,:,:), allocatable, public :: ptiestu ! depth of layer centres. + real, dimension(:,:,:), allocatable, public :: ptiestw ! depth of layer interfaces. + integer, dimension(:,:), allocatable, public :: k0100 + integer, dimension(:,:), allocatable, public :: k0500 + integer, dimension(:,:), allocatable, public :: k1000 + integer, dimension(:,:), allocatable, public :: k2000 + integer, dimension(:,:), allocatable, public :: k4000 + +contains subroutine set_vgrid(kpie,kpje,kpke,pddpo) !****************************************************************************** @@ -91,22 +76,20 @@ subroutine set_vgrid(kpie,kpje,kpke,pddpo) ! -find lowest mass containing layer in the euphotic zone ! -find k-index of 100,500,1000,2000, and 4000 m-surfaces ! - ! Parameter list: - ! --------------- - ! *INTEGER* *kpie* - 1st dimension of model grid. - ! *INTEGER* *kpje* - 2nd dimension of model grid. - ! *INTEGER* *kpke* - 3rd (vertical) dimension of model grid. - ! *REAL* *pddpo* - size of grid cell (3rd dimension) [m]. - ! !****************************************************************************** - INTEGER, intent(in) :: kpie,kpje,kpke - REAL, intent(in) :: pddpo(kpie,kpje,kpke) - INTEGER :: i,j,k + ! Arguments + integer, intent(in) :: kpie ! 1st dimension of model grid. + integer, intent(in) :: kpje ! 2nd dimension of model grid. + integer, intent(in) :: kpke ! 3rd (vertical) dimension of model grid. + real, intent(in) :: pddpo(kpie,kpje,kpke) ! size of grid cell (3rd dimension) [m]. + ! Local variables + integer :: i,j,k ! --- set depth of surface interface to zero ptiestw(:,:,1)=0. + ! --- depth of layer kpke+1 centre ptiestu(:,:,kpke+1)=9000. @@ -125,7 +108,6 @@ subroutine set_vgrid(kpie,kpje,kpke,pddpo) enddo !$OMP END PARALLEL DO - kbo(:,:) =1 bolay(:,:)=0.0 @@ -145,7 +127,6 @@ subroutine set_vgrid(kpie,kpje,kpke,pddpo) ENDDO !$OMP END PARALLEL DO - !$OMP PARALLEL DO PRIVATE(i,k) DO j=1,kpje DO i=1,kpie @@ -161,7 +142,6 @@ subroutine set_vgrid(kpie,kpje,kpke,pddpo) END DO !$OMP END PARALLEL DO - k0100(:,:)=0 k0500(:,:)=0 k1000(:,:)=0 @@ -211,13 +191,9 @@ subroutine set_vgrid(kpie,kpje,kpke,pddpo) END DO !$OMP END PARALLEL DO - RETURN - - !****************************************************************************** end subroutine set_vgrid - subroutine alloc_mem_vgrid(kpie,kpje,kpke) !****************************************************************************** ! @@ -229,86 +205,84 @@ subroutine alloc_mem_vgrid(kpie,kpje,kpke) use mod_xc, only: mnproc use mo_control_bgc, only: io_stdo_bgc - INTEGER, intent(in) :: kpie,kpje,kpke - INTEGER :: errstat + ! Arguments + integer, intent(in) :: kpie,kpje,kpke + ! Local variables + integer :: errstat IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)' ' - WRITE(io_stdo_bgc,*)'***************************************************' - WRITE(io_stdo_bgc,*)'Memory allocation for module mo_vgrid :' - WRITE(io_stdo_bgc,*)' ' + write(io_stdo_bgc,*)' ' + write(io_stdo_bgc,*)'***************************************************' + write(io_stdo_bgc,*)'Memory allocation for module mo_vgrid :' + write(io_stdo_bgc,*)' ' ENDIF - IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable ptiestu ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',kpke+1 + write(io_stdo_bgc,*)'Memory allocation for variable ptiestu ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Third dimension : ',kpke+1 ENDIF - ALLOCATE (ptiestu(kpie,kpje,kpke+1),stat=errstat) + allocate (ptiestu(kpie,kpje,kpke+1),stat=errstat) if(errstat.ne.0) stop 'not enough memory ptiestu' ptiestu(:,:,:) = 0.0 IF (mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable ptiestw ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje - WRITE(io_stdo_bgc,*)'Third dimension : ',kpke+1 + write(io_stdo_bgc,*)'Memory allocation for variable ptiestw ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Third dimension : ',kpke+1 ENDIF - ALLOCATE (ptiestw(kpie,kpje,kpke+1),stat=errstat) + allocate (ptiestw(kpie,kpje,kpke+1),stat=errstat) if(errstat.ne.0) stop 'not enough memory ptiestw' ptiestw(:,:,:) = 0.0 IF(mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable kmle ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable kmle ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - ALLOCATE(kmle(kpie,kpje),stat=errstat) + allocate(kmle(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory kmle' kmle(:,:) = kmle_static - IF(mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable kbo ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable kbo ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - ALLOCATE(kbo(kpie,kpje),stat=errstat) + allocate(kbo(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory kbo' kbo(:,:) = 0 - IF(mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable kwrbioz...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable kwrbioz...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - ALLOCATE(kwrbioz(kpie,kpje),stat=errstat) + allocate(kwrbioz(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory kwrbioz' kwrbioz(:,:) = 0 - IF(mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variables k0100, k0500, k1000, k2000 ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variables k0100, k0500, k1000, k2000 ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - ALLOCATE(k0100(kpie,kpje),stat=errstat) - ALLOCATE(k0500(kpie,kpje),stat=errstat) - ALLOCATE(k1000(kpie,kpje),stat=errstat) - ALLOCATE(k2000(kpie,kpje),stat=errstat) - ALLOCATE(k4000(kpie,kpje),stat=errstat) + allocate(k0100(kpie,kpje),stat=errstat) + allocate(k0500(kpie,kpje),stat=errstat) + allocate(k1000(kpie,kpje),stat=errstat) + allocate(k2000(kpie,kpje),stat=errstat) + allocate(k4000(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory k0100, k0500, k1000, k2000' k0100(:,:) = 0 k0500(:,:) = 0 @@ -316,21 +290,16 @@ subroutine alloc_mem_vgrid(kpie,kpje,kpke) k2000(:,:) = 0 k4000(:,:) = 0 - IF(mnproc.eq.1) THEN - WRITE(io_stdo_bgc,*)'Memory allocation for variable bolay ...' - WRITE(io_stdo_bgc,*)'First dimension : ',kpie - WRITE(io_stdo_bgc,*)'Second dimension : ',kpje + write(io_stdo_bgc,*)'Memory allocation for variable bolay ...' + write(io_stdo_bgc,*)'First dimension : ',kpie + write(io_stdo_bgc,*)'Second dimension : ',kpje ENDIF - ALLOCATE (bolay(kpie,kpje),stat=errstat) + allocate (bolay(kpie,kpje),stat=errstat) if(errstat.ne.0) stop 'not enough memory bolay' bolay(:,:) = 0.0 - - !****************************************************************************** end subroutine alloc_mem_vgrid - - !****************************************************************************** end module mo_vgrid diff --git a/hamocc/mo_write_netcdf_var.F90 b/hamocc/mo_write_netcdf_var.F90 index 07c90cb2..86b9e278 100644 --- a/hamocc/mo_write_netcdf_var.F90 +++ b/hamocc/mo_write_netcdf_var.F90 @@ -16,23 +16,22 @@ ! along with BLOM. If not, see https://www.gnu.org/licenses/. -MODULE MO_WRITE_NETCDF_VAR +module mo_write_netcdf_var implicit none private - public :: WRITE_NETCDF_VAR + public :: write_netcdf_var -CONTAINS +contains + + subroutine write_netcdf_var(ncid,desc,arr,klev,time) - SUBROUTINE WRITE_NETCDF_VAR(ncid,desc,arr,klev,time) !************************************************************************** - ! ! Gathers a global variable from all PEs and writes it to a NETCDF file - ! ! The NETCDF File is only accessed by mnproc=1 - ! !************************************************************************** + use netcdf, only: nf90_noerr,nf90_inq_varid,nf90_strerror,nf90_put_var use mod_xc, only: itdm,jtdm,jdm,lp,mnproc,nbdy,idm,xchalt,xcaget use mod_dia, only: iotype @@ -207,6 +206,6 @@ SUBROUTINE WRITE_NETCDF_VAR(ncid,desc,arr,klev,time) #endif ENDIF - END SUBROUTINE WRITE_NETCDF_VAR + end subroutine write_netcdf_var -END MODULE MO_WRITE_NETCDF_VAR +end module mo_write_netcdf_var