Skip to content
Snippets Groups Projects
Commit 47d9ba60 authored by Christian Ethe's avatar Christian Ethe
Browse files

First step of TOP halo cleanup

parent a3735d3a
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
src/TOP/trc.F90
+ 15
− 15
View file @ 47d9ba60
......@@ -158,26 +158,26 @@ CONTAINS
!!-------------------------------------------------------------------
ierr(:) = 0
!
ALLOCATE( tr(jpi,jpj,jpk,jptra,jpt) , &
& trc_i(jpi,jpj,jptra) , trc_o(jpi,jpj,jptra) , &
& gtru (jpi,jpj,jptra) , gtrv (jpi,jpj,jptra) , &
& gtrui(jpi,jpj,jptra) , gtrvi(jpi,jpj,jptra) , &
& trc_ice_ratio(jptra) , trc_ice_prescr(jptra) , cn_trc_o(jptra) , &
& neln(jpi,jpj) , heup(jpi,jpj) , heup_01(jpi,jpj) , &
& etot(jpi,jpj,jpk) , etot_ndcy(jpi,jpj,jpk) , &
& sbc_trc_b(jpi,jpj,jptra), sbc_trc(jpi,jpj,jptra) , &
& cvol(jpi,jpj,jpk) , trai(jptra) , &
& ctrcnm(jptra) , ctrcln(jptra) , ctrcun(jptra) , &
& ln_trc_ini(jptra) , &
& ln_trc_sbc(jptra) , ln_trc_cbc(jptra) , ln_trc_obc(jptra) , &
& ln_trc_ais(jptra) , &
ALLOCATE( tr(jpi,jpj,jpk,jptra,jpt) , &
& gtru (jpi,jpj,jptra) , gtrv (jpi,jpj,jptra) , &
& gtrui(jpi,jpj,jptra) , gtrvi(jpi,jpj,jptra) , &
& trc_i(A2D(0),jptra) , trc_o(A2D(0),jptra) , &
& trc_ice_ratio(jptra) , trc_ice_prescr(jptra) , cn_trc_o(jptra) , &
& neln(A2D(0)) , heup(A2D(0)) , heup_01(A2D(0)) , &
& etot(A2D(0),jpk) , etot_ndcy(A2D(0),jpk) , &
& sbc_trc_b(A2D(0),jptra), sbc_trc(A2D(0),jptra) , &
& cvol(jpi,jpj,jpk) , trai(jptra) , &
& ctrcnm(jptra) , ctrcln(jptra) , ctrcun(jptra) , &
& ln_trc_ini(jptra) , &
& ln_trc_sbc(jptra) , ln_trc_cbc(jptra) , ln_trc_obc(jptra) , &
& ln_trc_ais(jptra) , &
& STAT = ierr(1) )
!
IF( ln_bdy ) ALLOCATE( trcdta_bdy(jptra, jp_bdy) , STAT = ierr(2) )
!
IF (jp_dia3d > 0 ) ALLOCATE( trc3d(jpi,jpj,jpk,jp_dia3d), STAT = ierr(3) )
IF (jp_dia3d > 0 ) ALLOCATE( trc3d(A2D(0),jpk,jp_dia3d), STAT = ierr(3) )
!
IF (jp_dia2d > 0 ) ALLOCATE( trc2d(jpi,jpj,jp_dia2d) , STAT = ierr(4) )
IF (jp_dia2d > 0 ) ALLOCATE( trc2d(A2D(0),jp_dia2d) , STAT = ierr(4) )
!
trc_alloc = MAXVAL( ierr )
IF( trc_alloc /= 0 ) CALL ctl_stop( 'STOP', 'trc_alloc: failed to allocate arrays' )
......
src/TOP/trcais.F90
+ 4
− 4
View file @ 47d9ba60
......@@ -169,7 +169,7 @@ CONTAINS
DO jn = 1, jptra
IF( ln_trc_ais(jn) ) THEN
jl = n_trc_indais(jn)
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
DO_2D( 0, 0, 0, 0 )
zfact = 1. / e3t(ji,jj,1,Kmm)
ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + fwficb(ji,jj) * r1_rho0 * ptr(ji,jj,1,jn,Kmm) * zfact
END_2D
......@@ -181,7 +181,7 @@ CONTAINS
DO jn = 1, jptra
IF( ln_trc_ais(jn) ) THEN
jl = n_trc_indais(jn)
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
DO_2D( 0, 0, 0, 0 )
IF( ln_isfpar_mlt ) THEN
zcalv = fwfisf_par(ji,jj) * r1_rho0 / rhisf_tbl_par(ji,jj)
ikt = misfkt_par(ji,jj)
......@@ -213,7 +213,7 @@ CONTAINS
DO jn = 1, jptra
IF( ln_trc_ais(jn) ) THEN
jl = n_trc_indais(jn)
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
DO_2D( 0, 0, 0, 0 )
DO jk = 1, icblev
zcalv = fwficb(ji,jj) * r1_rho0
ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + rf_trafac(jl) * zcalv / gdepw(ji,jj,icblev+1,Kmm)
......@@ -228,7 +228,7 @@ CONTAINS
DO jn = 1, jptra
IF( ln_trc_ais(jn) ) THEN
jl = n_trc_indais(jn)
DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
DO_2D( 0, 0, 0, 0 )
IF( ln_isfpar_mlt ) THEN
zcalv = - fwfisf_par(ji,jj) * r1_rho0 / rhisf_tbl_par(ji,jj)
ikt = misfkt_par(ji,jj)
......
src/TOP/trcbc.F90
+ 3
− 3
View file @ 47d9ba60
......@@ -414,7 +414,7 @@ CONTAINS
!
! Remove river dilution for tracers with absent river load
IF( ln_rnf_ctl .AND. .NOT.ln_trc_cbc(jn) ) THEN
DO_2D( 0, 0, 0, 1 )
DO_2D( 0, 0, 0, 0 )
DO jk = 1, nk_rnf(ji,jj)
#if defined key_RK3
zrnf = rnf(ji,jj) * r1_rho0 / h_rnf(ji,jj)
......@@ -432,7 +432,7 @@ CONTAINS
IF( ln_trc_sbc(jn) ) THEN
jl = n_trc_indsbc(jn)
sf_trcsbc(jl)%fnow(:,:,1) = MAX( rtrn, sf_trcsbc(jl)%fnow(:,:,1) ) ! avoid nedgative value due to interpolation
DO_2D( 0, 0, 0, 1 )
DO_2D( 0, 0, 0, 0 )
zfact = 1. / ( e3t(ji,jj,1,Kmm) * rn_sbc_time )
ptr(ji,jj,1,jn,Krhs) = ptr(ji,jj,1,jn,Krhs) + rf_trsfac(jl) * sf_trcsbc(jl)%fnow(ji,jj,1) * zfact
END_2D
......@@ -443,7 +443,7 @@ CONTAINS
IF( l_offline ) rn_rfact = 1._wp
jl = n_trc_indcbc(jn)
sf_trccbc(jl)%fnow(:,:,1) = MAX( rtrn, sf_trccbc(jl)%fnow(:,:,1) ) ! avoid nedgative value due to interpolation
DO_2D( 0, 0, 0, 1 )
DO_2D( 0, 0, 0, 0 )
DO jk = 1, nk_rnf(ji,jj)
zfact = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_cbc_time )
ptr(ji,jj,jk,jn,Krhs) = ptr(ji,jj,jk,jn,Krhs) + rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zfact
......
src/TOP/trcnam.F90
+ 6
− 1
View file @ 47d9ba60
......@@ -254,7 +254,12 @@ CONTAINS
WRITE(numout,*) ' Namelist : namtrc_dcy '
WRITE(numout,*) ' Diurnal cycle for TOP ln_trcdc2dm = ', ln_trcdc2dm
ENDIF
! ! Define logical parameter ton control dirunal cycle in TOP
l_trcdm2dc = ( ln_trcdc2dm .AND. .NOT. ln_dm2dc )
!
IF( l_trcdm2dc .AND. lwp ) CALL ctl_warn( 'Coupling with passive tracers and used of diurnal cycle.', &
& 'Computation of a daily mean shortwave for some biogeochemical models ' )
!
END SUBROUTINE trc_nam_dcy
SUBROUTINE trc_nam_trd
......
src/TOP/trcopt.F90
+ 1
− 1
View file @ 47d9ba60
......@@ -348,7 +348,7 @@ CONTAINS
!! *** ROUTINE trc_opt_alloc ***
!!----------------------------------------------------------------------
!
ALLOCATE( ekb(jpi,jpj,jpk), ekr(jpi,jpj,jpk), &
ALLOCATE( ekb(jpi,jpj,jpk),ekr(jpi,jpj,jpk), &
ekg(jpi,jpj,jpk),zeps(jpi,jpj,jpk), STAT= trc_opt_alloc )
!
IF( trc_opt_alloc /= 0 ) CALL ctl_stop( 'STOP', 'trc_opt_alloc : failed to allocate arrays.' )
......
src/TOP/trcstp.F90
+ 5
− 21
View file @ 47d9ba60
......@@ -37,6 +37,8 @@ MODULE trcstp
REAL(wp) :: rsecfst, rseclast ! ???
REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE :: qsr_arr ! save qsr during TOP time-step
!! * Substitutions
# include "do_loop_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018)
......@@ -74,17 +76,13 @@ CONTAINS
ll_trcstat = ( sn_cfctl%l_trcstat ) .AND. &
& ( ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) )
IF( kt == nittrc000 ) CALL trc_stp_ctl ! control
IF( kt == nittrc000 .AND. lk_trdmxl_trc ) CALL trd_mxl_trc_init ! trends: Mixed-layer
!
IF( .NOT.ln_linssh ) THEN ! update ocean volume due to ssh temporal evolution
DO jk = 1, jpk
cvol(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk)
END DO
IF ( ll_trcstat .OR. kt == nitrst .OR. ( ln_check_mass .AND. kt == nitend ) &
& .OR. iom_use( "pno3tot" ) .OR. iom_use( "ppo4tot" ) .OR. iom_use( "psiltot" ) &
& .OR. iom_use( "palktot" ) .OR. iom_use( "pfertot" ) ) &
& areatot = glob_sum( 'trcstp', cvol(:,:,:) )
IF ( ll_trcstat .OR. kt == nitrst ) areatot = glob_sum( 'trcstp', cvol(:,:,:) )
ENDIF
!
IF( l_trcdm2dc ) CALL trc_mean_qsr( kt )
......@@ -141,20 +139,6 @@ CONTAINS
END SUBROUTINE trc_stp
SUBROUTINE trc_stp_ctl
!!----------------------------------------------------------------------
!! *** ROUTINE trc_stp_ctl ***
!!----------------------------------------------------------------------
!
! Define logical parameter ton control dirunal cycle in TOP
l_trcdm2dc = ( ln_trcdc2dm .AND. .NOT. ln_dm2dc )
!
IF( l_trcdm2dc .AND. lwp ) CALL ctl_warn( 'Coupling with passive tracers and used of diurnal cycle.', &
& 'Computation of a daily mean shortwave for some biogeochemical models ' )
!
END SUBROUTINE trc_stp_ctl
SUBROUTINE trc_mean_qsr( kt )
!!----------------------------------------------------------------------
!! *** ROUTINE trc_mean_qsr ***
......@@ -188,7 +172,7 @@ CONTAINS
WRITE(numout,*)
ENDIF
!
ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_day ) )
ALLOCATE( qsr_arr(A2D(0),nb_rec_per_day ) )
!
! !* Restart: read in restart file
IF( ln_rsttr .AND. nn_rsttr /= 0 .AND. iom_varid( numrtr, 'qsr_mean' , ldstop = .FALSE. ) > 0 &
......@@ -239,7 +223,7 @@ CONTAINS
qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1)
ENDDO
qsr_arr (:,:,nb_rec_per_day) = qsr(:,:)
qsr_mean(:,: ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_day
qsr_mean(:,:) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_day
ENDIF
!
IF( lrst_trc ) THEN !* Write the mean of qsr in restart file
......
src/TOP/trcstp_rk3.F90
+ 9
− 28
View file @ 47d9ba60
......@@ -41,6 +41,8 @@ MODULE trcstp_rk3
REAL(wp) :: rsecfst, rseclast ! ???
REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE :: qsr_arr ! save qsr during TOP time-step
!! * Substitutions
# include "do_loop_substitute.h90"
# include "domzgr_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/TOP 4.0 , NEMO Consortium (2018)
......@@ -71,15 +73,14 @@ CONTAINS
l_trcstat = ( sn_cfctl%l_trcstat ) .AND. &
& ( ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) )
!
IF( kt == nittrc000 ) CALL trc_stp_ctl ! control
IF( kt == nittrc000 ) CALL trc_stpsctl ! control
IF( kt == nittrc000 .AND. lk_trdmxl_trc ) CALL trd_mxl_trc_init ! trends: Mixed-layer
!
IF( .NOT.ln_linssh ) THEN ! update ocean volume due to ssh temporal evolution
DO jk = 1, jpk
cvol(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk)
END DO
IF( l_trcstat .OR. kt == nitrst .OR. ( ln_check_mass .AND. kt == nitend ) ) &
& areatot = glob_sum( 'trcstp', cvol(:,:,:) )
IF( l_trcstat .OR. kt == nitrst ) areatot = glob_sum( 'trcstp', cvol(:,:,:) )
ENDIF
!
IF( l_trcdm2dc ) CALL trc_mean_qsr( kt )
......@@ -146,22 +147,6 @@ CONTAINS
END SUBROUTINE trc_stp_end
SUBROUTINE trc_stp_ctl
!!----------------------------------------------------------------------
!! *** ROUTINE trc_stp_ctl ***
!! ** Purpose : Control + ocean volume
!!----------------------------------------------------------------------
!
! Define logical parameter ton control dirunal cycle in TOP
l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 .AND. ncpl_qsr_freq /= 0 )
l_trcdm2dc = l_trcdm2dc .AND. .NOT. l_offline
!
IF( l_trcdm2dc .AND. lwp ) CALL ctl_warn( 'Coupling with passive tracers and used of diurnal cycle.', &
& 'Computation of a daily mean shortwave for some biogeochemical models ' )
!
END SUBROUTINE trc_stp_ctl
SUBROUTINE trc_mean_qsr( kt )
!!----------------------------------------------------------------------
!! *** ROUTINE trc_mean_qsr ***
......@@ -185,13 +170,9 @@ CONTAINS
IF( ln_timing ) CALL timing_start('trc_mean_qsr')
!
IF( kt == nittrc000 ) THEN
IF( ln_cpl ) THEN
rdt_sampl = rday / ncpl_qsr_freq
nb_rec_per_day = ncpl_qsr_freq
ELSE
rdt_sampl = MAX( 3600., rn_Dt )
nb_rec_per_day = INT( rday / rdt_sampl )
ENDIF
!
rdt_sampl = REAL( ncpl_qsr_freq )
nb_rec_per_day = INT( rday / ncpl_qsr_freq )
!
IF(lwp) THEN
WRITE(numout,*)
......@@ -199,7 +180,7 @@ CONTAINS
WRITE(numout,*)
ENDIF
!
ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_day ) )
ALLOCATE( qsr_arr(A2D(0),nb_rec_per_day ) )
!
! !* Restart: read in restart file
IF( ln_rsttr .AND. nn_rsttr /= 0 .AND. iom_varid( numrtr, 'qsr_mean' , ldstop = .FALSE. ) > 0 &
......@@ -250,7 +231,7 @@ CONTAINS
qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1)
END DO
qsr_arr (:,:,nb_rec_per_day) = qsr(:,:)
qsr_mean(:,: ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_day
qsr_mean(:,:) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_day
ENDIF
!
IF( lrst_trc ) THEN !* Write the mean of qsr in restart file
......
src/TOP/trcwri.F90
+ 20
− 16
View file @ 47d9ba60
......@@ -42,12 +42,12 @@ CONTAINS
INTEGER, INTENT( in ) :: kt
INTEGER, INTENT( in ) :: Kmm ! time level indices
!
INTEGER :: jk, jn
INTEGER :: ji,jj,jk,jn
CHARACTER (len=20) :: cltra
CHARACTER (len=40) :: clhstnam
INTEGER :: inum = 11 ! temporary logical unit
REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d ! 3D workspace
!!---------------------------------------------------------------------
REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z3d ! 3D workspace
!!----------------------------------------------------------------------
!
IF( ln_timing ) CALL timing_start('trc_wri')
!
......@@ -58,6 +58,8 @@ CONTAINS
WRITE(inum,*) clhstnam
CLOSE(inum)
ENDIF
ALLOCATE( z3d(A2D(0),jpk) ) ; z3d(A2D(0),:) = 0._wp
! Output of initial vertical scale factor
CALL iom_put( "e3t_0", e3t_0(:,:,:) )
......@@ -66,25 +68,27 @@ CONTAINS
!
IF( .NOT.ln_linssh ) CALL iom_put( "ssh" , ssh(:,:,Kmm) ) ! sea surface height
!
IF ( iom_use("e3t") ) THEN ! time-varying e3t
DO jk = 1, jpk
z3d(:,:,jk) = e3t(:,:,jk,Kmm)
END DO
CALL iom_put( "e3t", z3d(:,:,:) )
! --- vertical scale factors --- !
IF( iom_use("e3t") ) THEN ! time-varying e3t
DO_3D( 0, 0, 0, 0, 1, jpk )
z3d(ji,jj,jk) = e3t(ji,jj,jk,Kmm)
END_3D
CALL iom_put( "e3t", z3d )
ENDIF
IF ( iom_use("e3u") ) THEN ! time-varying e3u
DO jk = 1, jpk
z3d(:,:,jk) = e3u(:,:,jk,Kmm)
END DO
CALL iom_put( "e3u", z3d(:,:,:) )
DO_3D( 0, 0, 0, 0, 1, jpk )
z3d(ji,jj,jk) = e3u(ji,jj,jk,Kmm)
END_3D
CALL iom_put( "e3u" , z3d )
ENDIF
IF ( iom_use("e3v") ) THEN ! time-varying e3v
DO jk = 1, jpk
z3d(:,:,jk) = e3v(:,:,jk,Kmm)
END DO
CALL iom_put( "e3v", z3d(:,:,:) )
DO_3D( 0, 0, 0, 0, 1, jpk )
z3d(ji,jj,jk) = e3v(ji,jj,jk,Kmm)
END_3D
CALL iom_put( "e3v" , z3d )
ENDIF
!
DEALLOCATE( z3d )
ENDIF
!
! write the tracer concentrations in the file
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment