- Timestamp:
- 2018-07-23T11:33:03+02:00 (6 years ago)
- Location:
- branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/TOP_SRC/TRP
- Files:
-
- 8 edited
-
trcadv.F90 (modified) (4 diffs)
-
trcbbl.F90 (modified) (3 diffs)
-
trcdmp.F90 (modified) (5 diffs)
-
trcldf.F90 (modified) (3 diffs)
-
trcnam_trp.F90 (modified) (3 diffs)
-
trcnxt.F90 (modified) (2 diffs)
-
trcsbc.F90 (modified) (3 diffs)
-
trctrp.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
r7960 r9987 26 26 USE traadv_mle ! ML eddy induced velocity (tra_adv_mle routine) 27 27 USE ldftra_oce ! lateral diffusion coefficient on tracers 28 USE trd_oce 29 USE trdtra 28 30 USE prtctl_trc ! Print control 29 31 … … 71 73 INTEGER, INTENT(in) :: kt ! ocean time-step index 72 74 ! 73 INTEGER :: jk 75 INTEGER :: jk, jn 74 76 CHARACTER (len=22) :: charout 75 77 REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn ! effective velocity 78 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrtrd 76 79 !!---------------------------------------------------------------------- 77 80 ! … … 111 114 IF( ln_mle ) CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' ) ! add the mle transport (if necessary) 112 115 ! 116 IF( l_trdtrc ) THEN 117 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd ) 118 ztrtrd(:,:,:,:) = tra(:,:,:,:) 119 ENDIF 120 ! 113 121 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! 114 122 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, nittrc000, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) ! 2nd order centered … … 140 148 ! 141 149 END SELECT 150 ! 151 IF( l_trdtrc ) THEN ! save the advective trends for further diagnostics 152 DO jn = 1, jptra 153 ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) 154 CALL trd_tra( kt, 'TRC', jn, jptra_totad, ztrtrd(:,:,:,jn) ) 155 END DO 156 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) 157 ENDIF 142 158 143 159 ! ! print mean trends (used for debugging) -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90
r7960 r9987 53 53 INTEGER, INTENT( in ) :: kt ! ocean time-step 54 54 CHARACTER (len=22) :: charout 55 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrtrd55 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztrtrd 56 56 !!---------------------------------------------------------------------- 57 57 ! … … 64 64 65 65 IF( l_trdtrc ) THEN 66 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd) ! temporary save of trends66 ALLOCATE(ztrtrd( 1:jpi, 1:jpj, 1:jpk, 1:jptra )) ! temporary save of trends 67 67 ztrtrd(:,:,:,:) = tra(:,:,:,:) 68 68 ENDIF … … 95 95 CALL trd_tra( kt, 'TRC', jn, jptra_bbl, ztrtrd(:,:,:,jn) ) 96 96 END DO 97 CALL wrk_dealloc( jpi, jpj, jpk, jptra,ztrtrd ) ! temporary save of trends97 DEALLOCATE(ztrtrd ) ! temporary save of trends 98 98 ENDIF 99 99 ! -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
r7960 r9987 35 35 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: restotr ! restoring coeff. on tracers (s-1) 36 36 37 INTEGER, PARAMETER :: npncts = 5! number of closed sea37 INTEGER, PARAMETER :: npncts = 8 ! number of closed sea 38 38 INTEGER, DIMENSION(npncts) :: nctsi1, nctsj1 ! south-west closed sea limits (i,j) 39 39 INTEGER, DIMENSION(npncts) :: nctsi2, nctsj2 ! north-east closed sea limits (i,j) … … 107 107 108 108 jl = n_trc_index(jn) 109 CALL trc_dta( kt, sf_trcdta(jl),rf_trfac(jl) ) ! read tracer data at nit000 110 ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:) 109 CALL trc_dta( kt, sf_trcdta(jl), rf_trfac(jl), ztrcdta ) ! read tracer data at nit000 111 110 112 111 SELECT CASE ( nn_zdmp_tr ) … … 208 207 ! 209 208 ! Caspian Sea 210 nctsi1(1) = 332 ; nctsj1(1) = 243 - isrow 211 nctsi2(1) = 344 ; nctsj2(1) = 275 - isrow 209 nctsi1(1) = 333 ; nctsj1(1) = 243 - isrow 210 nctsi2(1) = 342 ; nctsj2(1) = 274 - isrow 211 ! ! Lake Superior 212 nctsi1(2) = 198 ; nctsj1(2) = 258 - isrow 213 nctsi2(2) = 204 ; nctsj2(2) = 262 - isrow 214 ! ! Lake Michigan 215 nctsi1(3) = 201 ; nctsj1(3) = 250 - isrow 216 nctsi2(3) = 203 ; nctsj2(3) = 256 - isrow 217 ! ! Lake Huron 218 nctsi1(4) = 204 ; nctsj1(4) = 252 - isrow 219 nctsi2(4) = 209 ; nctsj2(4) = 256 - isrow 220 ! ! Lake Erie 221 nctsi1(5) = 206 ; nctsj1(5) = 249 - isrow 222 nctsi2(5) = 209 ; nctsj2(5) = 251 - isrow 223 ! ! Lake Ontario 224 nctsi1(6) = 210 ; nctsj1(6) = 252 - isrow 225 nctsi2(6) = 212 ; nctsj2(6) = 252 - isrow 226 ! ! Victoria Lake 227 nctsi1(7) = 321 ; nctsj1(7) = 180 - isrow 228 nctsi2(7) = 322 ; nctsj2(7) = 189 - isrow 229 ! ! Baltic Sea 230 nctsi1(8) = 297 ; nctsj1(8) = 270 - isrow 231 nctsi2(8) = 308 ; nctsj2(8) = 293 - isrow 212 232 ! 213 233 ! ! ======================= … … 283 303 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 284 304 jl = n_trc_index(jn) 285 CALL trc_dta( kt, sf_trcdta(jl),rf_trfac(jl) ) ! read tracer data at nit000 286 ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:) 305 CALL trc_dta( kt, sf_trcdta(jl), rf_trfac(jl), ztrcdta ) ! read tracer data at nit000 287 306 DO jc = 1, npncts 288 307 DO jk = 1, jpkm1 289 308 DO jj = nctsj1(jc), nctsj2(jc) 290 309 DO ji = nctsi1(jc), nctsi2(jc) 291 trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk) * tmask(ji,jj,jk)310 trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk) 292 311 trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 293 312 ENDDO … … 317 336 IF( nn_timing == 1 ) CALL timing_start('trc_dmp_init') 318 337 ! 338 !Allocate arrays 339 IF( trc_dmp_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'trc_dmp_init: unable to allocate arrays' ) 319 340 320 341 IF( lzoom ) nn_zdmp_tr = 0 ! restoring to climatology at closed north or south boundaries -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
r7960 r9987 56 56 INTEGER, INTENT( in ) :: kt ! ocean time-step index 57 57 !! 58 INTEGER :: jn 58 INTEGER :: ji, jj, jk, jn 59 REAL(wp) :: zdep 59 60 CHARACTER (len=22) :: charout 60 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrtrd61 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztrtrd 61 62 !!---------------------------------------------------------------------- 62 63 ! … … 66 67 67 68 rldf = rldf_rat 68 69 ! 70 r_fact_lap(:,:,:) = 1. 71 DO jk= 1, jpk 72 DO jj = 1, jpj 73 DO ji = 1, jpi 74 IF( fsdept(ji,jj,jk) > 200. .AND. gphit(ji,jj) < 5. .AND. gphit(ji,jj) > -5. ) THEN 75 zdep = MAX( fsdept(ji,jj,jk) - 1000., 0. ) / 1000. 76 r_fact_lap(ji,jj,jk) = MAX( 1., rn_fact_lap * EXP( -zdep ) ) 77 ENDIF 78 END DO 79 END DO 80 END DO 81 ! 69 82 IF( l_trdtrc ) THEN 70 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd)83 ALLOCATE( ztrtrd ( 1:jpi, 1:jpj, 1:jpk, 1:jptra) ) 71 84 ztrtrd(:,:,:,:) = tra(:,:,:,:) 72 85 ENDIF … … 107 120 CALL trd_tra( kt, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) ) 108 121 END DO 109 CALL wrk_dealloc( jpi, jpj, jpk, jptra,ztrtrd )122 DEALLOCATE( ztrtrd ) 110 123 ENDIF 111 124 ! ! print mean trends (used for debugging) -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90
r7960 r9987 40 40 REAL(wp), PUBLIC :: rn_ahtrc_0 !: diffusivity coefficient for passive tracer (m2/s) 41 41 REAL(wp), PUBLIC :: rn_ahtrb_0 !: background diffusivity coefficient for passive tracer (m2/s) 42 REAL(wp), PUBLIC :: rn_fact_lap !: Enhanced zonal diffusivity coefficent in the equatorial domain 42 43 43 44 ! !!: ** Treatment of Negative concentrations ( nam_trcrad ) … … 74 75 NAMELIST/namtrc_ldf/ ln_trcldf_lap , & 75 76 & ln_trcldf_bilap, ln_trcldf_level, & 76 & ln_trcldf_hor , ln_trcldf_iso , rn_ahtrc_0, rn_ahtrb_0 77 & ln_trcldf_hor , ln_trcldf_iso , rn_ahtrc_0, rn_ahtrb_0, & 78 & rn_fact_lap 79 77 80 NAMELIST/namtrc_zdf/ ln_trczdf_exp , nn_trczdf_exp 78 81 NAMELIST/namtrc_rad/ ln_trcrad … … 127 130 WRITE(numout,*) ' diffusivity coefficient rn_ahtrc_0 = ', rn_ahtrc_0 128 131 WRITE(numout,*) ' background hor. diffusivity rn_ahtrb_0 = ', rn_ahtrb_0 132 WRITE(numout,*) ' enhanced zonal diffusivity rn_fact_lap = ', rn_fact_lap 129 133 ENDIF 130 134 -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
r7960 r9987 102 102 ENDIF 103 103 104 #if defined key_agrif 105 CALL Agrif_trc ! AGRIF zoom boundaries 106 #endif 104 107 ! Update after tracer on domain lateral boundaries 105 108 DO jn = 1, jptra … … 110 113 #if defined key_bdy 111 114 !! CALL bdy_trc( kt ) ! BDY open boundaries 112 #endif113 #if defined key_agrif114 CALL Agrif_trc ! AGRIF zoom boundaries115 115 #endif 116 116 -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
r7960 r9987 102 102 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 103 103 104 IF( ln_rsttr .AND. & ! Restart: read in restart file 105 iom_varid( numrtr, 'sbc_'//TRIM(ctrcnm(1))//'_b', ldstop = .FALSE. ) > 0 ) THEN 106 IF(lwp) WRITE(numout,*) ' nittrc000-nn_dttrc surface tracer content forcing fields red in the restart file' 107 zfact = 0.5_wp 108 DO jn = 1, jptra 109 CALL iom_get( numrtr, jpdom_autoglo, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc_b(:,:,jn) ) ! before tracer content sbc 110 END DO 111 ELSE ! No restart or restart not found: Euler forward time stepping 104 !! JPALM -- 12-01-2016 -- problem after restart, maybe because of this... 105 !! -- set sbc_trc_b to 0 after restart, first, to check. 106 !!------------------------------------------------------------------------------ 107 ! IF( ln_rsttr .AND. .NOT.ln_top_euler .AND. & ! Restart: read in restart file 108 ! iom_varid( numrtr, 'sbc_'//TRIM(ctrcnm(1))//'_b', ldstop = .FALSE. ) > 0 ) THEN 109 ! IF(lwp) WRITE(numout,*) ' nittrc000-nn_dttrc surface tracer content forcing fields red in the restart file' 110 ! zfact = 0.5_wp 111 ! DO jn = 1, jptra 112 ! CALL iom_get( numrtr, jpdom_autoglo, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc_b(:,:,jn) ) ! before tracer content sbc 113 ! END DO 114 ! ELSE ! No restart or restart not found: Euler forward time stepping 112 115 zfact = 1._wp 113 116 sbc_trc_b(:,:,:) = 0._wp 114 ENDIF117 ! ENDIF 115 118 ELSE ! Swap of forcing fields 116 119 IF( ln_top_euler ) THEN … … 170 173 END DO 171 174 ENDIF 175 ! 176 CALL lbc_lnk( sbc_trc(:,:,jn), 'T', 1. ) 172 177 ! Concentration dilution effect on tracers due to evaporation & precipitation 173 178 DO jj = 2, jpj … … 188 193 ! Write in the tracer restar file 189 194 ! ******************************* 190 IF( lrst_trc ) THEN195 IF( lrst_trc .AND. .NOT.ln_top_euler ) THEN 191 196 IF(lwp) WRITE(numout,*) 192 197 IF(lwp) WRITE(numout,*) 'sbc : ocean surface tracer content forcing fields written in tracer restart file ', & -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
r7960 r9987 27 27 USE trcsbc ! surface boundary condition (trc_sbc routine) 28 28 USE zpshde ! partial step: hor. derivative (zps_hde routine) 29 # if defined key_debug_medusa 30 USE trcrst 31 # endif 32 29 33 30 34 #if defined key_agrif … … 65 69 ! 66 70 CALL trc_sbc( kstp ) ! surface boundary condition 71 # if defined key_debug_medusa 72 IF(lwp) WRITE(numout,*) ' MEDUSA trc_trp after trc_sbc at kt =', kstp 73 CALL trc_rst_tra_stat 74 CALL flush(numout) 75 # endif 67 76 IF( lk_trabbl ) CALL trc_bbl( kstp ) ! advective (and/or diffusive) bottom boundary layer scheme 68 77 IF( ln_trcdmp ) CALL trc_dmp( kstp ) ! internal damping trends 69 IF( ln_trcdmp_clo ) CALL trc_dmp_clo( kstp ) ! internal damping trends on closed seas only70 78 CALL trc_adv( kstp ) ! horizontal & vertical advection 79 IF( ln_zps ) THEN 80 IF( ln_isfcav ) THEN ; CALL zps_hde_isf( kstp, jptra, trb, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi ) ! both top & bottom 81 ELSE ; CALL zps_hde ( kstp, jptra, trb, gtru, gtrv ) ! only bottom 82 ENDIF 83 ENDIF 71 84 CALL trc_ldf( kstp ) ! lateral mixing 72 85 IF( .NOT. lk_offline .AND. lk_zdfkpp ) & … … 77 90 CALL trc_zdf( kstp ) ! vertical mixing and after tracer fields 78 91 CALL trc_nxt( kstp ) ! tracer fields at next time step 92 # if defined key_debug_medusa 93 IF(lwp) WRITE(numout,*) ' MEDUSA trc_trp after trc_nxt at kt =', kstp 94 CALL trc_rst_tra_stat 95 CALL flush(numout) 96 # endif 79 97 IF( ln_trcrad ) CALL trc_rad( kstp ) ! Correct artificial negative concentrations 98 IF( ln_trcdmp_clo ) CALL trc_dmp_clo( kstp ) ! internal damping trends on closed seas only 80 99 81 100 #if defined key_agrif … … 83 102 #endif 84 103 85 IF( ln_zps .AND. .NOT. ln_isfcav) &86 & CALL zps_hde ( kstp, jptra, trn, gtru, gtrv ) ! Partial steps: now horizontal gradient of passive87 IF( ln_zps .AND. ln_isfcav) &88 & CALL zps_hde_isf( kstp, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi ) ! Partial steps: now horizontal gradient of passive89 ! tracers at the bottom ocean level90 !91 104 ELSE ! 1D vertical configuration 92 105 CALL trc_sbc( kstp ) ! surface boundary condition … … 100 113 ! 101 114 IF( nn_timing == 1 ) CALL timing_stop('trc_trp') 115 ! 116 9400 FORMAT(a25,i4,D23.16) 102 117 ! 103 118 END SUBROUTINE trc_trp
Note: See TracChangeset
for help on using the changeset viewer.
