- Timestamp:
- 2017-12-01T18:44:09+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r7753 r8882 29 29 USE in_out_manager ! I/O manager 30 30 USE prtctl ! Print control 31 USE iom ! I/O manager31 USE iom ! I/O library 32 32 USE fldread ! read input fields 33 33 USE restart ! ocean restart 34 34 USE lib_mpp ! MPP library 35 35 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 36 USE wrk_nemo ! Memory Allocation37 36 USE timing ! Timing 38 37 … … 48 47 LOGICAL , PUBLIC :: ln_qsr_2bd !: 2 band light absorption flag 49 48 LOGICAL , PUBLIC :: ln_qsr_bio !: bio-model light absorption flag 50 LOGICAL , PUBLIC :: ln_qsr_ice !: light penetration for ice-model LIM3 (clem)51 49 INTEGER , PUBLIC :: nn_chldta !: use Chlorophyll data (=1) or not (=0) 52 50 REAL(wp), PUBLIC :: rn_abs !: fraction absorbed in the very near surface (RGB & 2 bands) … … 113 111 REAL(wp) :: zCb, zCmax, zze, zpsi, zpsimax, zdelpsi, zCtot, zCze 114 112 REAL(wp) :: zlogc, zlogc2, zlogc3 115 REAL(wp), POINTER, DIMENSION(:,:) :: zekb, zekg, zekr116 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt117 REAL(wp), POINTER, DIMENSION(:,:,:) :: zetot, zchl3d118 !!---------------------------------------------------------------------- 119 ! 120 IF( nn_timing == 1 )CALL timing_start('tra_qsr')113 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zekb, zekg, zekr 114 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt 115 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zetot, zchl3d 116 !!---------------------------------------------------------------------- 117 ! 118 IF( ln_timing ) CALL timing_start('tra_qsr') 121 119 ! 122 120 IF( kt == nit000 ) THEN … … 127 125 ! 128 126 IF( l_trdtra ) THEN ! trends diagnostic: save the input temperature trend 129 CALL wrk_alloc( jpi,jpj,jpk, ztrdt)127 ALLOCATE( ztrdt(jpi,jpj,jpk) ) 130 128 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 131 129 ENDIF … … 161 159 CASE( np_RGB , np_RGBc ) !== R-G-B fluxes ==! 162 160 ! 163 CALL wrk_alloc( jpi,jpj, zekb, zekg, zekr ) 164 CALL wrk_alloc( jpi,jpj,jpk, ze0, ze1, ze2, ze3, zea, zchl3d ) 161 ALLOCATE( zekb(jpi,jpj) , zekg(jpi,jpj) , zekr (jpi,jpj) , & 162 & ze0 (jpi,jpj,jpk) , ze1 (jpi,jpj,jpk) , ze2 (jpi,jpj,jpk) , & 163 & ze3 (jpi,jpj,jpk) , zea (jpi,jpj,jpk) , zchl3d(jpi,jpj,jpk) ) 165 164 ! 166 165 IF( nqsr == np_RGBc ) THEN !* Variable Chlorophyll … … 240 239 END DO 241 240 ! 242 CALL wrk_dealloc( jpi,jpj, zekb, zekg, zekr ) 243 CALL wrk_dealloc( jpi,jpj,jpk, ze0, ze1, ze2, ze3, zea, zchl3d ) 241 DEALLOCATE( zekb , zekg , zekr , ze0 , ze1 , ze2 , ze3 , zea , zchl3d ) 244 242 ! 245 243 CASE( np_2BD ) !== 2-bands fluxes ==! … … 269 267 END DO 270 268 ! 271 IF( ln_qsr_ice ) THEN ! sea-ice: store the 1st ocean level attenuation coefficient 272 DO jj = 2, jpjm1 273 DO ji = fs_2, fs_jpim1 ! vector opt. 274 IF( qsr(ji,jj) /= 0._wp ) THEN ; fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) 275 ELSE ; fraqsr_1lev(ji,jj) = 1._wp 276 ENDIF 277 END DO 278 END DO 279 ! Update haloes since lim_thd needs fraqsr_1lev to be defined everywhere 280 CALL lbc_lnk( fraqsr_1lev(:,:), 'T', 1._wp ) 281 ENDIF 269 ! sea-ice: store the 1st ocean level attenuation coefficient 270 DO jj = 2, jpjm1 271 DO ji = fs_2, fs_jpim1 ! vector opt. 272 IF( qsr(ji,jj) /= 0._wp ) THEN ; fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) 273 ELSE ; fraqsr_1lev(ji,jj) = 1._wp 274 ENDIF 275 END DO 276 END DO 277 CALL lbc_lnk( fraqsr_1lev(:,:), 'T', 1._wp ) 282 278 ! 283 279 IF( iom_use('qsr3d') ) THEN ! output the shortwave Radiation distribution 284 CALL wrk_alloc( jpi,jpj,jpk, zetot ) 285 ! 280 ALLOCATE( zetot(jpi,jpj,jpk) ) 286 281 zetot(:,:,nksr+1:jpk) = 0._wp ! below ~400m set to zero 287 282 DO jk = nksr, 1, -1 288 zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) / r1_rau0_rcp283 zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) * rau0_rcp 289 284 END DO 290 285 CALL iom_put( 'qsr3d', zetot ) ! 3D distribution of shortwave Radiation 291 ! 292 CALL wrk_dealloc( jpi,jpj,jpk, zetot ) 286 DEALLOCATE( zetot ) 293 287 ENDIF 294 288 ! … … 301 295 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 302 296 CALL trd_tra( kt, 'TRA', jp_tem, jptra_qsr, ztrdt ) 303 CALL wrk_dealloc( jpi,jpj,jpk,ztrdt )297 DEALLOCATE( ztrdt ) 304 298 ENDIF 305 299 ! ! print mean trends (used for debugging) 306 300 IF(ln_ctl) CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' qsr - Ta: ', mask1=tmask, clinfo3='tra-ta' ) 307 301 ! 308 IF( nn_timing == 1 )CALL timing_stop('tra_qsr')302 IF( ln_timing ) CALL timing_stop('tra_qsr') 309 303 ! 310 304 END SUBROUTINE tra_qsr … … 336 330 TYPE(FLD_N) :: sn_chl ! informations about the chlorofyl field to be read 337 331 !! 338 NAMELIST/namtra_qsr/ sn_chl, cn_dir, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, ln_qsr_ice,&332 NAMELIST/namtra_qsr/ sn_chl, cn_dir, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, & 339 333 & nn_chldta, rn_abs, rn_si0, rn_si1 340 334 !!---------------------------------------------------------------------- 341 335 ! 342 IF( nn_timing == 1) CALL timing_start('tra_qsr_init')336 IF( ln_timing ) CALL timing_start('tra_qsr_init') 343 337 ! 344 338 REWIND( numnam_ref ) ! Namelist namtra_qsr in reference namelist … … 359 353 WRITE(numout,*) ' 2 band light penetration ln_qsr_2bd = ', ln_qsr_2bd 360 354 WRITE(numout,*) ' bio-model light penetration ln_qsr_bio = ', ln_qsr_bio 361 WRITE(numout,*) ' light penetration for ice-model (LIM3) ln_qsr_ice = ', ln_qsr_ice362 355 WRITE(numout,*) ' RGB : Chl data (=1) or cst value (=0) nn_chldta = ', nn_chldta 363 356 WRITE(numout,*) ' RGB & 2 bands: fraction of light (rn_si1) rn_abs = ', rn_abs … … 435 428 ENDIF 436 429 ! 437 IF( nn_timing == 1) CALL timing_stop('tra_qsr_init')430 IF( ln_timing ) CALL timing_stop('tra_qsr_init') 438 431 ! 439 432 END SUBROUTINE tra_qsr_init
Note: See TracChangeset
for help on using the changeset viewer.
