- Timestamp:
- 2016-11-28T17:04:10+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
r5836 r7351 38 38 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: restotr ! restoring coeff. on tracers (s-1) 39 39 40 INTEGER, PARAMETER :: npncts = 5! number of closed sea40 INTEGER, PARAMETER :: npncts = 8 ! number of closed sea 41 41 INTEGER, DIMENSION(npncts) :: nctsi1, nctsj1 ! south-west closed sea limits (i,j) 42 42 INTEGER, DIMENSION(npncts) :: nctsi2, nctsj2 ! north-east closed sea limits (i,j) 43 43 44 44 !! * Substitutions 45 # include "domzgr_substitute.h90"46 45 # include "vectopt_loop_substitute.h90" 47 46 !!---------------------------------------------------------------------- … … 82 81 !! - save the trends ('key_trdmxl_trc') 83 82 !!---------------------------------------------------------------------- 84 !! 85 INTEGER, INTENT( in ) :: kt ! ocean time-step index 86 !! 87 INTEGER :: ji, jj, jk, jn, jl ! dummy loop indices 88 REAL(wp) :: ztra ! temporary scalars 89 CHARACTER (len=22) :: charout 83 INTEGER, INTENT(in) :: kt ! ocean time-step index 84 ! 85 INTEGER :: ji, jj, jk, jn, jl ! dummy loop indices 86 CHARACTER (len=22) :: charout 90 87 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrd 91 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace88 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace 92 89 !!---------------------------------------------------------------------- 93 90 ! … … 105 102 ! 106 103 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 107 104 ! 108 105 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(:,:,:) 111 106 CALL trc_dta( kt, sf_trcdta(jl), rf_trfac(jl), ztrcdta ) ! read tracer data at nit000 107 ! 112 108 SELECT CASE ( nn_zdmp_tr ) 113 109 ! … … 116 112 DO jj = 2, jpjm1 117 113 DO ji = fs_2, fs_jpim1 ! vector opt. 118 ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 119 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 114 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 120 115 END DO 121 116 END DO 122 117 END DO 123 !118 ! 124 119 CASE ( 1 ) !== no damping in the turbocline (avt > 5 cm2/s) ==! 125 120 DO jk = 1, jpkm1 … … 127 122 DO ji = fs_2, fs_jpim1 ! vector opt. 128 123 IF( avt(ji,jj,jk) <= 5.e-4_wp ) THEN 129 ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 130 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 124 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 131 125 ENDIF 132 126 END DO 133 127 END DO 134 128 END DO 135 !129 ! 136 130 CASE ( 2 ) !== no damping in the mixed layer ==! 137 131 DO jk = 1, jpkm1 138 132 DO jj = 2, jpjm1 139 133 DO ji = fs_2, fs_jpim1 ! vector opt. 140 IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN 141 ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 142 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 134 IF( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN 135 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 143 136 END IF 144 137 END DO 145 138 END DO 146 139 END DO 147 !140 ! 148 141 END SELECT 149 142 ! … … 162 155 IF( l_trdtrc ) CALL wrk_dealloc( jpi, jpj, jpk, ztrtrd ) 163 156 ! ! print mean trends (used for debugging) 164 IF( ln_ctl ) THEN 165 WRITE(charout, FMT="('dmp ')") ; CALL prt_ctl_trc_info(charout) 166 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 157 IF( ln_ctl ) THEN 158 WRITE(charout, FMT="('dmp ')") 159 CALL prt_ctl_trc_info(charout) 160 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 167 161 ENDIF 168 162 ! … … 170 164 ! 171 165 END SUBROUTINE trc_dmp 166 172 167 173 168 SUBROUTINE trc_dmp_ini … … 180 175 !! called by trc_dmp at the first timestep (nittrc000) 181 176 !!---------------------------------------------------------------------- 182 ! 183 INTEGER :: ios ! Local integer output status for namelist read 184 INTEGER :: imask !local file handle 185 ! 177 INTEGER :: ios, imask ! local integers 178 !! 186 179 NAMELIST/namtrc_dmp/ nn_zdmp_tr , cn_resto_tr 187 180 !!---------------------------------------------------------------------- 188 189 IF( nn_timing == 1 ) CALL timing_start('trc_dmp_init') 190 ! 191 181 ! 182 IF( nn_timing == 1 ) CALL timing_start('trc_dmp_ini') 183 ! 192 184 REWIND( numnat_ref ) ! Namelist namtrc_dmp in reference namelist : Passive tracers newtonian damping 193 185 READ ( numnat_ref, namtrc_dmp, IOSTAT = ios, ERR = 909) … … 207 199 WRITE(numout,*) ' Restoration coeff file cn_resto_tr = ', cn_resto_tr 208 200 ENDIF 201 ! ! Allocate arrays 202 IF( trc_dmp_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'trc_dmp_ini: unable to allocate arrays' ) 209 203 ! 210 204 IF( lzoom .AND. .NOT.lk_c1d ) nn_zdmp_tr = 0 ! restoring to climatology at closed north or south boundaries … … 233 227 END SUBROUTINE trc_dmp_ini 234 228 229 235 230 SUBROUTINE trc_dmp_clo( kt ) 236 231 !!--------------------------------------------------------------------- … … 247 242 INTEGER, INTENT( in ) :: kt ! ocean time-step index 248 243 ! 249 INTEGER :: ji , jj, jk, jn, jl, jc 244 INTEGER :: ji , jj, jk, jn, jl, jc ! dummy loop indicesa 250 245 INTEGER :: isrow ! local index 251 246 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace … … 270 265 ! 271 266 ! Caspian Sea 272 nctsi1(1) = 332 ; nctsj1(1) = 243 - isrow 273 nctsi2(1) = 344 ; nctsj2(1) = 275 - isrow 267 nctsi1(1) = 333 ; nctsj1(1) = 243 - isrow 268 nctsi2(1) = 342 ; nctsj2(1) = 274 - isrow 269 ! ! Lake Superior 270 nctsi1(2) = 198 ; nctsj1(2) = 258 - isrow 271 nctsi2(2) = 204 ; nctsj2(2) = 262 - isrow 272 ! ! Lake Michigan 273 nctsi1(3) = 201 ; nctsj1(3) = 250 - isrow 274 nctsi2(3) = 203 ; nctsj2(3) = 256 - isrow 275 ! ! Lake Huron 276 nctsi1(4) = 204 ; nctsj1(4) = 252 - isrow 277 nctsi2(4) = 209 ; nctsj2(4) = 256 - isrow 278 ! ! Lake Erie 279 nctsi1(5) = 206 ; nctsj1(5) = 249 - isrow 280 nctsi2(5) = 209 ; nctsj2(5) = 251 - isrow 281 ! ! Lake Ontario 282 nctsi1(6) = 210 ; nctsj1(6) = 252 - isrow 283 nctsi2(6) = 212 ; nctsj2(6) = 252 - isrow 284 ! ! Victoria Lake 285 nctsi1(7) = 321 ; nctsj1(7) = 180 - isrow 286 nctsi2(7) = 322 ; nctsj2(7) = 189 - isrow 287 ! ! Baltic Sea 288 nctsi1(8) = 297 ; nctsj1(8) = 270 - isrow 289 nctsi2(8) = 308 ; nctsj2(8) = 293 - isrow 274 290 ! 275 291 ! ! ======================= … … 345 361 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 346 362 jl = n_trc_index(jn) 347 CALL trc_dta( kt, sf_trcdta(jl),rf_trfac(jl) ) ! read tracer data at nit000 348 ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:) 363 CALL trc_dta( kt, sf_trcdta(jl), rf_trfac(jl), ztrcdta ) ! read tracer data at nit000 349 364 DO jc = 1, npncts 350 365 DO jk = 1, jpkm1 351 366 DO jj = nctsj1(jc), nctsj2(jc) 352 367 DO ji = nctsi1(jc), nctsi2(jc) 353 trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk) * tmask(ji,jj,jk)368 trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk) 354 369 trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 355 370 ENDDO … … 364 379 END SUBROUTINE trc_dmp_clo 365 380 366 381 367 382 #else 368 383 !!---------------------------------------------------------------------- … … 376 391 #endif 377 392 378 379 393 !!====================================================================== 380 394 END MODULE trcdmp
Note: See TracChangeset
for help on using the changeset viewer.
