Changeset 6606
- Timestamp:
- 2016-05-23T17:06:46+02:00 (8 years ago)
- Location:
- branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC
- Files:
-
- 3 edited
-
TRP/trcdmp.F90 (modified) (12 diffs)
-
trcdta.F90 (modified) (8 diffs)
-
trcini.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
r6308 r6606 35 35 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: restotr ! restoring coeff. on tracers (s-1) 36 36 37 INTEGER, PARAMETER :: npncts = 5! number of closed sea37 INTEGER, PARAMETER :: npncts = 8 ! number of closed sea 38 38 INTEGER, DIMENSION(npncts) :: nctsi1, nctsj1 ! south-west closed sea limits (i,j) 39 39 INTEGER, DIMENSION(npncts) :: nctsi2, nctsj2 ! north-east closed sea limits (i,j) … … 85 85 CHARACTER (len=22) :: charout 86 86 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrd 87 REAL(wp), POINTER, DIMENSION(:,:,: ) :: ztrcdta ! 3D workspace87 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrcdta ! 3D workspace 88 88 !!---------------------------------------------------------------------- 89 89 ! … … 98 98 IF( nb_trcdta > 0 ) THEN ! Initialisation of tracer from a file that may also be used for damping 99 99 ! 100 CALL wrk_alloc( jpi, jpj, jpk, ztrcdta ) ! Memory allocation 100 CALL wrk_alloc( jpi, jpj, jpk, nb_trcdta, ztrcdta ) ! Memory allocation 101 CALL trc_dta( kt, ztrcdta ) ! read tracer data at nit000 101 102 ! ! =========== 102 103 DO jn = 1, jptra ! tracer loop … … 105 106 ! 106 107 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 107 108 108 jl = n_trc_index(jn) 109 CALL trc_dta( kt, sf_trcdta(jl) ) ! read tracer data at nit000110 ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:) * tmask(:,:,:) * rf_trfac(jl)111 112 109 SELECT CASE ( nn_zdmp_tr ) 113 110 ! … … 116 113 DO jj = 2, jpjm1 117 114 DO ji = fs_2, fs_jpim1 ! vector opt. 118 ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk ) - trb(ji,jj,jk,jn) )115 ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk,jl) * rf_trfac(jl) - trb(ji,jj,jk,jn) ) 119 116 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 120 117 END DO … … 127 124 DO ji = fs_2, fs_jpim1 ! vector opt. 128 125 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) )126 ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk,jl) * rf_trfac(jl) - trb(ji,jj,jk,jn) ) 130 127 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 131 128 ENDIF … … 139 136 DO ji = fs_2, fs_jpim1 ! vector opt. 140 137 IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN 141 ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk ) - trb(ji,jj,jk,jn) )138 ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk,jl) * rf_trfac(jl) - trb(ji,jj,jk,jn) ) 142 139 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 143 140 END IF … … 157 154 END DO ! tracer loop 158 155 ! ! =========== 159 CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta )156 CALL wrk_dealloc( jpi, jpj, jpk, nb_trcdta, ztrcdta ) 160 157 ENDIF 161 158 ! … … 187 184 INTEGER :: ji , jj, jk, jn, jl, jc ! dummy loop indicesa 188 185 INTEGER :: isrow ! local index 186 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrcdta ! 3D workspace 189 187 190 188 !!---------------------------------------------------------------------- … … 207 205 ! 208 206 ! Caspian Sea 209 nctsi1(1) = 332 ; nctsj1(1) = 243 - isrow 210 nctsi2(1) = 344 ; nctsj2(1) = 275 - isrow 211 ! 207 nctsi1(1) = 333 ; nctsj1(1) = 243 - isrow 208 nctsi2(1) = 342 ; nctsj2(1) = 274 - isrow 209 ! ! Lake Superior 210 nctsi1(2) = 198 ; nctsj1(2) = 258 - isrow 211 nctsi2(2) = 204 ; nctsj2(2) = 262 - isrow 212 ! ! Lake Michigan 213 nctsi1(3) = 201 ; nctsj1(3) = 250 - isrow 214 nctsi2(3) = 203 ; nctsj2(3) = 256 - isrow 215 ! ! Lake Huron 216 nctsi1(4) = 204 ; nctsj1(4) = 252 - isrow 217 nctsi2(4) = 209 ; nctsj2(4) = 256 - isrow 218 ! ! Lake Erie 219 nctsi1(5) = 206 ; nctsj1(5) = 249 - isrow 220 nctsi2(5) = 209 ; nctsj2(5) = 251 - isrow 221 ! ! Lake Ontario 222 nctsi1(6) = 210 ; nctsj1(6) = 252 - isrow 223 nctsi2(6) = 212 ; nctsj2(6) = 252 - isrow 224 ! ! Victoria Lake 225 nctsi1(7) = 321 ; nctsj1(7) = 180 - isrow 226 nctsi2(7) = 322 ; nctsj2(7) = 189 - isrow 227 ! ! Baltic Sea 228 nctsi1(8) = 297 ; nctsj1(8) = 270 - isrow 229 nctsi2(8) = 308 ; nctsj2(8) = 293 - isrow 230 212 231 ! ! ======================= 213 232 CASE ( 2 ) ! ORCA_R2 configuration … … 277 296 IF(lwp) WRITE(numout,*) 278 297 ! 298 CALL wrk_alloc( jpi, jpj, jpk, nb_trcdta, ztrcdta ) ! Memory allocation 299 CALL trc_dta( kt, ztrcdta ) ! read tracer data at nit000 300 ! 279 301 DO jn = 1, jptra 280 302 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 281 303 jl = n_trc_index(jn) 282 CALL trc_dta( kt, sf_trcdta(jl) ) ! read tracer data at nit000304 IF(lwp) WRITE(numout,*) 283 305 DO jc = 1, npncts 284 306 DO jk = 1, jpkm1 285 307 DO jj = nctsj1(jc), nctsj2(jc) 286 308 DO ji = nctsi1(jc), nctsi2(jc) 287 trn(ji,jj,jk,jn) = sf_trcdta(jl)%fnow(ji,jj,jk) * tmask(ji,jj,jk) * rf_trfac(jl)309 trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk,jl) * rf_trfac(jl) 288 310 trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 289 311 ENDDO … … 293 315 ENDIF 294 316 ENDDO 317 CALL wrk_dealloc( jpi, jpj, jpk, nb_trcdta, ztrcdta ) ! Memory allocation 295 318 ! 296 319 ENDIF -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
r6308 r6606 151 151 152 152 153 SUBROUTINE trc_dta( kt, sf_dta)153 SUBROUTINE trc_dta( kt, ptrc ) 154 154 !!---------------------------------------------------------------------- 155 155 !! *** ROUTINE trc_dta *** … … 161 161 !! - ln_trcdmp=F: deallocates the data structure as they are not used 162 162 !! 163 !! ** Action : sf_ dta passive tracer data on medl mesh and interpolated at time-step kt164 !!---------------------------------------------------------------------- 165 INTEGER , INTENT(in ) :: kt ! ocean time-step166 TYPE(FLD), DIMENSION(1) , INTENT(inout) :: sf_dta! array of information on the field to read163 !! ** Action : sf_trcdta passive tracer data on medl mesh and interpolated at time-step kt 164 !!---------------------------------------------------------------------- 165 INTEGER , INTENT(in ) :: kt ! ocean time-step 166 REAL(wp), DIMENSION(jpi,jpj,jpk,nb_trcdta), INTENT(inout) :: ptrc ! array of information on the field to read 167 167 ! 168 168 INTEGER :: ji, jj, jk, jl, jkk, ik ! dummy loop indices … … 176 176 IF( nb_trcdta > 0 ) THEN 177 177 ! 178 CALL fld_read( kt, 1, sf_dta ) !== read data at kt time step ==! 178 CALL fld_read( kt, 1, sf_trcdta ) !== read data at kt time step ==! 179 ! 180 DO jl = 1, nb_trcdta 181 ptrc(:,:,:,jl) = sf_trcdta(jl)%fnow(:,:,:) * tmask(:,:,:) ! Mask 182 ENDDO 179 183 ! 180 184 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! … … 184 188 WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh' 185 189 ENDIF 186 !190 DO jl = 1, nb_trcdta 187 191 DO jj = 1, jpj ! vertical interpolation of T & S 188 192 DO ji = 1, jpi … … 190 194 zl = fsdept_n(ji,jj,jk) 191 195 IF( zl < gdept_1d(1 ) ) THEN ! above the first level of data 192 ztp(jk) = sf_dta(1)%fnow(ji,jj,1)196 ztp(jk) = ptrc(ji,jj,1,jl) 193 197 ELSEIF( zl > gdept_1d(jpk) ) THEN ! below the last level of data 194 ztp(jk) = sf_dta(1)%fnow(ji,jj,jpkm1)198 ztp(jk) = ptrc(ji,jj,jpkm1,jl) 195 199 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 196 200 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 197 201 IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 198 202 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 199 ztp(jk) = sf_dta(1)%fnow(ji,jj,jkk) + ( sf_dta(1)%fnow(ji,jj,jkk+1) - & 200 sf_dta(1)%fnow(ji,jj,jkk) ) * zi 203 ztp(jk) = ptrc(ji,jj,jkk,jl) + ( ptrc(ji,jj,jkk+1,jl) - ptrc(ji,jj,jkk,jl) ) * zi 201 204 ENDIF 202 205 END DO … … 204 207 END DO 205 208 DO jk = 1, jpkm1 206 sf_dta(1)%fnow(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord209 ptrc(ji,jj,jk,jl) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord 207 210 END DO 208 sf_dta(1)%fnow(ji,jj,jpk) = 0._wp211 ptrc(ji,jj,jpk,jl) = 0._wp 209 212 END DO 210 213 END DO 214 END DO 211 215 ! 212 216 ELSE !== z- or zps- coordinate ==! 213 217 ! 214 sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * tmask(:,:,:) ! Mask215 !216 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level218 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level 219 DO jl = 1, nb_trcdta 220 ! 217 221 DO jj = 1, jpj 218 222 DO ji = 1, jpi … … 220 224 IF( ik > 1 ) THEN 221 225 zl = ( gdept_1d(ik) - fsdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 222 sf_dta(1)%fnow(ji,jj,ik) = (1.-zl) * sf_dta(1)%fnow(ji,jj,ik) + zl * sf_dta(1)%fnow(ji,jj,ik-1)226 ptrc(ji,jj,ik,jl) = (1.-zl) * ptrc(ji,jj,ik,jl) + zl * ptrc(ji,jj,ik-1,jl) 223 227 ENDIF 224 228 ik = mikt(ji,jj) 225 229 IF( ik > 1 ) THEN 226 230 zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 227 sf_dta(1)%fnow(ji,jj,ik) = (1.-zl) * sf_dta(1)%fnow(ji,jj,ik) + zl * sf_dta(1)%fnow(ji,jj,ik+1)231 ptrc(ji,jj,ik,jl) = (1.-zl) * ptrc(ji,jj,ik,jl) + zl * ptrc(ji,jj,ik+1,jl) 228 232 ENDIF 229 233 END DO 230 234 END DO 231 ENDIF 235 END DO 236 ENDIF 232 237 ! 233 238 ENDIF 234 239 ! 235 IF( lwp .AND. kt == nit000 ) THEN 236 clndta = TRIM( sf_dta(1)%clvar ) 237 WRITE(numout,*) ''//clndta//' data ' 238 WRITE(numout,*) 239 WRITE(numout,*)' level = 1' 240 CALL prihre( sf_dta(1)%fnow(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 241 WRITE(numout,*)' level = ', jpk/2 242 CALL prihre( sf_dta(1)%fnow(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 243 WRITE(numout,*)' level = ', jpkm1 244 CALL prihre( sf_dta(1)%fnow(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 245 WRITE(numout,*) 246 ENDIF 240 ENDIF 241 ! 242 IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN !== deallocate data structure ==! 243 ! (data used only for initialisation) 244 IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only used to initialize the run' 245 DO jl = 1, nb_trcdta 246 DEALLOCATE( sf_trcdta(jl)%fnow) ! arrays in the structure 247 IF( sf_trcdta(jl)%ln_tint ) DEALLOCATE( sf_trcdta(jl)%fdta) 248 ENDDO 247 249 ENDIF 248 250 ! … … 255 257 !!---------------------------------------------------------------------- 256 258 CONTAINS 257 SUBROUTINE trc_dta( kt, sf_ dta, zrf_trfac ) ! Empty routine259 SUBROUTINE trc_dta( kt, sf_trcdta, zrf_trfac ) ! Empty routine 258 260 WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt 259 261 END SUBROUTINE trc_dta -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r6308 r6606 30 30 USE trcsub ! variables to substep passive tracers 31 31 USE lib_mpp ! distribued memory computing library 32 USE wrk_nemo 32 33 USE sbc_oce 33 34 USE trcice ! tracers in sea ice … … 61 62 INTEGER :: jk, jn, jl ! dummy loop indices 62 63 CHARACTER (len=25) :: charout 64 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrcdta 63 65 !!--------------------------------------------------------------------- 64 66 ! … … 120 122 IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN ! Initialisation of tracer from a file that may also be used for damping 121 123 ! 124 CALL wrk_alloc( jpi, jpj, jpk, nb_trcdta, ztrcdta ) 125 ! 126 CALL trc_dta( nit000, ztrcdta ) ! read tracer data at nit000 127 ! 122 128 DO jn = 1, jptra 123 129 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 124 130 jl = n_trc_index(jn) 125 CALL trc_dta( nit000, sf_trcdta(jl) ) ! read tracer data at nit000 126 trn(:,:,:,jn) = sf_trcdta(jl)%fnow(:,:,:) * tmask(:,:,:) * rf_trfac(jl) 127 ! 128 IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN !== deallocate data structure ==! 129 ! (data used only for initialisation) 130 IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only used to initialize the run' 131 DEALLOCATE( sf_trcdta(jl)%fnow ) ! arrays in the structure 132 IF( sf_trcdta(jl)%ln_tint ) DEALLOCATE( sf_trcdta(jl)%fdta ) 133 ! 134 ENDIF 131 trn(:,:,:,jn) = ztrcdta(:,:,:,jl) * rf_trfac(jl) 135 132 ENDIF 136 133 ENDDO 137 134 ! 135 CALL wrk_dealloc( jpi, jpj, jpk, nb_trcdta, ztrcdta ) 136 ! 138 137 ENDIF 139 138 !
Note: See TracChangeset
for help on using the changeset viewer.
