Hi,
I wasn’t sure whether to create a new post for this issue, or continue here on this thread. I’ll continue here for now.
Having successfully compiled the nemo model with updated ldfdyn.F90
and step.F90
, I have attempted to run a simulation using the QG Leith code. However, the model crashes and I receive the following errors in testing.output
:
*** glibc detected *** ./nemo: free(): invalid pointer
I think the above error implies the code is trying to access an index that does not exist. I can’t see anything immediately obvious with the below routine,
CASE( 33 ) !== time varying 3D field ==! = F(QG PV gradient, divergence, and gridscale) (QG Leith)
!
IF( ln_dynldf_lap ) THEN ! laplacian operator
!
! allocate local variables !
ALLOCATE( zbu(jpi,jpj,jpk) , zst(jpi,jpj,jpk) , zwz(jpi,jpj,jpk) )
!
zcmqgl = (rn_cqgc/rpi)**6 ! (C_qg/pi)^6
zqglep1 = 1.e-12_wp
zqglep2 = 1.e-24_wp
!== begin calculation of stretching term d/dz[(f/(N**2))*b] ==!
! find buoyancy and interpolate onto w-grid !
DO jk = 1, jpkm1
DO jj = 1, jpjm1
DO ji = 1, jpim1
IF( jk < 2 ) THEN
! buoyancy at surface on w-grid !
zbu(ji,jj,jk) = - grav * prd(ji,jj,jk)
ELSE
! buoyancy below surface on w-grid !
zbuup = - grav * prd(ji,jj,jk-1)
zbulw = - grav * prd(ji,jj,jk )
zbu(ji,jj,jk) = 0.5_wp * ( zbuup + zbulw )
ENDIF
END DO
END DO
END DO
!
!== finish calculation and take vertical derivative (t-point) ==!
DO jk = 1, jpkm1
DO jj = 1, jpjm1
DO ji = 1, jpim1
IF( jk < jpkm1 ) THEN
zker1 = ( ff_t(ji,jj) / MAX( pn2(ji,jj,jk ), zqglep1 ) ) * zbu(ji,jj,jk )
zker2 = ( ff_t(ji,jj) / MAX( pn2(ji,jj,jk+1), zqglep1 ) ) * zbu(ji,jj,jk+1)
zst(ji,jj,jk) = (( zker1 - zker2 ) / e3w_n(ji,jj,jk) ) * tmask(ji,jj,jk)
ELSE
zker1 = ( ff_t(ji,jj) / MAX( pn2(ji,jj,jk ), zqglep1 ) ) * zbu(ji,jj,jk )
zker2 = 0._wp ! no value set at ocean bottom jk = jpk as it lies outside domain !
zst(ji,jj,jk) = (( zker1 - zker2 ) / e3w_n(ji,jj,jk) ) * tmask(ji,jj,jk)
ENDIF
END DO
END DO
END DO
!
!== calculate absolute vorticity (f+zeta) on f-point ==!
DO jk = 1, jpkm1 ! Horizontal slab
DO jj = 1, jpjm1
DO ji = 1, fs_jpim1 ! vector opt.
zwz(ji,jj,jk) = ff_f(ji,jj) + ( e2v(ji+1,jj ) * vn(ji+1,jj ,jk) - e2v(ji,jj) * vn(ji,jj,jk) &
& - e1u(ji ,jj+1) * un(ji ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk) ) * r1_e1e2f(ji,jj)
END DO
END DO
END DO
!
!== calculate square of Rossby and Froude numbers, then limit stretching term if needed (f-point) ==!
DO jk = 1, jpkm1
DO jj = 1, jpjm1
DO ji = 1, jpim1
zusq = r1_2 * ( ( un(ji,jj,jk)**2 + un(ji,jj+1,jk)**2 ) + ( vn(ji,jj,jk)**2 + vn(ji+1,jj,jk)**2 ) )
zrosq = ( zusq / ( MAX( ff_f(ji,jj)**2, zqglep2 ) * ( esqf(ji,jj)**2 ) ) ) * fmask(ji,jj,jk)
znsq = r1_2 * ( r1_4 * ( pn2(ji,jj,jk) + pn2(ji+1,jj,jk) + pn2(ji,jj+1,jk) + pn2(ji+1,jj+1,jk) ) &
& + r1_4 * ( pn2(ji,jj,jk+1) + pn2(ji+1,jj,jk+1) + pn2(ji,jj+1,jk+1) + pn2(ji+1,jj+1,jk+1) ) ) ! pn2 on f-point !
zfrsq = ( ( zusq * rpi * rpi ) / MAX( ( znsq * e3f_n(ji,jj,jk)**2 ), zqglep2 ) ) * fmask(ji,jj,jk)
! limit the stretching term !
zsthld = min( ABS( r1_4 * ( zst(ji,jj,jk) + zst(ji+1,jj,jk) + zst(ji,jj+1,jk) + zst(ji+1,jj+1,jk) ) ), &
& ABS( ( zwz(ji,jj,jk) * zfrsq ) / &
& ( zrosq + zfrsq**2 + zqglep2 ) ) )
zst(ji,jj,jk) = SIGN( zsthld, zst(ji,jj,jk) ) ! possibly define key_nosignedzero? !
END DO
END DO
END DO
!
!== calculate gradients of vorticity and stretching, then square of magnitude (t-point) ==!
DO jk = 1, jpkm1
DO jj = 2, jpjm1
DO ji = 2, jpim1
zvsdx = r1_2 * ( r1_e1f(ji,jj-1) * ( zst(ji,jj-1,jk) + zwz(ji,jj-1,jk) - &
& zst(ji-1,jj-1,jk) - zwz(ji-1,jj-1,jk) ) &
& + r1_e1f(ji,jj) * ( zst(ji,jj,jk) + zwz(ji,jj,jk) - &
& zst(ji-1,jj,jk) - zwz(ji-1,jj,jk) ) )
zvsdy = r1_2 * ( r1_e2f(ji-1,jj) * ( zst(ji-1,jj,jk) + zwz(ji-1,jj,jk) - &
& zst(ji-1,jj-1,jk) - zwz(ji-1,jj-1,jk) ) &
& + r1_e2f(ji,jj) * ( zst(ji,jj,jk) + zwz(ji,jj,jk) - &
& zst(ji,jj-1,jk) - zwz(ji,jj-1,jk) ) )
dvsmagsq(ji,jj,jk) = ( zvsdx**2 + zvsdy**2 ) * tmask(ji,jj,jk)
END DO
END DO
END DO
!
CALL lbc_lnk_multi( 'ldfdyn', dvsmagsq, 'T', 1. )
!
!== calculate gradients of divergence, then square of magnitude (f-point) ==!
DO jk = 1, jpkm1
DO jj = 1, jpjm1
DO ji = 1, jpim1
zdivdx = r1_2 * ( r1_e1t(ji,jj+1) * ( hdivn(ji+1,jj+1,jk) - hdivn(ji,jj+1,jk) ) &
& + r1_e1t(ji,jj) * ( hdivn(ji+1,jj,jk) - hdivn(ji,jj,jk) ) )
zdivdy = r1_2 * ( r1_e2t(ji+1,jj) * ( hdivn(ji+1,jj+1,jk) - hdivn(ji+1,jj,jk) ) &
& + r1_e2t(ji,jj) * ( hdivn(ji,jj+1,jk) - hdivn(ji,jj,jk) ) )
ddivmagsq(ji,jj,jk) = ( zdivdx**2 + zdivdy**2 ) * fmask(ji,jj,jk)
END DO
END DO
END DO
!
DO jk = 1, jpkm1 !== QG Leith viscosity coefficient on T-point ==!
DO jj = 2, jpjm1
DO ji = fs_2, fs_jpim1 ! vector opt.
zsqqg = r1_4 * ( ddivmagsq(ji,jj,jk) + ddivmagsq(ji-1,jj,jk) + ddivmagsq(ji,jj-1,jk) + &
& ddivmagsq(ji-1,jj-1,jk) ) + dvsmagsq(ji,jj,jk)
ahmt(ji,jj,jk) = SQRT( zcmqgl * esqt(ji,jj)**3 * zsqqg )
END DO
END DO
END DO
!
DO jk = 1, jpkm1 !== QG Leith viscosity coefficient on F-point ==!
DO jj = 1, jpjm1
DO ji = 1, fs_jpim1 ! vector opt.
zsqqg = r1_4 * ( dvsmagsq(ji,jj,jk) + dvsmagsq(ji+1,jj,jk) + dvsmagsq(ji,jj+1,jk) + &
& dvsmagsq(ji+1,jj+1,jk) ) + ddivmagsq(ji,jj,jk)
ahmf(ji,jj,jk) = SQRT( zcmqgl * esqf(ji,jj)**3 * zsqqg )
END DO
END DO
END DO
!
DEALLOCATE( zbu, zst, zwz )
!
ENDIF
!
CALL lbc_lnk_multi( 'ldfdyn', ahmt, 'T', 1., ahmf, 'F', 1. )
!
END SELECT
Part of me wonders whether I should replace un/vn
with ub/vb
and then calculate hdiv
inside the routine using ub/vb
.
Anyway, has anyone encountered an error like this before? And how did you fix it?
Cheers