- Timestamp:
- 2021-11-28T18:59:49+01:00 (3 years ago)
- Location:
- NEMO/branches/2021/ticket2632_r14588_theta_sbcblk
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/TRA/traqsr.F90 (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk
- Property svn:externals
-
old new 9 9 10 10 # SETTE 11 ^/utils/CI/sette@14244 sette 11 ^/utils/CI/sette@HEAD sette 12
-
- Property svn:externals
-
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/OCE/TRA/traqsr.F90
r14215 r15548 108 108 ! 109 109 INTEGER :: ji, jj, jk ! dummy loop indices 110 INTEGER :: irgb , isi, iei, isj, iej! local integers110 INTEGER :: irgb ! local integers 111 111 REAL(wp) :: zchl, zcoef, z1_2 ! local scalars 112 112 REAL(wp) :: zc0 , zc1 , zc2 , zc3 ! - - … … 121 121 IF( ln_timing ) CALL timing_start('tra_qsr') 122 122 ! 123 IF( ntile == 0.OR. ntile == 1 ) THEN ! Do only on the first tile123 IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile 124 124 IF( kt == nit000 ) THEN 125 125 IF(lwp) WRITE(numout,*) … … 137 137 ! ! before qsr induced heat content ! 138 138 ! !-----------------------------------! 139 IF( ntsi == Nis0 ) THEN ; isi = nn_hls ; ELSE ; isi = 0 ; ENDIF ! Avoid double-counting when using tiling140 IF( ntsj == Njs0 ) THEN ; isj = nn_hls ; ELSE ; isj = 0 ; ENDIF141 IF( ntei == Nie0 ) THEN ; iei = nn_hls ; ELSE ; iei = 0 ; ENDIF142 IF( ntej == Nje0 ) THEN ; iej = nn_hls ; ELSE ; iej = 0 ; ENDIF143 144 139 IF( kt == nit000 ) THEN !== 1st time step ==! 145 140 IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN ! read in restart 146 141 z1_2 = 0.5_wp 147 IF( ntile == 0.OR. ntile == 1 ) THEN ! Do only on the first tile142 IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile 148 143 IF(lwp) WRITE(numout,*) ' nit000-1 qsr tracer content forcing field read in the restart file' 149 144 CALL iom_get( numror, jpdom_auto, 'qsr_hc_b', qsr_hc_b ) ! before heat content trend due to Qsr flux … … 151 146 ELSE ! No restart or Euler forward at 1st time step 152 147 z1_2 = 1._wp 153 DO_3D ( isi, iei, isj, iej, 1, jpk )148 DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 154 149 qsr_hc_b(ji,jj,jk) = 0._wp 155 150 END_3D … … 157 152 ELSE !== Swap of qsr heat content ==! 158 153 z1_2 = 0.5_wp 159 DO_3D ( isi, iei, isj, iej, 1, jpk )154 DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 160 155 qsr_hc_b(ji,jj,jk) = qsr_hc(ji,jj,jk) 161 156 END_3D … … 168 163 CASE( np_BIO ) !== bio-model fluxes ==! 169 164 ! 170 DO_3D ( isi, iei, isj, iej, 1, nksr )165 DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr ) 171 166 qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( etot3(ji,jj,jk) - etot3(ji,jj,jk+1) ) 172 167 END_3D … … 179 174 ! 180 175 IF( nqsr == np_RGBc ) THEN !* Variable Chlorophyll 181 IF( ntile == 0.OR. ntile == 1 ) THEN ! Do only for the full domain182 IF( ln_tile ) CALL dom_tile ( ntsi, ntsj, ntei, ntej, ktile = 0 )! Use full domain176 IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only for the full domain 177 IF( ln_tile ) CALL dom_tile_stop( ldhold=.TRUE. ) ! Use full domain 183 178 CALL fld_read( kt, 1, sf_chl ) ! Read Chl data and provides it at the current time step 184 IF( ln_tile ) CALL dom_tile ( ntsi, ntsj, ntei, ntej, ktile = 1) ! Revert to tile domain179 IF( ln_tile ) CALL dom_tile_start( ldhold=.TRUE. ) ! Revert to tile domain 185 180 ENDIF 186 181 ! … … 190 185 ! most expensive calculations) 191 186 ! 192 DO_2D ( isi, iei, isj, iej)187 DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 193 188 ! zlogc = log(zchl) 194 189 zlogc = LOG ( MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) ) ) … … 209 204 210 205 ! 211 DO_3D ( isi, iei, isj, iej, 1, nksr + 1 )206 DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr + 1 ) 212 207 ! zchl = ALOG( ze0(ji,jj) ) 213 208 zlogc = ze0(ji,jj) … … 239 234 ! 240 235 zcoef = ( 1. - rn_abs ) / 3._wp !* surface equi-partition in R-G-B 241 DO_2D ( isi, iei, isj, iej)236 DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 242 237 ze0(ji,jj) = rn_abs * qsr(ji,jj) 243 238 ze1(ji,jj) = zcoef * qsr(ji,jj) … … 250 245 ! 251 246 ! !* interior equi-partition in R-G-B depending on vertical profile of Chl 252 DO_3D ( isi, iei, isj, iej, 2, nksr + 1 )247 DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 2, nksr + 1 ) 253 248 ze3t = e3t(ji,jj,jk-1,Kmm) 254 249 irgb = NINT( ztmp3d(ji,jj,jk) ) … … 264 259 END_3D 265 260 ! 266 DO_3D ( isi, iei, isj, iej, 1, nksr ) !* now qsr induced heat content261 DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr ) !* now qsr induced heat content 267 262 qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( ztmp3d(ji,jj,jk) - ztmp3d(ji,jj,jk+1) ) 268 263 END_3D … … 274 269 zz0 = rn_abs * r1_rho0_rcp ! surface equi-partition in 2-bands 275 270 zz1 = ( 1. - rn_abs ) * r1_rho0_rcp 276 DO_3D ( isi, iei, isj, iej, 1, nksr ) !* now qsr induced heat content271 DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr ) !* now qsr induced heat content 277 272 zc0 = zz0 * EXP( -gdepw(ji,jj,jk ,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk ,Kmm)*xsi1r ) 278 273 zc1 = zz0 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi1r ) … … 292 287 ! 293 288 ! sea-ice: store the 1st ocean level attenuation coefficient 294 DO_2D ( isi, iei, isj, iej)289 DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls ) 295 290 IF( qsr(ji,jj) /= 0._wp ) THEN ; fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rho0_rcp * qsr(ji,jj) ) 296 291 ELSE ; fraqsr_1lev(ji,jj) = 1._wp … … 298 293 END_2D 299 294 ! 300 ! TEMP: [tiling] This change not necessary and working array can use A2D(nn_hls) if using XIOS (subdomain support) 301 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 302 IF( iom_use('qsr3d') ) THEN ! output the shortwave Radiation distribution 303 ALLOCATE( zetot(jpi,jpj,jpk) ) 304 zetot(:,:,nksr+1:jpk) = 0._wp ! below ~400m set to zero 305 DO jk = nksr, 1, -1 306 zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) * rho0_rcp 307 END DO 308 CALL iom_put( 'qsr3d', zetot ) ! 3D distribution of shortwave Radiation 309 DEALLOCATE( zetot ) 310 ENDIF 311 ENDIF 312 ! 313 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 295 IF( iom_use('qsr3d') ) THEN ! output the shortwave Radiation distribution 296 ALLOCATE( zetot(A2D(nn_hls),jpk) ) 297 zetot(:,:,nksr+1:jpk) = 0._wp ! below ~400m set to zero 298 DO_3DS(0, 0, 0, 0, nksr, 1, -1) 299 zetot(ji,jj,jk) = zetot(ji,jj,jk+1) + qsr_hc(ji,jj,jk) * rho0_rcp 300 END_3D 301 CALL iom_put( 'qsr3d', zetot ) ! 3D distribution of shortwave Radiation 302 DEALLOCATE( zetot ) 303 ENDIF 304 ! 305 IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN ! Do only on the last tile 314 306 IF( lrst_oce ) THEN ! write in the ocean restart file 315 307 CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b' , qsr_hc )
Note: See TracChangeset
for help on using the changeset viewer.
