Changeset 6688
- Timestamp:
- 2016-06-13T14:50:45+02:00 (8 years ago)
- Location:
- branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO
- Files:
-
- 4 edited
-
OPA_SRC/TRA/trasbc.F90 (modified) (1 diff)
-
TOP_SRC/TRP/trcdmp.F90 (modified) (12 diffs)
-
TOP_SRC/trcdta.F90 (modified) (11 diffs)
-
TOP_SRC/trcini.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r6471 r6688 158 158 ELSE ! No restart or restart not found: Euler forward time stepping 159 159 zfact = 1._wp 160 sbc_tsc(:,:,:) = 0._wp 160 161 sbc_tsc_b(:,:,:) = 0._wp 161 162 ENDIF -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
r6606 r6688 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, nb_trcdta, ztrcdta ) ! Memory allocation 101 CALL trc_dta( kt, ztrcdta ) ! read tracer data at nit000 100 CALL wrk_alloc( jpi, jpj, jpk, ztrcdta ) ! Memory allocation 102 101 ! ! =========== 103 102 DO jn = 1, jptra ! tracer loop … … 106 105 ! 107 106 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), rf_trfac(jl), ztrcdta ) ! read tracer data at nit000 110 109 111 SELECT CASE ( nn_zdmp_tr ) 110 112 ! … … 113 115 DO jj = 2, jpjm1 114 116 DO ji = fs_2, fs_jpim1 ! vector opt. 115 ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk ,jl) * rf_trfac(jl) - trb(ji,jj,jk,jn) )117 ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 116 118 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 117 119 END DO … … 124 126 DO ji = fs_2, fs_jpim1 ! vector opt. 125 127 IF( avt(ji,jj,jk) <= 5.e-4_wp ) THEN 126 ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk ,jl) * rf_trfac(jl) - trb(ji,jj,jk,jn) )128 ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 127 129 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 128 130 ENDIF … … 136 138 DO ji = fs_2, fs_jpim1 ! vector opt. 137 139 IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN 138 ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk ,jl) * rf_trfac(jl) - trb(ji,jj,jk,jn) )140 ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 139 141 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 140 142 END IF … … 154 156 END DO ! tracer loop 155 157 ! ! =========== 156 CALL wrk_dealloc( jpi, jpj, jpk, nb_trcdta,ztrcdta )158 CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta ) 157 159 ENDIF 158 160 ! … … 184 186 INTEGER :: ji , jj, jk, jn, jl, jc ! dummy loop indicesa 185 187 INTEGER :: isrow ! local index 186 REAL(wp), POINTER, DIMENSION(:,:,: ,:) :: ztrcdta! 3D workspace188 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace 187 189 188 190 !!---------------------------------------------------------------------- … … 228 230 nctsi1(8) = 297 ; nctsj1(8) = 270 - isrow 229 231 nctsi2(8) = 308 ; nctsj2(8) = 293 - isrow 230 232 ! 231 233 ! ! ======================= 232 234 CASE ( 2 ) ! ORCA_R2 configuration … … 296 298 IF(lwp) WRITE(numout,*) 297 299 ! 298 CALL wrk_alloc( jpi, jpj, jpk, nb_trcdta, ztrcdta ) ! Memory allocation 299 CALL trc_dta( kt, ztrcdta ) ! read tracer data at nit000 300 CALL wrk_alloc( jpi, jpj, jpk, ztrcdta ) ! Memory allocation 300 301 ! 301 302 DO jn = 1, jptra 302 303 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 303 304 jl = n_trc_index(jn) 304 IF(lwp) WRITE(numout,*)305 CALL trc_dta( kt, sf_trcdta(jl), rf_trfac(jl), ztrcdta ) ! read tracer data at nit000 305 306 DO jc = 1, npncts 306 307 DO jk = 1, jpkm1 307 308 DO jj = nctsj1(jc), nctsj2(jc) 308 309 DO ji = nctsi1(jc), nctsi2(jc) 309 trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk ,jl) * rf_trfac(jl)310 trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk) 310 311 trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 311 312 ENDDO … … 315 316 ENDIF 316 317 ENDDO 317 CALL wrk_dealloc( jpi, jpj, jpk, nb_trcdta, ztrcdta ) ! Memory allocation 318 ! 318 CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta ) 319 319 ENDIF 320 320 ! … … 336 336 IF( nn_timing == 1 ) CALL timing_start('trc_dmp_init') 337 337 ! 338 !Allocate arrays 339 IF( trc_dmp_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'trc_dmp_init: unable to allocate arrays' ) 338 340 339 341 IF( lzoom ) nn_zdmp_tr = 0 ! restoring to climatology at closed north or south boundaries -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
r6606 r6688 77 77 ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 ) 78 78 IF( ierr0 > 0 ) THEN 79 CALL ctl_stop( 'trc_ nam: unable to allocate n_trc_index' ) ; RETURN79 CALL ctl_stop( 'trc_dta_init: unable to allocate n_trc_index' ) ; RETURN 80 80 ENDIF 81 81 nb_trcdta = 0 … … 91 91 IF(lwp) THEN 92 92 WRITE(numout,*) ' ' 93 WRITE(numout,*) 'trc_dta_init : Passive tracers Initial Conditions ' 94 WRITE(numout,*) '~~~~~~~~~~~~~~ ' 93 95 WRITE(numout,*) ' number of passive tracers to be initialize by data :', ntra 94 96 WRITE(numout,*) ' ' … … 107 109 DO jn = 1, ntrc 108 110 IF( ln_trc_ini(jn) ) THEN ! open input file only if ln_trc_ini(jn) is true 109 clndta = TRIM( sn_trcdta(jn)%clvar ) 110 clntrc = TRIM( ctrcnm (jn) ) 111 clndta = TRIM( sn_trcdta(jn)%clvar ) 112 if (jn > jptra) then 113 clntrc='Dummy' ! By pass weird formats in ocean.output if ntrc > jptra 114 else 115 clntrc = TRIM( ctrcnm (jn) ) 116 endif 111 117 zfact = rn_trfac(jn) 112 IF( clndta /= clntrc ) THEN 113 CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation :', &114 & ' the variable name in the data file : '//clndta// &115 & ' must be the same than the name of the passive tracer : '//clntrc//' ')118 IF( clndta /= clntrc ) THEN 119 CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation ', & 120 & 'Input name of data file : '//TRIM(clndta)// & 121 & ' differs from that of tracer : '//TRIM(clntrc)//' ') 116 122 ENDIF 117 WRITE(numout, *) ' read an initial file for passive tracer number :', jn, ' name : ', clndta, &118 & ' multiplicativefactor : ', zfact123 WRITE(numout,'(a, i4,3a,e11.3)') ' Read IC file for tracer number :', & 124 & jn, ', name : ', TRIM(clndta), ', Multiplicative Scaling factor : ', zfact 119 125 ENDIF 120 126 END DO … … 124 130 ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 ) 125 131 IF( ierr1 > 0 ) THEN 126 CALL ctl_stop( 'trc_dta_ini : unable to allocate sf_trcdta structure' ) ; RETURN132 CALL ctl_stop( 'trc_dta_init: unable to allocate sf_trcdta structure' ) ; RETURN 127 133 ENDIF 128 134 ! … … 135 141 IF( sn_trcdta(jn)%ln_tint ) ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 ) 136 142 IF( ierr2 + ierr3 > 0 ) THEN 137 CALL ctl_stop( 'trc_dta : unable to allocate passive tracer data arrays' ) ; RETURN143 CALL ctl_stop( 'trc_dta_init : unable to allocate passive tracer data arrays' ) ; RETURN 138 144 ENDIF 139 145 ENDIF … … 141 147 ENDDO 142 148 ! ! fill sf_trcdta with slf_i and control print 143 CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta ', 'Passive tracer data', 'namtrc' )149 CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta_init', 'Passive tracer data', 'namtrc' ) 144 150 ! 145 151 ENDIF … … 151 157 152 158 153 SUBROUTINE trc_dta( kt, ptrc)159 SUBROUTINE trc_dta( kt, sf_dta, ptrfac, ptrc) 154 160 !!---------------------------------------------------------------------- 155 161 !! *** ROUTINE trc_dta *** … … 161 167 !! - ln_trcdmp=F: deallocates the data structure as they are not used 162 168 !! 163 !! ** 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 169 !! ** Action : sf_dta passive tracer data on medl mesh and interpolated at time-step kt 170 !!---------------------------------------------------------------------- 171 INTEGER , INTENT(in ) :: kt ! ocean time-step 172 TYPE(FLD), DIMENSION(1) , INTENT(inout) :: sf_dta ! array of information on the field to read 173 REAL(wp) , INTENT(in ) :: ptrfac ! multiplication factor 174 REAL(wp), DIMENSION(jpi,jpj,jpk), OPTIONAL , INTENT(out ) :: ptrc 167 175 ! 168 176 INTEGER :: ji, jj, jk, jl, jkk, ik ! dummy loop indices 169 177 REAL(wp):: zl, zi 170 178 REAL(wp), DIMENSION(jpk) :: ztp ! 1D workspace 179 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace 171 180 CHARACTER(len=100) :: clndta 172 181 !!---------------------------------------------------------------------- … … 176 185 IF( nb_trcdta > 0 ) THEN 177 186 ! 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 187 CALL wrk_alloc( jpi, jpj, jpk, ztrcdta ) ! Memory allocation 188 ! 189 CALL fld_read( kt, 1, sf_dta ) !== read data at kt time step ==! 190 ztrcdta(:,:,:) = sf_dta(1)%fnow(:,:,:) * tmask(:,:,:) ! Mask 183 191 ! 184 192 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! … … 188 196 WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh' 189 197 ENDIF 190 DO jl = 1, nb_trcdta 191 DO jj = 1, jpj ! vertical interpolation of T & S 192 DO ji = 1, jpi 193 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 194 zl = fsdept_n(ji,jj,jk) 195 IF( zl < gdept_1d(1 ) ) THEN ! above the first level of data 196 ztp(jk) = ptrc(ji,jj,1,jl) 197 ELSEIF( zl > gdept_1d(jpk) ) THEN ! below the last level of data 198 ztp(jk) = ptrc(ji,jj,jpkm1,jl) 199 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 200 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 201 IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 202 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 203 ztp(jk) = ptrc(ji,jj,jkk,jl) + ( ptrc(ji,jj,jkk+1,jl) - ptrc(ji,jj,jkk,jl) ) * zi 204 ENDIF 205 END DO 206 ENDIF 207 END DO 208 DO jk = 1, jpkm1 209 ptrc(ji,jj,jk,jl) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord 210 END DO 211 ptrc(ji,jj,jpk,jl) = 0._wp 198 ! 199 DO jj = 1, jpj ! vertical interpolation of T & S 200 DO ji = 1, jpi 201 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 202 zl = fsdept_n(ji,jj,jk) 203 IF( zl < gdept_1d(1 ) ) THEN ! above the first level of data 204 ztp(jk) = ztrcdta(ji,jj,1) 205 ELSEIF( zl > gdept_1d(jpk) ) THEN ! below the last level of data 206 ztp(jk) = ztrcdta(ji,jj,jpkm1) 207 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 208 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 209 IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 210 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 211 ztp(jk) = ztrcdta(ji,jj,jkk) + ( ztrcdta(ji,jj,jkk+1) - & 212 ztrcdta(ji,jj,jkk) ) * zi 213 ENDIF 214 END DO 215 ENDIF 212 216 END DO 213 END DO 217 DO jk = 1, jpkm1 218 ztrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord 219 END DO 220 ztrcdta(ji,jj,jpk) = 0._wp 221 END DO 214 222 END DO 215 223 ! 216 224 ELSE !== z- or zps- coordinate ==! 217 ! 225 ! 218 226 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level 219 DO jl = 1, nb_trcdta 220 ! 221 DO jj = 1, jpj 222 DO ji = 1, jpi 223 ik = mbkt(ji,jj) 224 IF( ik > 1 ) THEN 225 zl = ( gdept_1d(ik) - fsdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 226 ptrc(ji,jj,ik,jl) = (1.-zl) * ptrc(ji,jj,ik,jl) + zl * ptrc(ji,jj,ik-1,jl) 227 ENDIF 228 ik = mikt(ji,jj) 229 IF( ik > 1 ) THEN 230 zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 231 ptrc(ji,jj,ik,jl) = (1.-zl) * ptrc(ji,jj,ik,jl) + zl * ptrc(ji,jj,ik+1,jl) 232 ENDIF 233 END DO 227 DO jj = 1, jpj 228 DO ji = 1, jpi 229 ik = mbkt(ji,jj) 230 IF( ik > 1 ) THEN 231 zl = ( gdept_1d(ik) - fsdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 232 ztrcdta(ji,jj,ik) = (1.-zl) * ztrcdta(ji,jj,ik) + zl * ztrcdta(ji,jj,ik-1) 233 ENDIF 234 ik = mikt(ji,jj) 235 IF( ik > 1 ) THEN 236 zl = ( fsdept_n(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 237 ztrcdta(ji,jj,ik) = (1.-zl) * ztrcdta(ji,jj,ik) + zl * ztrcdta(ji,jj,ik+1) 238 ENDIF 234 239 END DO 235 END DO 236 ENDIF 237 ! 238 ENDIF 239 ! 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 240 END DO 241 ENDIF 242 ! 243 ENDIF 244 ! 245 ! Add multiplicative factor 246 ztrcdta(:,:,:) = ztrcdta(:,:,:) * ptrfac 247 ! 248 ! Data structure for trc_ini (and BFMv5.1 coupling) 249 IF( .NOT. PRESENT(ptrc) ) sf_dta(1)%fnow(:,:,:) = ztrcdta(:,:,:) 250 ! 251 ! Data structure for trc_dmp 252 IF( PRESENT(ptrc) ) ptrc(:,:,:) = ztrcdta(:,:,:) 253 ! 254 IF( lwp .AND. kt == nit000 ) THEN 255 clndta = TRIM( sf_dta(1)%clvar ) 256 WRITE(numout,*) ''//clndta//' data ' 257 WRITE(numout,*) 258 WRITE(numout,*)' level = 1' 259 CALL prihre( ztrcdta(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 260 WRITE(numout,*)' level = ', jpk/2 261 CALL prihre( ztrcdta(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 262 WRITE(numout,*)' level = ', jpkm1 263 CALL prihre( ztrcdta(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 264 WRITE(numout,*) 265 ENDIF 266 ! 267 CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta ) 268 ! 249 269 ENDIF 250 270 ! … … 257 277 !!---------------------------------------------------------------------- 258 278 CONTAINS 259 SUBROUTINE trc_dta( kt, sf_ trcdta, zrf_trfac) ! Empty routine279 SUBROUTINE trc_dta( kt, sf_dta, ptrfac, ptrc) ! Empty routine 260 280 WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt 261 281 END SUBROUTINE trc_dta -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r6606 r6688 30 30 USE trcsub ! variables to substep passive tracers 31 31 USE lib_mpp ! distribued memory computing library 32 USE wrk_nemo33 32 USE sbc_oce 34 33 USE trcice ! tracers in sea ice … … 62 61 INTEGER :: jk, jn, jl ! dummy loop indices 63 62 CHARACTER (len=25) :: charout 64 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrcdta65 63 !!--------------------------------------------------------------------- 66 64 ! … … 122 120 IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN ! Initialisation of tracer from a file that may also be used for damping 123 121 ! 124 CALL wrk_alloc( jpi, jpj, jpk, nb_trcdta, ztrcdta )125 !126 CALL trc_dta( nit000, ztrcdta ) ! read tracer data at nit000127 !128 122 DO jn = 1, jptra 129 123 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 130 124 jl = n_trc_index(jn) 131 trn(:,:,:,jn) = ztrcdta(:,:,:,jl) * rf_trfac(jl) 125 CALL trc_dta( nit000, sf_trcdta(jl), rf_trfac(jl) ) ! read tracer data at nit000 126 trn(:,:,:,jn) = sf_trcdta(jl)%fnow(:,:,:) 127 IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN !== deallocate data structure ==! 128 ! (data used only for initialisation) 129 IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only used to initialize the run' 130 DEALLOCATE( sf_trcdta(jl)%fnow ) ! arrays in the structure 131 IF( sf_trcdta(jl)%ln_tint ) DEALLOCATE( sf_trcdta(jl)%fdta ) 132 ! 133 ENDIF 132 134 ENDIF 133 135 ENDDO 134 136 ! 135 CALL wrk_dealloc( jpi, jpj, jpk, nb_trcdta, ztrcdta )136 !137 137 ENDIF 138 138 !
Note: See TracChangeset
for help on using the changeset viewer.
