From c9cf8fdc78147444309d1a585c486ad8a09d4c0d Mon Sep 17 00:00:00 2001 From: Tomas Torsvik Date: Wed, 11 Mar 2026 11:20:00 +0100 Subject: [PATCH 1/3] Add flush(io_stdo_bgc) statement when entering profile_gd subroutine This overcomes a problem encountered when running in debug mode on Olivia, where IFLD index can be altered if this flush statement is not present. --- hamocc/mo_profile_gd.F90 | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/hamocc/mo_profile_gd.F90 b/hamocc/mo_profile_gd.F90 index b53f5796..e5d59129 100644 --- a/hamocc/mo_profile_gd.F90 +++ b/hamocc/mo_profile_gd.F90 @@ -75,6 +75,11 @@ subroutine profile_gd(kpie,kpje,kpke,kbnd,pglon,pglat,omask) integer :: ifld(maxflds) character(len=3) :: vname(maxflds) + ! Ensure all data buffered by Fortran runtime library is written to external file. + ! This overcomes a problem encountered when running in debug mode on Olivia, where + ! IFLD index can be altered if this flush statement is not present. + flush(io_stdo_bgc) + nflds = nread_base vname( 1:nflds) = (/ 'dic', 'alk', 'pho', 'nit','sil', 'oxy' /) ifld( 1:nflds) = (/ isco212,ialkali,iphosph,iano3,isilica,ioxygen/) @@ -164,11 +169,11 @@ subroutine profile_gd(kpie,kpje,kpke,kbnd,pglon,pglat,omask) 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_rp) > 1.0e-6_rp ) then - write(io_stdo_bgc,*) 'profile_gd error: inconsisten weihts' + write(io_stdo_bgc,*) 'profile_gd error: inconsistent weights' write(io_stdo_bgc,*) 'profile_gd error: ', k,l,abs(sum(wgt(:))-1.0_rp) 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) + flush(io_stdo_bgc) call xchalt('(profile_gd)') endif do ll=1,l From 641ffe67c630082df9dba6e781c339e9313075a1 Mon Sep 17 00:00:00 2001 From: Tomas Torsvik Date: Wed, 11 Mar 2026 11:31:33 +0100 Subject: [PATCH 2/3] Use Fortran2003 flush statements in iHAMOCC --- hamocc/mo_Gdata_read.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/hamocc/mo_Gdata_read.F90 b/hamocc/mo_Gdata_read.F90 index 53679f10..a526f8db 100644 --- a/hamocc/mo_Gdata_read.F90 +++ b/hamocc/mo_Gdata_read.F90 @@ -791,7 +791,7 @@ subroutine ncerr(status) write(io_stdo_bgc,*) 'NetCDF error: ',nf90_strerror(status) write(io_stdo_bgc,*) 'Abort... ' - call flush(io_stdo_bgc) + flush(io_stdo_bgc) call xchalt('(Module mo_Gdata_read, ncerr)') stop '(Module mo_Gdata_read, ncerr)' !-------------------------------------------------------------------------------- @@ -807,7 +807,7 @@ subroutine moderr(routinestr,errstr) write(io_stdo_bgc,'(/3a)') routinestr, ': ', errstr write(io_stdo_bgc,*) 'Abort... ' - call flush(io_stdo_bgc) + flush(io_stdo_bgc) call xchalt('(Module mo_Gdata_read)') stop '(Module mo_Gdata_read)' !-------------------------------------------------------------------------------- From 63554cec43da57f377b89476dfaf9e345fca0f62 Mon Sep 17 00:00:00 2001 From: Tomas Torsvik Date: Wed, 11 Mar 2026 11:53:33 +0100 Subject: [PATCH 3/3] Use Fortran2003 flush statements in BLOM --- channel/mod_channel.F90 | 2 +- phy/mod_bigrid.F90 | 6 +++--- phy/mod_blom_init.F90 | 8 ++++---- phy/mod_checksum.F90 | 2 +- phy/mod_dia.F90 | 2 +- phy/mod_forcing.F90 | 2 +- phy/mod_geoenv.F90 | 4 ++-- phy/mod_nctools.F90 | 12 ++++++------ phy/mod_pointtest.F90 | 2 +- phy/mod_swabs.F90 | 4 ++-- phy/mod_tidaldissip.F90 | 2 +- phy/mod_xc.F90 | 2 +- 12 files changed, 24 insertions(+), 24 deletions(-) diff --git a/channel/mod_channel.F90 b/channel/mod_channel.F90 index e44003c3..f19236c5 100644 --- a/channel/mod_channel.F90 +++ b/channel/mod_channel.F90 @@ -223,7 +223,7 @@ subroutine inicon_channel if (mnproc.eq.1) then write (lp,'(1a)') ' idealized initial conditions' - call flush(lp) + flush(lp) endif ! diff --git a/phy/mod_bigrid.F90 b/phy/mod_bigrid.F90 index 7e8937a5..6217647e 100644 --- a/phy/mod_bigrid.F90 +++ b/phy/mod_bigrid.F90 @@ -100,7 +100,7 @@ subroutine bigrid(depth) write(lp,'(a,l1)') 'bigrid: larctic =',larctic write(lp,'(a,l1)') 'bigrid: lperiodj =',lperiodj write(lp,'(a/)') 'basin depth array inconsistent with nreg' - call flush(lp) + flush(lp) end if call xcstop('(bigrid)') stop '(bigrid)' @@ -119,7 +119,7 @@ subroutine bigrid(depth) else if (nreg == 4) then write(lp,'(a/)') 'bigrid: periodic domain in j-index' end if - call flush(lp) + flush(lp) end if ! nreg is defined, so now safe to update halo @@ -186,7 +186,7 @@ subroutine bigrid(depth) if (mnproc == 1) then write(lp,'(/a/)') & 'Must correct bathymetry before running BLOM' - call flush(lp) + flush(lp) end if call xcstop('(bigrid)') stop '(bigrid)' diff --git a/phy/mod_blom_init.F90 b/phy/mod_blom_init.F90 index 6e61bf82..ed446a41 100644 --- a/phy/mod_blom_init.F90 +++ b/phy/mod_blom_init.F90 @@ -224,7 +224,7 @@ subroutine blom_init_phase2 if (mnproc == 1) then write (lp,*) & 'Warning! date is inconsistent with ini. cond. (Jan 1st)!' - call flush(lp) + flush(lp) end if end if @@ -438,7 +438,7 @@ subroutine blom_init_phase2 write (lp,'(/2(a,i6),2(a,i9),a/)') & 'model starts at day',nday1,', goes to day',nday2,' (steps', & nstep1,' --',nstep2,')' - call flush(lp) + flush(lp) end if end subroutine blom_init_phase2 @@ -497,7 +497,7 @@ subroutine numerical_bounds call xcmin(btdtmx) if (mnproc == 1) then write (lp, *) 'estimated max. barotropic time step:', btdtmx/sqrt(2._r8) - call flush(lp) + flush(lp) endif ! Set maximum velocities allowable ensuring stability of the upwind scheme. @@ -539,7 +539,7 @@ subroutine numerical_bounds if (mnproc == 1) then write (lp, *) 'min/max umax:', umaxmin, umaxmax write (lp, *) 'min/max vmax:', vmaxmin, vmaxmax - call flush(lp) + flush(lp) endif if (csdiag) then diff --git a/phy/mod_checksum.F90 b/phy/mod_checksum.F90 index 1818b5f2..3ebe791e 100644 --- a/phy/mod_checksum.F90 +++ b/phy/mod_checksum.F90 @@ -68,7 +68,7 @@ subroutine chksum(a, kcsd, itype, text) if (mnproc == 1) then write (lp,'(3a,z8.8)') ' chksum: ', trim(text), ': 0x', crc - call flush(lp) + flush(lp) endif end subroutine chksum diff --git a/phy/mod_dia.F90 b/phy/mod_dia.F90 index a2c65012..ee96b4e4 100644 --- a/phy/mod_dia.F90 +++ b/phy/mod_dia.F90 @@ -4030,7 +4030,7 @@ subroutine diamer(iogrp) jind(nind(l),l) > jtdm) then write(lp,*) 'iind=',iind(nind(l),l),' itdm = ',itdm write(lp,*) 'jind=',jind(nind(l),l),' jtdm = ',jtdm - call flush(lp) + flush(lp) write(lp,*) 'indices out of range!' call xchalt('(diamer)') stop '(diamer)' diff --git a/phy/mod_forcing.F90 b/phy/mod_forcing.F90 index 50ee8e4c..2aae5560 100644 --- a/phy/mod_forcing.F90 +++ b/phy/mod_forcing.F90 @@ -413,7 +413,7 @@ subroutine fwbbal(m, n, mm, nn, k1m, k1n) if (mnproc == 1) then write (lp, *) & 'new correction factor for precipitation/runoff:', prfac - call flush(lp) + flush(lp) endif ! Reset accumulation arrays. diff --git a/phy/mod_geoenv.F90 b/phy/mod_geoenv.F90 index 530eb4c9..6f905ac5 100644 --- a/phy/mod_geoenv.F90 +++ b/phy/mod_geoenv.F90 @@ -69,7 +69,7 @@ subroutine geoenv_file if (mnproc == 1) then write (lp,'(2a)') ' reading grid information from ',trim(grfile) - call flush(lp) + flush(lp) ! open netcdf file status = nf90_open(grfile,nf90_nowrite,ncid) @@ -719,7 +719,7 @@ subroutine geoenv_file if (mnproc == 1) then write (lp,'(2a)') ' reading topographic beta from ', & trim(tbfile) - call flush(lp) + flush(lp) status = nf90_open(tbfile,nf90_nowrite,ncid) if (status /= nf90_noerr) then write(lp,'(4a)') ' nf90_open: ',trim(tbfile),': ', & diff --git a/phy/mod_nctools.F90 b/phy/mod_nctools.F90 index 25bf2475..46e12daa 100644 --- a/phy/mod_nctools.F90 +++ b/phy/mod_nctools.F90 @@ -871,7 +871,7 @@ subroutine ncread(vnm, fld, msk, mskflg, fill, scf_arg) if (status /= nf_noerr) then if (mnproc == 1) then write(lp,*) 'WARNING: Problems reading variable ',trim(vnm) - call flush(lp) + flush(lp) end if call ncerro(status) end if @@ -1062,7 +1062,7 @@ subroutine ncread(vnm, fld, msk, mskflg, fill, scf_arg) status = nf90_inq_varid(ncid,vnm,rhid) if (status /= nf90_noerr) then write(lp,*) 'WARNING: Problems reading variable ',trim(vnm) - call flush(lp) + flush(lp) call ncerro(status) end if call ncerro(nf90_inquire_variable(ncid,rhid,ndims = ndims)) @@ -2104,7 +2104,7 @@ subroutine ncwrtc(vnm,dims,fld) if (strn > 2) then if (mnproc == 1) then write(lp,*) 'ncwrtc: number of dimensions has to be <=2' - call flush(lp) + flush(lp) end if call xcstop('(ncerro)') stop '(ncerro)' @@ -2147,7 +2147,7 @@ subroutine ncwrtc(vnm,dims,fld) call ncsevl(dims,strn,strind) if (strn > 2) then write(lp,*) 'ncwrtc: number of dimensions has to be <=2' - call flush(lp) + flush(lp) call xchalt('(ncerro)') stop '(ncerro)' end if @@ -2850,7 +2850,7 @@ subroutine ncerro(ncstatus) #ifdef PNETCDF if (ncstatus /= nf_noerr) then write(lp,*) 'NetCDF error:',nfmpi_strerror(ncstatus) - call flush(lp) + flush(lp) call xchalt('(ncerro)') stop '(ncerro)' end if @@ -2858,7 +2858,7 @@ subroutine ncerro(ncstatus) else if(io_type == 0) then if (ncstatus /= nf90_noerr) then write(lp,*) 'NetCDF error: ',nf90_strerror(ncstatus) - call flush(lp) + flush(lp) call xchalt('(ncerro)') stop '(ncerro)' end if diff --git a/phy/mod_pointtest.F90 b/phy/mod_pointtest.F90 index ee0036b5..939e9a51 100644 --- a/phy/mod_pointtest.F90 +++ b/phy/mod_pointtest.F90 @@ -48,7 +48,7 @@ subroutine init_ptest write (lp, '(a,i4,a,i4,a,i5)') & ' itest = ', itest,', jtest = ', jtest, & ' found on processor ', mnproc - call flush(lp) + flush(lp) ptest = mnproc itest = itest - i0 jtest = jtest - j0 diff --git a/phy/mod_swabs.F90 b/phy/mod_swabs.F90 index 1bf6ab7c..fe99312a 100644 --- a/phy/mod_swabs.F90 +++ b/phy/mod_swabs.F90 @@ -227,7 +227,7 @@ subroutine iniswa write (lp,*) & 'reading chlorophyll concentration climatology from '// & trim(ccfile) - call flush(lp) + flush(lp) ! Open netCDF file. errstat = nf90_open(ccfile, nf90_nowrite, ncid) @@ -366,7 +366,7 @@ subroutine iniswa write (lp,*) & 'reading spatially varying spectral band fractions and '// & 'attenuation lengths from '//trim(svfile) - call flush(lp) + flush(lp) ! Open netCDF file. errstat = nf90_open(svfile, nf90_nowrite, ncid) diff --git a/phy/mod_tidaldissip.F90 b/phy/mod_tidaldissip.F90 index fe389f20..8c455701 100644 --- a/phy/mod_tidaldissip.F90 +++ b/phy/mod_tidaldissip.F90 @@ -77,7 +77,7 @@ subroutine read_tidaldissip if (mnproc == 1) then write (lp, '(2a)') ' reading tidal dissipation data from ', & trim(tdfile) - call flush(lp) + flush(lp) ! Open netcdf file. errstat = nf90_open(tdfile, nf90_nowrite, ncid) diff --git a/phy/mod_xc.F90 b/phy/mod_xc.F90 index 8bb4f7f6..44f10d1d 100644 --- a/phy/mod_xc.F90 +++ b/phy/mod_xc.F90 @@ -4214,7 +4214,7 @@ subroutine xcsync(lflush) ! 3) Only one processor, so the barrier is a no-op in this case. !----------- if (lflush) then - call flush(lp) + flush(lp) end if end subroutine xcsync