- Timestamp:
- 2015-11-20T09:39:06+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
r5038 r5901 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 … … 27 28 PUBLIC trc_sbc ! routine called by step.F90 28 29 30 REAL(wp) :: r2dt ! time-step at surface 31 29 32 !! * Substitutions 30 # include "top_substitute.h90" 33 # include "domzgr_substitute.h90" 34 # include "vectopt_loop_substitute.h90" 31 35 !!---------------------------------------------------------------------- 32 36 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 60 64 INTEGER, INTENT( in ) :: kt ! ocean time-step index 61 65 ! 62 INTEGER :: ji, jj, jn ! dummy loop indices 63 REAL(wp) :: zsrau, zse3t ! temporary scalars 66 INTEGER :: ji, jj, jn ! dummy loop indices 67 REAL(wp) :: zse3t, zrtrn, zratio, zfact ! temporary scalars 68 REAL(wp) :: zswitch, zftra, zcd, zdtra, ztfx, ztra ! temporary scalars 64 69 CHARACTER (len=22) :: charout 65 70 REAL(wp), POINTER, DIMENSION(:,: ) :: zsfx 66 71 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrd 72 67 73 !!--------------------------------------------------------------------- 68 74 ! … … 72 78 CALL wrk_alloc( jpi, jpj, zsfx ) 73 79 IF( l_trdtrc ) CALL wrk_alloc( jpi, jpj, jpk, ztrtrd ) 80 ! 81 zrtrn = 1.e-15_wp 82 83 SELECT CASE( nn_ice_embd ) ! levitating or embedded sea-ice option 84 CASE( 0 ) ; zswitch = 1 ! (0) standard levitating sea-ice : salt exchange only 85 CASE( 1, 2 ) ; zswitch = 0 ! (1) levitating sea-ice: salt and volume exchange but no pressure effect 86 ! ! (2) embedded sea-ice : salt and volume fluxes and pressure 87 END SELECT 88 89 IF( ln_top_euler) THEN 90 r2dt = rdttrc(1) ! = rdttrc (use Euler time stepping) 91 ELSE 92 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ! at nittrc000 93 r2dt = rdttrc(1) ! = rdttrc (restarting with Euler time stepping) 94 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ! at nittrc000 or nittrc000+1 95 r2dt = 2. * rdttrc(1) ! = 2 rdttrc (leapfrog) 96 ENDIF 97 ENDIF 98 74 99 75 100 IF( kt == nittrc000 ) THEN … … 77 102 IF(lwp) WRITE(numout,*) 'trc_sbc : Passive tracers surface boundary condition' 78 103 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 104 105 IF( ln_rsttr .AND. & ! Restart: read in restart file 106 iom_varid( numrtr, 'sbc_'//TRIM(ctrcnm(1))//'_b', ldstop = .FALSE. ) > 0 ) THEN 107 IF(lwp) WRITE(numout,*) ' nittrc000-nn_dttrc surface tracer content forcing fields red in the restart file' 108 zfact = 0.5_wp 109 DO jn = 1, jptra 110 CALL iom_get( numrtr, jpdom_autoglo, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc_b(:,:,jn) ) ! before tracer content sbc 111 END DO 112 ELSE ! No restart or restart not found: Euler forward time stepping 113 zfact = 1._wp 114 sbc_trc_b(:,:,:) = 0._wp 115 ENDIF 116 ELSE ! Swap of forcing fields 117 IF( ln_top_euler ) THEN 118 zfact = 1._wp 119 sbc_trc_b(:,:,:) = 0._wp 120 ELSE 121 zfact = 0.5_wp 122 sbc_trc_b(:,:,:) = sbc_trc(:,:,:) 123 ENDIF 124 ! 79 125 ENDIF 80 126 … … 90 136 91 137 ! 0. initialization 92 zsrau = 1. / rau093 138 DO jn = 1, jptra 94 139 ! 95 140 IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) ! save trends 96 141 ! ! add the trend to the general tracer trend 142 143 IF ( nn_ice_tr == -1 ) THEN ! No tracers in sea ice (null concentration in sea ice) 144 145 DO jj = 2, jpj 146 DO ji = fs_2, fs_jpim1 ! vector opt. 147 sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rau0 * trn(ji,jj,1,jn) 148 END DO 149 END DO 150 151 ELSE 152 153 DO jj = 2, jpj 154 DO ji = fs_2, fs_jpim1 ! vector opt. 155 zse3t = 1. / fse3t(ji,jj,1) 156 ! tracer flux at the ice/ocean interface (tracer/m2/s) 157 zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice 158 zcd = trc_o(ji,jj,jn) * fmmflx(ji,jj) ! concentration dilution due to freezing-melting, 159 ! only used in the levitating sea ice case 160 ! tracer flux only : add concentration dilution term in net tracer flux, no F-M in volume flux 161 ! tracer and mass fluxes : no concentration dilution term in net tracer flux, F-M term in volume flux 162 ztfx = zftra + zswitch * zcd ! net tracer flux (+C/D if no ice/ocean mass exchange) 163 164 zdtra = r1_rau0 * ( ztfx + zsfx(ji,jj) * trn(ji,jj,1,jn) ) 165 IF ( zdtra < 0. ) THEN 166 zratio = -zdtra * zse3t * r2dt / ( trn(ji,jj,1,jn) + zrtrn ) 167 zdtra = MIN(1.0, zratio) * zdtra ! avoid negative concentrations to arise 168 ENDIF 169 sbc_trc(ji,jj,jn) = zdtra 170 END DO 171 END DO 172 ENDIF 173 ! Concentration dilution effect on tracers due to evaporation & precipitation 97 174 DO jj = 2, jpj 98 175 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) * zse3t176 zse3t = zfact / fse3t(ji,jj,1) 177 tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t 101 178 END DO 102 179 END DO 103 180 ! 104 181 IF( l_trdtrc ) THEN 105 182 ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) … … 109 186 END DO ! tracer loop 110 187 ! ! =========== 188 189 ! Write in the tracer restar file 190 ! ******************************* 191 IF( lrst_trc ) THEN 192 IF(lwp) WRITE(numout,*) 193 IF(lwp) WRITE(numout,*) 'sbc : ocean surface tracer content forcing fields written in tracer restart file ', & 194 & 'at it= ', kt,' date= ', ndastp 195 IF(lwp) WRITE(numout,*) '~~~~' 196 DO jn = 1, jptra 197 CALL iom_rstput( kt, nitrst, numrtw, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc(:,:,jn) ) 198 END DO 199 ENDIF 200 ! 111 201 IF( ln_ctl ) THEN 112 202 WRITE(charout, FMT="('sbc ')") ; CALL prt_ctl_trc_info(charout)
Note: See TracChangeset
for help on using the changeset viewer.