Changeset 5385 for trunk/NEMOGCM/NEMO/TOP_SRC/TRP
- Timestamp:
- 2015-06-09T15:50:42+02:00 (9 years ago)
- Location:
- trunk/NEMOGCM/NEMO/TOP_SRC/TRP
- Files:
-
- 7 edited
-
trcadv.F90 (modified) (1 diff)
-
trcdmp.F90 (modified) (1 diff)
-
trcldf.F90 (modified) (1 diff)
-
trcnam_trp.F90 (modified) (3 diffs)
-
trcnxt.F90 (modified) (2 diffs)
-
trcsbc.F90 (modified) (7 diffs)
-
trczdf.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
r4610 r5385 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 -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
r5215 r5385 126 126 DO jj = 2, jpjm1 127 127 DO ji = fs_2, fs_jpim1 ! vector opt. 128 IF( avt(ji,jj,jk) <= 5.e-4 ) THEN128 IF( avt(ji,jj,jk) <= 5.e-4_wp ) THEN 129 129 ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 130 130 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
r4990 r5385 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,*) -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90
r5102 r5385 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 … … 73 72 & ln_trcadv_ubs , ln_trcadv_qck, ln_trcadv_msc_ups 74 73 75 NAMELIST/namtrc_ldf/ ln_trcldf_ diff , ln_trcldf_lap , &74 NAMELIST/namtrc_ldf/ ln_trcldf_lap , & 76 75 & ln_trcldf_bilap, ln_trcldf_level, & 77 76 & ln_trcldf_hor , ln_trcldf_iso , rn_ahtrc_0, rn_ahtrb_0 … … 121 120 WRITE(numout,*) '~~~~~~~~~~~' 122 121 WRITE(numout,*) ' Namelist namtrc_ldf : set lateral mixing parameters (type, direction, coefficients)' 123 WRITE(numout,*) ' perform lateral diffusion or not ln_trcldf_diff = ', ln_trcldf_diff124 122 WRITE(numout,*) ' laplacian operator ln_trcldf_lap = ', ln_trcldf_lap 125 123 WRITE(numout,*) ' bilaplacian operator ln_trcldf_bilap = ', ln_trcldf_bilap -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
r4990 r5385 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 -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
r4990 r5385 19 19 USE trc ! ocean passive tracers variables 20 20 USE prtctl_trc ! Print control for debbuging 21 USE iom 21 22 USE trd_oce 22 23 USE trdtra … … 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(:,:,:) … … 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) -
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90
r4990 r5385 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
Note: See TracChangeset
for help on using the changeset viewer.
