- Timestamp:
- 2015-12-01T16:35:30+01:00 (8 years ago)
- Location:
- branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/TOP_SRC/TRP
- Files:
-
- 4 deleted
- 10 edited
- 4 copied
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
r4610 r5965 83 83 IF( kt == nittrc000 ) CALL trc_adv_ctl ! initialisation & control of options 84 84 85 IF( ln_top_euler) THEN 86 r2dt(:) = rdttrc(:) ! = rdttrc (use Euler time stepping) 87 ELSE 88 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ! at nittrc000 89 r2dt(:) = rdttrc(:) ! = rdttrc (restarting with Euler time stepping) 90 ELSEIF( kt <= nittrc000 + 1 ) THEN ! at nittrc000 or nittrc000+1 91 r2dt(:) = 2. * rdttrc(:) ! = 2 rdttrc (leapfrog) 92 ENDIF 85 IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN ! at nittrc000 86 r2dt(:) = rdttrc(:) ! = rdttrc (use or restarting with Euler time stepping) 87 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ! at nittrc000 or nittrc000+1 88 r2dt(:) = 2. * rdttrc(:) ! = 2 rdttrc (leapfrog) 93 89 ENDIF 94 95 90 ! ! effective transport 96 91 DO jk = 1, jpkm1 -
branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90
r4513 r5965 25 25 USE trabbl ! 26 26 USE prtctl_trc ! Print control for debbuging 27 USE trd mod_oce27 USE trd_oce 28 28 USE trdtra 29 29 … … 93 93 DO jn = 1, jptra 94 94 ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) 95 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_bbl, ztrtrd(:,:,:,jn) )95 CALL trd_tra( kt, 'TRC', jn, jptra_bbl, ztrtrd(:,:,:,jn) ) 96 96 END DO 97 97 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) ! temporary save of trends -
branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
r4359 r5965 23 23 USE prtctl_trc ! Print control for debbuging 24 24 USE trdtra 25 USE trdmod_oce 25 USE trd_oce 26 USE iom 26 27 27 28 IMPLICIT NONE … … 42 43 !!---------------------------------------------------------------------- 43 44 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 44 !! $ Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcdmp.F90,v 1.11 2006/09/01 14:03:49 opalod Exp$45 !! $Id$ 45 46 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 46 47 !!---------------------------------------------------------------------- … … 75 76 !! ** Action : - update the tracer trends tra with the newtonian 76 77 !! damping trends. 77 !! - save the trends ('key_trdm ld_trc')78 !! - save the trends ('key_trdmxl_trc') 78 79 !!---------------------------------------------------------------------- 79 80 !! … … 125 126 DO jj = 2, jpjm1 126 127 DO ji = fs_2, fs_jpim1 ! vector opt. 127 IF( avt(ji,jj,jk) <= 5.e-4 ) THEN128 IF( avt(ji,jj,jk) <= 5.e-4_wp ) THEN 128 129 ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 129 130 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra … … 151 152 IF( l_trdtrc ) THEN 152 153 ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) 153 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_dmp, ztrtrd )154 CALL trd_tra( kt, 'TRC', jn, jptra_dmp, ztrtrd ) 154 155 END IF 155 156 ! ! =========== … … 184 185 INTEGER, INTENT( in ) :: kt ! ocean time-step index 185 186 ! 186 INTEGER :: ji, jj, jk, jn, jl, jc ! dummy loop indicesa 187 INTEGER :: ji , jj, jk, jn, jl, jc ! dummy loop indicesa 188 INTEGER :: isrow ! local index 187 189 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace 188 190 … … 200 202 ! 201 203 SELECT CASE ( jp_cfg ) 204 ! ! ======================= 205 CASE ( 1 ) ! eORCA_R1 configuration 206 ! ! ======================= 207 isrow = 332 - jpjglo 208 ! 209 ! Caspian Sea 210 nctsi1(1) = 332 ; nctsj1(1) = 243 - isrow 211 nctsi2(1) = 344 ; nctsj2(1) = 275 - isrow 212 ! 202 213 ! ! ======================= 203 214 CASE ( 2 ) ! ORCA_R2 configuration … … 302 313 !!---------------------------------------------------------------------- 303 314 ! 315 INTEGER :: imask !local file handle 316 304 317 IF( nn_timing == 1 ) CALL timing_start('trc_dmp_init') 305 318 ! 306 SELECT CASE ( nn_hdmp_tr )307 CASE ( -1 ) ; IF(lwp) WRITE(numout,*) ' tracer damping in the Med & Red seas only'308 CASE ( 1:90 ) ; IF(lwp) WRITE(numout,*) ' tracer damping poleward of', nn_hdmp_tr, ' degrees'309 CASE DEFAULT310 WRITE(ctmp1,*) ' bad flag value for nn_hdmp_tr = ', nn_hdmp_tr311 CALL ctl_stop(ctmp1)312 END SELECT313 319 314 320 IF( lzoom ) nn_zdmp_tr = 0 ! restoring to climatology at closed north or south boundaries … … 325 331 & CALL ctl_stop( 'passive trace damping need key_tradmp to compute damping coef.' ) 326 332 ! 327 ! ! Damping coefficients initialization328 IF( lzoom ) THEN ; CALL dtacof_zoom( restotr )329 ELSE ; CALL dtacof( nn_hdmp_tr, rn_surf_tr, rn_bot_tr, rn_dep_tr, &330 & nn_file_tr, 'TRC' , restotr)331 ENDIF333 ! ! Read damping coefficients from file 334 !Read in mask from file 335 CALL iom_open ( cn_resto_tr, imask) 336 CALL iom_get ( imask, jpdom_autoglo, 'resto', restotr) 337 CALL iom_close( imask ) 332 338 ! 333 339 IF( nn_timing == 1 ) CALL timing_stop('trc_dmp_init') -
branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
r3294 r5965 25 25 USE traldf_iso_grif ! lateral mixing (tra_ldf_iso_grif routine) 26 26 USE traldf_lap ! lateral mixing (tra_ldf_lap routine) 27 USE trd mod_oce27 USE trd_oce 28 28 USE trdtra 29 29 USE prtctl_trc ! Print control … … 73 73 74 74 SELECT CASE ( nldf ) ! compute lateral mixing trend and add it to the general trend 75 CASE ( 0 ) ; CALL tra_ldf_lap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra) ! iso-level laplacian75 CASE ( 0 ) ; CALL tra_ldf_lap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra ) ! iso-level laplacian 76 76 CASE ( 1 ) ! rotated laplacian 77 77 IF( ln_traldf_grif ) THEN 78 78 CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 79 79 ELSE 80 CALL tra_ldf_iso ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 )80 CALL tra_ldf_iso ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, rn_ahtb_0 ) 81 81 ENDIF 82 CASE ( 2 ) ; CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra ) ! iso-level bilaplacian82 CASE ( 2 ) ; CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra ) ! iso-level bilaplacian 83 83 CASE ( 3 ) ; CALL tra_ldf_bilapg( kt, nittrc000, 'TRC', trb, tra, jptra ) ! s-coord. horizontal bilaplacian 84 84 ! 85 85 CASE ( -1 ) ! esopa: test all possibility with control print 86 CALL tra_ldf_lap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra )86 CALL tra_ldf_lap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra ) 87 87 WRITE(charout, FMT="('ldf0 ')") ; CALL prt_ctl_trc_info(charout) 88 88 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) … … 90 90 CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 91 91 ELSE 92 CALL tra_ldf_iso ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 )92 CALL tra_ldf_iso ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, rn_ahtb_0 ) 93 93 ENDIF 94 94 WRITE(charout, FMT="('ldf1 ')") ; CALL prt_ctl_trc_info(charout) 95 95 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 96 CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra )96 CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra ) 97 97 WRITE(charout, FMT="('ldf2 ')") ; CALL prt_ctl_trc_info(charout) 98 98 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) … … 105 105 DO jn = 1, jptra 106 106 ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) 107 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_ldf, ztrtrd(:,:,:,jn) )107 CALL trd_tra( kt, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) ) 108 108 END DO 109 109 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) … … 217 217 ENDIF 218 218 219 IF( .NOT. ln_trcldf_diff ) THEN220 IF(lwp) WRITE(numout,*) ' No lateral diffusion on passive tracers'221 nldf = -2222 ENDIF223 224 219 IF(lwp) THEN 225 220 WRITE(numout,*) -
branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90
r4624 r5965 33 33 34 34 ! !!: ** lateral mixing namelist (nam_trcldf) ** 35 LOGICAL , PUBLIC :: ln_trcldf_diff !: flag of perform or not the lateral diff.36 35 LOGICAL , PUBLIC :: ln_trcldf_lap !: laplacian operator 37 36 LOGICAL , PUBLIC :: ln_trcldf_bilap !: bilaplacian operator … … 51 50 ! !!: ** newtonian damping namelist (nam_trcdmp) ** 52 51 ! !!* Namelist namtrc_dmp : passive tracer newtonian damping * 53 INTEGER , PUBLIC :: nn_hdmp_tr ! = 0/-1/'latitude' for damping over passive tracer54 52 INTEGER , PUBLIC :: nn_zdmp_tr ! = 0/1/2 flag for damping in the mixed layer 55 REAL(wp), PUBLIC :: rn_surf_tr ! surface time scale for internal damping [days] 56 REAL(wp), PUBLIC :: rn_bot_tr ! bottom time scale for internal damping [days] 57 REAL(wp), PUBLIC :: rn_dep_tr ! depth of transition between rn_surf and rn_bot [meters] 58 INTEGER , PUBLIC :: nn_file_tr ! = 1 create a damping.coeff NetCDF file 53 CHARACTER(LEN=200) , PUBLIC :: cn_resto_tr !File containing restoration coefficient 59 54 60 55 !!---------------------------------------------------------------------- … … 77 72 & ln_trcadv_ubs , ln_trcadv_qck, ln_trcadv_msc_ups 78 73 79 NAMELIST/namtrc_ldf/ ln_trcldf_ diff , ln_trcldf_lap , &74 NAMELIST/namtrc_ldf/ ln_trcldf_lap , & 80 75 & ln_trcldf_bilap, ln_trcldf_level, & 81 76 & ln_trcldf_hor , ln_trcldf_iso , rn_ahtrc_0, rn_ahtrb_0 82 77 NAMELIST/namtrc_zdf/ ln_trczdf_exp , nn_trczdf_exp 83 78 NAMELIST/namtrc_rad/ ln_trcrad 84 NAMELIST/namtrc_dmp/ nn_hdmp_tr, nn_zdmp_tr, rn_surf_tr, & 85 & rn_bot_tr , rn_dep_tr , nn_file_tr 79 NAMELIST/namtrc_dmp/ nn_zdmp_tr , cn_resto_tr 86 80 !!---------------------------------------------------------------------- 87 81 … … 126 120 WRITE(numout,*) '~~~~~~~~~~~' 127 121 WRITE(numout,*) ' Namelist namtrc_ldf : set lateral mixing parameters (type, direction, coefficients)' 128 WRITE(numout,*) ' perform lateral diffusion or not ln_trcldf_diff = ', ln_trcldf_diff129 122 WRITE(numout,*) ' laplacian operator ln_trcldf_lap = ', ln_trcldf_lap 130 123 WRITE(numout,*) ' bilaplacian operator ln_trcldf_bilap = ', ln_trcldf_bilap … … 184 177 WRITE(numout,*) '~~~~~~~' 185 178 WRITE(numout,*) ' Namelist namtrc_dmp : set damping parameter' 186 WRITE(numout,*) ' tracer damping option nn_hdmp_tr = ', nn_hdmp_tr187 179 WRITE(numout,*) ' mixed layer damping option nn_zdmp_tr = ', nn_zdmp_tr, '(zoom: forced to 0)' 188 WRITE(numout,*) ' surface time scale (days) rn_surf_tr = ', rn_surf_tr 189 WRITE(numout,*) ' bottom time scale (days) rn_bot_tr = ', rn_bot_tr 190 WRITE(numout,*) ' depth of transition (meters) rn_dep_tr = ', rn_dep_tr 191 WRITE(numout,*) ' create a damping.coeff file nn_file_tr = ', nn_file_tr 180 WRITE(numout,*) ' Restoration coeff file cn_resto_tr = ', cn_resto_tr 192 181 ENDIF 193 182 ! -
branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
r4611 r5965 30 30 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 31 31 USE prtctl_trc ! Print control for debbuging 32 USE trd mod_oce32 USE trd_oce 33 33 USE trdtra 34 34 USE tranxt … … 118 118 ! set time step size (Euler/Leapfrog) 119 119 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ; r2dt(:) = rdttrc(:) ! at nittrc000 (Euler) 120 ELSEIF( kt <= nittrc000 + 1 )THEN ; r2dt(:) = 2.* rdttrc(:) ! at nit000 or nit000+1 (Leapfrog)120 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ; r2dt(:) = 2.* rdttrc(:) ! at nit000 or nit000+1 (Leapfrog) 121 121 ENDIF 122 122 … … 137 137 ELSE 138 138 ! Leap-Frog + Asselin filter time stepping 139 IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt, nittrc000, 'TRC', trb, trn, tra, jptra ) ! variable volume level (vvl) 140 ELSE ; CALL tra_nxt_fix( kt, nittrc000, 'TRC', trb, trn, tra, jptra ) ! fixed volume level 139 IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt, nittrc000, rdttrc, 'TRC', trb, trn, tra, & 140 & sbc_trc, sbc_trc_b, jptra ) ! variable volume level (vvl) 141 ELSE ; CALL tra_nxt_fix( kt, nittrc000, 'TRC', trb, trn, tra, jptra ) ! fixed volume level 141 142 ENDIF 142 143 ENDIF … … 148 149 zfact = 1.e0 / r2dt(jk) 149 150 ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact 150 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_atf, ztrdt )151 CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt ) 151 152 END DO 152 153 END DO -
branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90
r3680 r5965 15 15 USE oce_trc ! ocean dynamics and tracers variables 16 16 USE trc ! ocean passive tracers variables 17 USE trd mod_oce17 USE trd_oce 18 18 USE trdtra 19 19 USE prtctl_trc ! Print control for debbuging … … 156 156 ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 157 157 ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt 158 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_radb, ztrtrdb ) ! Asselin-like trend handling159 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_radn, ztrtrdn ) ! standard trend handling158 CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb ) ! Asselin-like trend handling 159 CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn ) ! standard trend handling 160 160 ! 161 161 ENDIF … … 187 187 ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 188 188 ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt 189 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_radb, ztrtrdb ) ! Asselin-like trend handling190 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_radn, ztrtrdn ) ! standard trend handling189 CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb ) ! Asselin-like trend handling 190 CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn ) ! standard trend handling 191 191 ! 192 192 ENDIF -
branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
r3719 r5965 19 19 USE trc ! ocean passive tracers variables 20 20 USE prtctl_trc ! Print control for debbuging 21 USE trdmod_oce 21 USE iom 22 USE trd_oce 22 23 USE trdtra 23 24 … … 26 27 27 28 PUBLIC trc_sbc ! routine called by step.F90 29 30 REAL(wp) :: r2dt ! time-step at surface 28 31 29 32 !! * Substitutions … … 60 63 INTEGER, INTENT( in ) :: kt ! ocean time-step index 61 64 ! 62 INTEGER :: ji, jj, jn ! dummy loop indices 63 REAL(wp) :: zsrau, zse3t ! temporary scalars 65 INTEGER :: ji, jj, jn ! dummy loop indices 66 REAL(wp) :: zse3t, zrtrn, zratio, zfact ! temporary scalars 67 REAL(wp) :: zswitch, zftra, zcd, zdtra, ztfx, ztra ! temporary scalars 64 68 CHARACTER (len=22) :: charout 65 69 REAL(wp), POINTER, DIMENSION(:,: ) :: zsfx 66 70 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrd 71 67 72 !!--------------------------------------------------------------------- 68 73 ! … … 72 77 CALL wrk_alloc( jpi, jpj, zsfx ) 73 78 IF( l_trdtrc ) CALL wrk_alloc( jpi, jpj, jpk, ztrtrd ) 79 ! 80 zrtrn = 1.e-15_wp 81 82 SELECT CASE( nn_ice_embd ) ! levitating or embedded sea-ice option 83 CASE( 0 ) ; zswitch = 1 ! (0) standard levitating sea-ice : salt exchange only 84 CASE( 1, 2 ) ; zswitch = 0 ! (1) levitating sea-ice: salt and volume exchange but no pressure effect 85 ! (2) embedded sea-ice : salt and volume fluxes and pressure 86 END SELECT 87 88 IF( ln_top_euler) THEN 89 r2dt = rdttrc(1) ! = rdttrc (use Euler time stepping) 90 ELSE 91 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ! at nittrc000 92 r2dt = rdttrc(1) ! = rdttrc (restarting with Euler time stepping) 93 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ! at nittrc000 or nittrc000+1 94 r2dt = 2. * rdttrc(1) ! = 2 rdttrc (leapfrog) 95 ENDIF 96 ENDIF 97 74 98 75 99 IF( kt == nittrc000 ) THEN … … 77 101 IF(lwp) WRITE(numout,*) 'trc_sbc : Passive tracers surface boundary condition' 78 102 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 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 112 zfact = 1._wp 113 sbc_trc_b(:,:,:) = 0._wp 114 ENDIF 115 ELSE ! Swap of forcing fields 116 IF( ln_top_euler ) THEN 117 zfact = 1._wp 118 sbc_trc_b(:,:,:) = 0._wp 119 ELSE 120 zfact = 0.5_wp 121 sbc_trc_b(:,:,:) = sbc_trc(:,:,:) 122 ENDIF 123 ! 79 124 ENDIF 80 125 … … 90 135 91 136 ! 0. initialization 92 zsrau = 1. / rau093 137 DO jn = 1, jptra 94 138 ! 95 139 IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) ! save trends 96 140 ! ! add the trend to the general tracer trend 141 142 IF ( nn_ice_tr == -1 ) THEN ! No tracers in sea ice (null concentration in sea ice) 143 144 DO jj = 2, jpj 145 DO ji = fs_2, fs_jpim1 ! vector opt. 146 sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rau0 * trn(ji,jj,1,jn) 147 END DO 148 END DO 149 150 ELSE 151 152 DO jj = 2, jpj 153 DO ji = fs_2, fs_jpim1 ! vector opt. 154 zse3t = 1. / fse3t(ji,jj,1) 155 ! tracer flux at the ice/ocean interface (tracer/m2/s) 156 zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice 157 zcd = trc_o(ji,jj,jn) * fmmflx(ji,jj) ! concentration dilution due to freezing-melting, 158 ! only used in the levitating sea ice case 159 ! tracer flux only : add concentration dilution term in net tracer flux, no F-M in volume flux 160 ! tracer and mass fluxes : no concentration dilution term in net tracer flux, F-M term in volume flux 161 ztfx = zftra + zswitch * zcd ! net tracer flux (+C/D if no ice/ocean mass exchange) 162 163 zdtra = r1_rau0 * ( ztfx + zsfx(ji,jj) * trn(ji,jj,1,jn) ) 164 IF ( zdtra < 0. ) THEN 165 zratio = -zdtra * zse3t * r2dt / ( trn(ji,jj,1,jn) + zrtrn ) 166 zdtra = MIN(1.0, zratio) * zdtra ! avoid negative concentrations to arise 167 ENDIF 168 sbc_trc(ji,jj,jn) = zdtra 169 END DO 170 END DO 171 ENDIF 172 ! Concentration dilution effect on tracers due to evaporation & precipitation 97 173 DO jj = 2, jpj 98 174 DO ji = fs_2, fs_jpim1 ! vector opt. 99 zse3t = 1./ fse3t(ji,jj,1)100 tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + zsfx(ji,jj) * zsrau * trn(ji,jj,1,jn) * zse3t175 zse3t = zfact / fse3t(ji,jj,1) 176 tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t 101 177 END DO 102 178 END DO 103 179 ! 104 180 IF( l_trdtrc ) THEN 105 181 ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) 106 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_nsr, ztrtrd )182 CALL trd_tra( kt, 'TRC', jn, jptra_nsr, ztrtrd ) 107 183 END IF 108 184 ! ! =========== 109 185 END DO ! tracer loop 110 186 ! ! =========== 187 188 ! Write in the tracer restar file 189 ! ******************************* 190 IF( lrst_trc ) THEN 191 IF(lwp) WRITE(numout,*) 192 IF(lwp) WRITE(numout,*) 'sbc : ocean surface tracer content forcing fields written in tracer restart file ', & 193 & 'at it= ', kt,' date= ', ndastp 194 IF(lwp) WRITE(numout,*) '~~~~' 195 DO jn = 1, jptra 196 CALL iom_rstput( kt, nitrst, numrtw, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc(:,:,jn) ) 197 END DO 198 ENDIF 199 ! 111 200 IF( ln_ctl ) THEN 112 201 WRITE(charout, FMT="('sbc ')") ; CALL prt_ctl_trc_info(charout) -
branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
r4148 r5965 82 82 IF( .NOT. Agrif_Root()) CALL Agrif_Update_Trc( kstp ) ! Update tracer at AGRIF zoom boundaries : children only 83 83 #endif 84 IF( ln_zps ) CALL zps_hde( kstp, jptra, trn, gtru, gtrv ) ! Partial steps: now horizontal gradient of passive 84 85 IF( ln_zps .AND. .NOT. ln_isfcav) & 86 & CALL zps_hde ( kstp, jptra, trn, gtru, gtrv ) ! Partial steps: now horizontal gradient of passive 87 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 passive 85 89 ! tracers at the bottom ocean level 86 90 ! -
branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90
r3680 r5965 19 19 USE trazdf_exp ! vertical diffusion: explicit (tra_zdf_exp routine) 20 20 USE trazdf_imp ! vertical diffusion: implicit (tra_zdf_imp routine) 21 USE trd mod_oce21 USE trd_oce 22 22 USE trdtra 23 23 USE prtctl_trc ! Print control … … 73 73 IF( kt == nittrc000 ) CALL zdf_ctl ! initialisation & control of options 74 74 75 IF( ln_top_euler) THEN 76 r2dt(:) = rdttrc(:) ! = rdttrc (use Euler time stepping) 77 ELSE 78 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ! at nittrc000 79 r2dt(:) = rdttrc(:) ! = rdttrc (restarting with Euler time stepping) 80 ELSEIF( kt <= nittrc000 + 1 ) THEN ! at nittrc000 or nittrc000+1 81 r2dt(:) = 2. * rdttrc(:) ! = 2 rdttrc (leapfrog) 82 ENDIF 75 IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN ! at nittrc000 76 r2dt(:) = rdttrc(:) ! = rdttrc (use or restarting with Euler time stepping) 77 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ! at nittrc000 or nittrc000+1 78 r2dt(:) = 2. * rdttrc(:) ! = 2 rdttrc (leapfrog) 83 79 ENDIF 84 80 … … 106 102 ztrtrd(:,:,jk,jn) = ( ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) / r2dt(jk) ) - ztrtrd(:,:,jk,jn) 107 103 END DO 108 CALL trd_tra( kt, 'TRC', jn, jptra_ trd_zdf, ztrtrd(:,:,:,jn) )104 CALL trd_tra( kt, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:,jn) ) 109 105 END DO 110 106 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd )
Note: See TracChangeset
for help on using the changeset viewer.