- Timestamp:
- 2015-07-10T13:28:53+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r4624 r5581 21 21 USE sbc_oce ! surface boundary condition: ocean 22 22 USE trc_oce ! share SMS/Ocean variables 23 USE trd mod_oce ! ocean variables trends24 USE trdtra ! ocean active tracers trends23 USE trd_oce ! trends: ocean variables 24 USE trdtra ! trends manager: tracers 25 25 USE in_out_manager ! I/O manager 26 26 USE phycst ! physical constants … … 32 32 USE wrk_nemo ! Memory Allocation 33 33 USE timing ! Timing 34 USE sbc_ice, ONLY : lk_lim335 34 36 35 IMPLICIT NONE … … 38 37 39 38 PUBLIC tra_qsr ! routine called by step.F90 (ln_traqsr=T) 40 PUBLIC tra_qsr_init ! routine called by opa.F9039 PUBLIC tra_qsr_init ! routine called by nemogcm.F90 41 40 42 41 ! !!* Namelist namtra_qsr: penetrative solar radiation … … 50 49 REAL(wp), PUBLIC :: rn_si0 !: very near surface depth of extinction (RGB & 2 bands) 51 50 REAL(wp), PUBLIC :: rn_si1 !: deepest depth of extinction (water type I) (2 bands) 52 51 53 52 ! Module variables 54 53 REAL(wp) :: xsi0r !: inverse of rn_si0 … … 129 128 IF( kt == nit000 ) THEN ! Set the forcing field at nit000 - 1 130 129 ! ! ----------------------------------- 130 qsr_hc(:,:,:) = 0.e0 131 ! 131 132 IF( ln_rstart .AND. & ! Restart: read in restart file 132 133 & iom_varid( numror, 'qsr_hc_b', ldstop = .FALSE. ) > 0 ) THEN … … 163 164 CALL iom_put( 'qsr3d', etot3 ) ! Shortwave Radiation 3D distribution 164 165 ! clem: store attenuation coefficient of the first ocean level 165 IF ( l k_lim3 .AND. ln_qsr_ice ) THEN166 IF ( ln_qsr_ice ) THEN 166 167 DO jj = 1, jpj 167 168 DO ji = 1, jpi 168 169 IF ( qsr(ji,jj) /= 0._wp ) THEN 169 oatte(ji,jj) = ( qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) ) 170 iatte(ji,jj) = oatte(ji,jj) 170 fraqsr_1lev(ji,jj) = ( qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) ) 171 ELSE 172 fraqsr_1lev(ji,jj) = 1. 171 173 ENDIF 172 174 END DO … … 232 234 END DO 233 235 ! clem: store attenuation coefficient of the first ocean level 234 IF ( l k_lim3 .AND. ln_qsr_ice ) THEN236 IF ( ln_qsr_ice ) THEN 235 237 DO jj = 1, jpj 236 238 DO ji = 1, jpi … … 239 241 zzc2 = zcoef * EXP( - fse3t(ji,jj,1) * zekg(ji,jj) ) 240 242 zzc3 = zcoef * EXP( - fse3t(ji,jj,1) * zekr(ji,jj) ) 241 oatte(ji,jj) = 1.0 - ( zzc0 + zzc1 + zzc2 + zzc3 ) * tmask(ji,jj,2) 242 iatte(ji,jj) = 1.0 - ( zzc0 + zzc1 + zcoef + zcoef ) * tmask(ji,jj,2) 243 fraqsr_1lev(ji,jj) = 1.0 - ( zzc0 + zzc1 + zzc2 + zzc3 ) * tmask(ji,jj,2) 243 244 END DO 244 245 END DO … … 256 257 END DO 257 258 ! clem: store attenuation coefficient of the first ocean level 258 IF ( lk_lim3 .AND. ln_qsr_ice ) THEN 259 oatte(:,:) = etot3(:,:,1) / r1_rau0_rcp 260 iatte(:,:) = oatte(:,:) 259 IF ( ln_qsr_ice ) THEN 260 fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp 261 261 ENDIF 262 262 ENDIF … … 280 280 END DO 281 281 ! clem: store attenuation coefficient of the first ocean level 282 IF ( l k_lim3 .AND. ln_qsr_ice ) THEN282 IF ( ln_qsr_ice ) THEN 283 283 DO jj = 1, jpj 284 284 DO ji = 1, jpi 285 285 zc0 = zz0 * EXP( -fsdepw(ji,jj,1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,1)*xsi1r ) 286 286 zc1 = zz0 * EXP( -fsdepw(ji,jj,2)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,2)*xsi1r ) 287 oatte(ji,jj) = ( zc0*tmask(ji,jj,1) - zc1*tmask(ji,jj,2) ) / r1_rau0_rcp 288 iatte(ji,jj) = oatte(ji,jj) 287 fraqsr_1lev(ji,jj) = ( zc0*tmask(ji,jj,1) - zc1*tmask(ji,jj,2) ) / r1_rau0_rcp 289 288 END DO 290 289 END DO … … 294 293 DO jj = 2, jpjm1 295 294 DO ji = fs_2, fs_jpim1 ! vector opt. 296 qsr_hc(ji,jj,jk) = etot3(ji,jj,jk) * qsr(ji,jj) 295 ! (ISF) no light penetration below the ice shelves 296 qsr_hc(ji,jj,jk) = etot3(ji,jj,jk) * qsr(ji,jj) * tmask(ji,jj,1) 297 297 END DO 298 298 END DO 299 299 END DO 300 300 ! clem: store attenuation coefficient of the first ocean level 301 IF ( lk_lim3 .AND. ln_qsr_ice ) THEN 302 oatte(:,:) = etot3(:,:,1) / r1_rau0_rcp 303 iatte(:,:) = oatte(:,:) 301 IF ( ln_qsr_ice ) THEN 302 fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp 304 303 ENDIF 305 304 ! … … 326 325 & 'at it= ', kt,' date= ', ndastp 327 326 IF(lwp) WRITE(numout,*) '~~~~' 328 CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b', qsr_hc ) 327 CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b' , qsr_hc ) 328 CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev ) ! default definition in sbcssm 329 329 ! 330 330 ENDIF … … 332 332 IF( l_trdtra ) THEN ! qsr tracers trends saved for diagnostics 333 333 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 334 CALL trd_tra( kt, 'TRA', jp_tem, jptra_ trd_qsr, ztrdt )334 CALL trd_tra( kt, 'TRA', jp_tem, jptra_qsr, ztrdt ) 335 335 CALL wrk_dealloc( jpi, jpj, jpk, ztrdt ) 336 336 ENDIF … … 381 381 ! 382 382 IF( nn_timing == 1 ) CALL timing_start('tra_qsr_init') 383 !384 ! clem init for oatte and iatte385 IF( .NOT. ln_rstart ) THEN386 oatte(:,:) = 1._wp387 iatte(:,:) = 1._wp388 ENDIF389 383 ! 390 384 CALL wrk_alloc( jpi, jpj, zekb, zekg, zekr ) … … 415 409 WRITE(numout,*) ' RGB & 2 bands: shortess depth of extinction rn_si0 = ', rn_si0 416 410 WRITE(numout,*) ' 2 bands: longest depth of extinction rn_si1 = ', rn_si1 417 WRITE(numout,*) ' light penetration for ice-model LIM3 ln_qsr_ice = ', ln_qsr_ice418 411 ENDIF 419 412 … … 520 513 ! 521 514 DO jk = 1, nksr 522 etot3(:,:,jk) = r1_rau0_rcp * ( zea(:,:,jk) - zea(:,:,jk+1) ) 515 ! (ISF) no light penetration below the ice shelves 516 etot3(:,:,jk) = r1_rau0_rcp * ( zea(:,:,jk) - zea(:,:,jk+1) ) * tmask(:,:,1) 523 517 END DO 524 518 etot3(:,:,nksr+1:jpk) = 0.e0 ! below 400m set to zero … … 548 542 zc0 = zz0 * EXP( -fsdepw(ji,jj,jk )*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk )*xsi1r ) 549 543 zc1 = zz0 * EXP( -fsdepw(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r ) 550 etot3(ji,jj,jk) = ( zc0 * tmask(ji,jj,jk) - zc1 * tmask(ji,jj,jk+1) ) 544 etot3(ji,jj,jk) = ( zc0 * tmask(ji,jj,jk) - zc1 * tmask(ji,jj,jk+1) ) * tmask(ji,jj,1) 551 545 END DO 552 546 END DO … … 566 560 ENDIF 567 561 ! 562 ! initialisation of fraqsr_1lev used in sbcssm 563 IF( iom_varid( numror, 'fraqsr_1lev', ldstop = .FALSE. ) > 0 ) THEN 564 CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev' , fraqsr_1lev ) 565 ELSE 566 fraqsr_1lev(:,:) = 1._wp ! default definition 567 ENDIF 568 ! 568 569 CALL wrk_dealloc( jpi, jpj, zekb, zekg, zekr ) 569 570 CALL wrk_dealloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea )
Note: See TracChangeset
for help on using the changeset viewer.
