Skip to content
Snippets Groups Projects
Commit 3c836781 authored by Andrew Coward's avatar Andrew Coward
Browse files

Merge branch...

Merge branch '54-robust-and-accurate-passive-tracer-restart-mechanism-for-configurations-with-forward' into 'branch_4.2'

Resolve "Robust and accurate passive-tracer restart mechanism for configurations with forward Euler time stepping of passive tracers"

See merge request nemo/nemo!96
parents 0b4a38d9 4a8cbbdc
No related branches found
No related tags found
No related merge requests found
......@@ -54,12 +54,7 @@ CONTAINS
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) ' trc_sms_age: AGE model'
IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
IF( l_1st_euler .OR. ln_top_euler ) THEN
tr(:,:,:,jp_age,Kbb) = tr(:,:,:,jp_age,Kmm)
ENDIF
!
DO jk = 1, nla_age
tr(:,:,jk,jp_age,Krhs) = rn_age_kill_rate * tr(:,:,jk,jp_age,Kbb)
END DO
......
......@@ -104,13 +104,7 @@ CONTAINS
IF(lwp) write(numout,*) ' PISCES Biology time step rfact2 = ', rfact2
IF(lwp) WRITE(numout,*)
ENDIF
IF( l_1st_euler .OR. ln_top_euler ) THEN
DO jn = jp_pcs0, jp_pcs1 ! SMS on tracer without Asselin time-filter
tr(:,:,:,jn,Kbb) = tr(:,:,:,jn,Kmm)
END DO
ENDIF
!
DO jn = jp_pcs0, jp_pcs1 ! Store the tracer concentrations before entering PISCES
ztrbbio(:,:,:,jn) = tr(:,:,:,jn,Kbb)
END DO
......
......@@ -133,9 +133,14 @@ CONTAINS
CALL iom_get( numrtr, jpdom_auto, 'TRN'//ctrcnm(jn), tr(:,:,:,jn,Kmm) )
END DO
DO jn = 1, jptra
CALL iom_get( numrtr, jpdom_auto, 'TRB'//ctrcnm(jn), tr(:,:,:,jn,Kbb) )
END DO
IF( l_1st_euler .OR. ln_top_euler ) THEN
IF(lwp) WRITE(numout,*) ' + adjustment for forward Euler time stepping'
tr(:,:,:,1:jptra,Kbb) = tr(:,:,:,1:jptra,Kmm)
ELSE
DO jn = 1, jptra
CALL iom_get( numrtr, jpdom_auto, 'TRB'//ctrcnm(jn), tr(:,:,:,jn,Kbb) )
END DO
END IF
!
IF(.NOT.lrxios) CALL iom_delay_rst( 'READ', 'TOP', numrtr ) ! read only TOP delayed global communication variables
END SUBROUTINE trc_rst_read
......
......@@ -115,7 +115,6 @@ CONTAINS
IF(lrxios) CALL iom_context_finalize( cr_toprst_cxt )
IF(lwm) CALL FLUSH( numont ) ! flush namelist output
ENDIF
IF( lrst_trc ) CALL trc_rst_wri ( kt, Kmm, Kaa, Kbb ) ! write tracer restart file
IF( lk_trdmxl_trc ) CALL trd_mxl_trc ( kt, Kaa ) ! trends: Mixed-layer
!
IF( ln_top_euler ) THEN
......@@ -125,6 +124,8 @@ CONTAINS
tr(:,:,:,:,Kmm) = tr(:,:,:,:,Kaa)
ENDIF
!
IF( lrst_trc ) CALL trc_rst_wri( kt, Kmm, Kaa, Kbb ) ! write tracer restart file
!
IF (ll_trcstat) THEN
ztrai = 0._wp ! content of all tracers
DO jn = 1, jptra
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment