- Timestamp:
- 2020-09-24T20:49:07+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traqsr.F90
r13333 r13518 22 22 USE phycst ! physical constants 23 23 USE dom_oce ! ocean space and time domain 24 USE domain, ONLY : dom_tile 24 25 USE sbc_oce ! surface boundary condition: ocean 25 26 USE trc_oce ! share SMS/Ocean variables … … 114 115 REAL(wp) :: zCb, zCmax, zpsi, zpsimax, zrdpsi, zCze 115 116 REAL(wp) :: zlogc, zlogze, zlogCtot, zlogCze 117 ! TEMP: These changes not necessary after trd_tra is tiled 118 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ztrdt 116 119 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ze0, ze1, ze2, ze3 117 120 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, zetot, ztmp3d … … 120 123 IF( ln_timing ) CALL timing_start('tra_qsr') 121 124 ! 122 IF( kt == nit000 ) THEN 123 IF(lwp) WRITE(numout,*) 124 IF(lwp) WRITE(numout,*) 'tra_qsr : penetration of the surface solar radiation' 125 IF(lwp) WRITE(numout,*) '~~~~~~~' 125 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 126 IF( kt == nit000 ) THEN 127 IF(lwp) WRITE(numout,*) 128 IF(lwp) WRITE(numout,*) 'tra_qsr : penetration of the surface solar radiation' 129 IF(lwp) WRITE(numout,*) '~~~~~~~' 130 ENDIF 126 131 ENDIF 127 132 ! 128 133 IF( l_trdtra ) THEN ! trends diagnostic: save the input temperature trend 129 ALLOCATE( ztrdt(jpi,jpj,jpk) ) 130 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 134 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 135 ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 136 ALLOCATE( ztrdt(jpi,jpj,jpk) ) 137 ENDIF 138 139 DO_3D( 0, 0, 0, 0, 1, jpk ) 140 ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs) 141 END_3D 131 142 ENDIF 132 143 ! … … 136 147 IF( kt == nit000 ) THEN !== 1st time step ==! 137 148 IF( ln_rstart .AND. iom_varid( numror, 'qsr_hc_b', ldstop = .FALSE. ) > 0 .AND. .NOT.l_1st_euler ) THEN ! read in restart 138 IF(lwp) WRITE(numout,*) ' nit000-1 qsr tracer content forcing field read in the restart file'139 149 z1_2 = 0.5_wp 140 CALL iom_get( numror, jpdom_auto, 'qsr_hc_b', qsr_hc_b, ldxios = lrxios ) ! before heat content trend due to Qsr flux 150 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 151 IF(lwp) WRITE(numout,*) ' nit000-1 qsr tracer content forcing field read in the restart file' 152 CALL iom_get( numror, jpdom_auto, 'qsr_hc_b', qsr_hc_b, ldxios = lrxios ) ! before heat content trend due to Qsr flux 153 ENDIF 141 154 ELSE ! No restart or restart not found: Euler forward time stepping 142 155 z1_2 = 1._wp 143 qsr_hc_b(:,:,:) = 0._wp 156 DO_3D( 0, 0, 0, 0, 1, jpk ) 157 qsr_hc_b(ji,jj,jk) = 0._wp 158 END_3D 144 159 ENDIF 145 160 ELSE !== Swap of qsr heat content ==! 146 161 z1_2 = 0.5_wp 147 qsr_hc_b(:,:,:) = qsr_hc(:,:,:) 162 DO_3D( 0, 0, 0, 0, 1, jpk ) 163 qsr_hc_b(ji,jj,jk) = qsr_hc(ji,jj,jk) 164 END_3D 148 165 ENDIF 149 166 ! … … 154 171 CASE( np_BIO ) !== bio-model fluxes ==! 155 172 ! 156 DO jk = 1, nksr157 qsr_hc( :,:,jk) = r1_rho0_rcp * ( etot3(:,:,jk) - etot3(:,:,jk+1) )158 END DO173 DO_3D( 0, 0, 0, 0, 1, nksr ) 174 qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( etot3(ji,jj,jk) - etot3(ji,jj,jk+1) ) 175 END_3D 159 176 ! 160 177 CASE( np_RGB , np_RGBc ) !== R-G-B fluxes ==! 161 178 ! 162 ALLOCATE( ze0 ( jpi,jpj) , ze1 (jpi,jpj) , &163 & ze2 ( jpi,jpj) , ze3 (jpi,jpj) , &164 & ztmp3d( jpi,jpj,nksr + 1) )179 ALLOCATE( ze0 (ST_2D(nn_hls)) , ze1 (ST_2D(nn_hls)) , & 180 & ze2 (ST_2D(nn_hls)) , ze3 (ST_2D(nn_hls)) , & 181 & ztmp3d(ST_2D(nn_hls),nksr + 1) ) 165 182 ! 166 183 IF( nqsr == np_RGBc ) THEN !* Variable Chlorophyll 167 CALL fld_read( kt, 1, sf_chl ) ! Read Chl data and provides it at the current time step 184 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only for the full domain 185 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 186 CALL fld_read( kt, 1, sf_chl ) ! Read Chl data and provides it at the current time step 187 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 1 ) ! Revert to tile domain 188 ENDIF 168 189 ! 169 190 ! Separation in R-G-B depending on the surface Chl … … 215 236 ! Convert chlorophyll value to attenuation coefficient look-up table index 216 237 zlui = 41 + 20.*LOG10(zchl) + 1.e-15 217 DO jk = 1, nksr + 1218 ztmp3d( :,:,jk) = zlui219 END DO238 DO_3D( 1, 1, 1, 1, 1, nksr + 1 ) 239 ztmp3d(ji,jj,jk) = zlui 240 END_3D 220 241 ENDIF 221 242 ! … … 277 298 ENDIF 278 299 END_2D 279 CALL lbc_lnk( 'traqsr', fraqsr_1lev(:,:), 'T', 1._wp ) 280 ! 281 IF( iom_use('qsr3d') ) THEN ! output the shortwave Radiation distribution 282 ALLOCATE( zetot(jpi,jpj,jpk) ) 283 zetot(:,:,nksr+1:jpk) = 0._wp ! below ~400m set to zero 284 DO jk = nksr, 1, -1 285 zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) * rho0_rcp 286 END DO 287 CALL iom_put( 'qsr3d', zetot ) ! 3D distribution of shortwave Radiation 288 DEALLOCATE( zetot ) 289 ENDIF 290 ! 291 IF( lrst_oce ) THEN ! write in the ocean restart file 292 IF( lwxios ) CALL iom_swap( cwxios_context ) 293 CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b' , qsr_hc , ldxios = lwxios ) 294 CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev, ldxios = lwxios ) 295 IF( lwxios ) CALL iom_swap( cxios_context ) 296 ENDIF 297 ! 300 ! TEMP: This change not necessary after extra haloes development (lbc_lnk removed) 301 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 302 CALL lbc_lnk( 'traqsr', fraqsr_1lev(:,:), 'T', 1._wp ) 303 ENDIF 304 ! 305 ! TEMP: This change not necessary and working array can use ST_2D(nn_hls) if using XIOS (subdomain support) 306 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 307 IF( iom_use('qsr3d') ) THEN ! output the shortwave Radiation distribution 308 ALLOCATE( zetot(jpi,jpj,jpk) ) 309 zetot(:,:,nksr+1:jpk) = 0._wp ! below ~400m set to zero 310 DO jk = nksr, 1, -1 311 zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) * rho0_rcp 312 END DO 313 CALL iom_put( 'qsr3d', zetot ) ! 3D distribution of shortwave Radiation 314 DEALLOCATE( zetot ) 315 ENDIF 316 ENDIF 317 ! 318 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 319 IF( lrst_oce ) THEN ! write in the ocean restart file 320 IF( lwxios ) CALL iom_swap( cwxios_context ) 321 CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b' , qsr_hc , ldxios = lwxios ) 322 CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev, ldxios = lwxios ) 323 IF( lwxios ) CALL iom_swap( cxios_context ) 324 ENDIF 325 ENDIF 326 ! 327 ! TEMP: These changes not necessary after trd_tra is tiled 298 328 IF( l_trdtra ) THEN ! qsr tracers trends saved for diagnostics 299 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 300 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_qsr, ztrdt ) 301 DEALLOCATE( ztrdt ) 329 DO_3D( 0, 0, 0, 0, 1, jpk ) 330 ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs) - ztrdt(ji,jj,jk) 331 END_3D 332 333 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 334 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 335 336 ! TODO: TO BE TILED- trd_tra 337 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_qsr, ztrdt ) 338 DEALLOCATE( ztrdt ) 339 340 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = nijtile ) ! Revert to tile domain 341 ENDIF 302 342 ENDIF 303 343 ! ! print mean trends (used for debugging)
Note: See TracChangeset
for help on using the changeset viewer.
