Changeset 5989 for branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
- Timestamp:
- 2015-12-03T09:10:32+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r5260 r5989 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 … … 165 164 CALL iom_put( 'qsr3d', etot3 ) ! Shortwave Radiation 3D distribution 166 165 ! clem: store attenuation coefficient of the first ocean level 167 IF ( l k_lim3 .AND. ln_qsr_ice ) THEN166 IF ( ln_qsr_ice ) THEN 168 167 DO jj = 1, jpj 169 168 DO ji = 1, jpi 170 169 IF ( qsr(ji,jj) /= 0._wp ) THEN 171 170 fraqsr_1lev(ji,jj) = ( qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) ) 171 ELSE 172 fraqsr_1lev(ji,jj) = 1. 172 173 ENDIF 173 174 END DO … … 188 189 CALL fld_read( kt, 1, sf_chl ) ! Read Chl data and provides it at the current time step 189 190 ! 190 !CDIR COLLAPSE191 !CDIR NOVERRCHK192 191 DO jj = 1, jpj ! Separation in R-G-B depending of the surface Chl 193 !CDIR NOVERRCHK194 192 DO ji = 1, jpi 195 193 zchl = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) ) … … 216 214 ! 217 215 DO jk = 2, nksr+1 218 !CDIR NOVERRCHK219 216 DO jj = 1, jpj 220 !CDIR NOVERRCHK221 217 DO ji = 1, jpi 222 218 zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * xsi0r ) … … 233 229 END DO 234 230 ! clem: store attenuation coefficient of the first ocean level 235 IF ( l k_lim3 .AND. ln_qsr_ice ) THEN231 IF ( ln_qsr_ice ) THEN 236 232 DO jj = 1, jpj 237 233 DO ji = 1, jpi … … 256 252 END DO 257 253 ! clem: store attenuation coefficient of the first ocean level 258 IF ( l k_lim3 .AND. ln_qsr_ice ) THEN254 IF ( ln_qsr_ice ) THEN 259 255 fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp 260 256 ENDIF … … 279 275 END DO 280 276 ! clem: store attenuation coefficient of the first ocean level 281 IF ( l k_lim3 .AND. ln_qsr_ice ) THEN277 IF ( ln_qsr_ice ) THEN 282 278 DO jj = 1, jpj 283 279 DO ji = 1, jpi … … 298 294 END DO 299 295 ! clem: store attenuation coefficient of the first ocean level 300 IF ( l k_lim3 .AND. ln_qsr_ice ) THEN296 IF ( ln_qsr_ice ) THEN 301 297 fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp 302 298 ENDIF … … 324 320 & 'at it= ', kt,' date= ', ndastp 325 321 IF(lwp) WRITE(numout,*) '~~~~' 326 CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b', qsr_hc ) 322 CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b' , qsr_hc ) 323 CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev ) ! default definition in sbcssm 327 324 ! 328 325 ENDIF … … 379 376 ! 380 377 IF( nn_timing == 1 ) CALL timing_start('tra_qsr_init') 381 !382 ! Default value for fraqsr_1lev383 IF( .NOT. ln_rstart ) THEN384 fraqsr_1lev(:,:) = 1._wp385 ENDIF386 378 ! 387 379 CALL wrk_alloc( jpi, jpj, zekb, zekg, zekr ) … … 412 404 WRITE(numout,*) ' RGB & 2 bands: shortess depth of extinction rn_si0 = ', rn_si0 413 405 WRITE(numout,*) ' 2 bands: longest depth of extinction rn_si1 = ', rn_si1 414 WRITE(numout,*) ' light penetration for ice-model LIM3 ln_qsr_ice = ', ln_qsr_ice415 406 ENDIF 416 407 … … 499 490 500 491 DO jk = 2, nksr+1 501 !CDIR NOVERRCHK502 492 DO jj = 1, jpj 503 !CDIR NOVERRCHK504 493 DO ji = 1, jpi 505 494 zc0 = ze0(ji,jj,jk-1) * EXP( - e3t_0(ji,jj,jk-1) * xsi0r ) … … 564 553 ENDIF 565 554 ! 555 ! initialisation of fraqsr_1lev used in sbcssm 556 IF( iom_varid( numror, 'fraqsr_1lev', ldstop = .FALSE. ) > 0 ) THEN 557 CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev' , fraqsr_1lev ) 558 ELSE 559 fraqsr_1lev(:,:) = 1._wp ! default definition 560 ENDIF 561 ! 566 562 CALL wrk_dealloc( jpi, jpj, zekb, zekg, zekr ) 567 563 CALL wrk_dealloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea )
Note: See TracChangeset
for help on using the changeset viewer.