Update use of flush statements in BLOM/iHAMOCC

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
 
          !

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)'
     !--------------------------------------------------------------------------------

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

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)'

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

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

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)'

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.

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),': ', &

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,15 +2850,15 @@ 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
 #endif
     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

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

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)

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)

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