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