- Timestamp:
- 2019-06-18T17:48:39+02:00 (5 years ago)
- Location:
- branches/UKMO/r6232_collate_bgc_diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA
- Files:
-
- 5 edited
-
eosbn2.F90 (modified) (1 diff)
-
traadv_tvd.F90 (modified) (1 diff)
-
tranxt.F90 (modified) (3 diffs)
-
traqsr.F90 (modified) (9 diffs)
-
trasbc.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/r6232_collate_bgc_diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
r11132 r11134 1241 1241 IF(lwm) WRITE( numond, nameos ) 1242 1242 ! 1243 rau0 = 1026._wp !: volumic mass of reference [kg/m3] 1243 rau0 = 1020._wp !: volumic mass of reference [kg/m3] 1244 ! rau0 = 1026._wp !: volumic mass of reference [kg/m3] 1244 1245 rcp = 3991.86795711963_wp !: heat capacity [J/K] 1245 1246 ! -
branches/UKMO/r6232_collate_bgc_diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r11132 r11134 100 100 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 101 101 ENDIF 102 ! slwa unless you use l_trdtra too, the above switches off trend calculations for l_trdtrc 103 l_trd = .FALSE. 104 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 105 !slwa 102 106 ! 103 107 IF( l_trd ) THEN -
branches/UKMO/r6232_collate_bgc_diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r11132 r11134 58 58 59 59 REAL(wp) :: rbcp ! Brown & Campana parameters for semi-implicit hpg 60 INTEGER :: warn_1, warn_2 ! indicators for warning statement 60 61 61 62 !! * Substitutions … … 93 94 INTEGER, INTENT(in) :: kt ! ocean time-step index 94 95 !! 95 INTEGER :: jk, jn ! dummy loop indices96 REAL(wp) :: zfact ! local scalars96 INTEGER :: jk, jn, ji, jj ! dummy loop indices 97 REAL(wp) :: zfact, zfreeze ! local scalars 97 98 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds 98 99 !!---------------------------------------------------------------------- … … 125 126 ELSEIF( kt <= nit000 + 1 ) THEN ; r2dtra(:) = 2._wp* rdttra(:) ! at nit000 or nit000+1 (Leapfrog) 126 127 ENDIF 128 129 #if ( ! defined key_lim3 && ! defined key_lim2 && ! key_cice ) 130 IF ( kt == nit000 ) warn_1=0 131 warn_2=0 132 DO jk = 1, jpkm1 133 DO jj = 1, jpj 134 DO ji = 1, jpi 135 IF ( tsa(ji,jj,jk,jp_tem) .lt. 0.0 ) THEN 136 ! calculate freezing point 137 zfreeze = ( -0.0575_wp + 1.710523E-3 * Sqrt(Abs(tsn(ji,jj,jk,jp_sal))) & 138 - 2.154996E-4 * tsn(ji,jj,jk,jp_sal) ) * tsn(ji,jj,jk,jp_sal) - 7.53E-4 * ( 10.0_wp + fsdept(ji,jj,jk) ) 139 IF ( tsa(ji,jj,jk,jp_tem) .lt. zfreeze ) THEN 140 tsa(ji,jj,jk,jp_tem)=zfreeze 141 warn_2=1 142 ENDIF 143 ENDIF 144 END DO 145 END DO 146 END DO 147 CALL mpp_max(warn_1) 148 CALL mpp_max(warn_2) 149 IF ( (warn_1 == 0) .and. (warn_2 /= 0) ) THEN 150 IF(lwp) THEN 151 CALL ctl_warn( ' Temperatures dropping below freezing point, ', & 152 & ' being forced to freezing point, no longer conservative' ) 153 ENDIF 154 warn_1=1 155 ENDIF 156 #endif 127 157 128 158 ! trends computation initialisation -
branches/UKMO/r6232_collate_bgc_diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r11132 r11134 46 46 LOGICAL , PUBLIC :: ln_qsr_ice !: light penetration for ice-model LIM3 (clem) 47 47 INTEGER , PUBLIC :: nn_chldta !: use Chlorophyll data (=1) or not (=0) 48 INTEGER , PUBLIC :: nn_kd490dta !: use kd490dta data (=1) or not (=0) 48 49 REAL(wp), PUBLIC :: rn_abs !: fraction absorbed in the very near surface (RGB & 2 bands) 49 50 REAL(wp), PUBLIC :: rn_si0 !: very near surface depth of extinction (RGB & 2 bands) … … 54 55 REAL(wp) :: xsi1r !: inverse of rn_si1 55 56 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_chl ! structure of input Chl (file informations, fields read) 57 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_kd490 ! structure of input kd490 (file informations, fields read) 56 58 INTEGER, PUBLIC :: nksr ! levels below which the light cannot penetrate ( depth larger than 391 m) 57 59 REAL(wp), DIMENSION(3,61) :: rkrgb !: tabulated attenuation coefficients for RGB absorption … … 306 308 ! 307 309 ENDIF 310 ! slwa 311 IF( nn_kd490dta == 1 ) THEN ! use KD490 data read in ! 312 ! ! ------------------------- ! 313 nksr = jpk - 1 314 ! 315 CALL fld_read( kt, 1, sf_kd490 ) ! Read kd490 data and provide it at the current time step 316 ! 317 zcoef = ( 1. - rn_abs ) 318 ze0(:,:,1) = rn_abs * qsr(:,:) 319 ze1(:,:,1) = zcoef * qsr(:,:) 320 zea(:,:,1) = qsr(:,:) 321 ! 322 DO jk = 2, nksr+1 323 !CDIR NOVERRCHK 324 DO jj = 1, jpj 325 !CDIR NOVERRCHK 326 DO ji = 1, jpi 327 zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * xsi0r ) 328 zc1 = ze1(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * sf_kd490(1)%fnow(ji,jj,1) ) 329 ze0(ji,jj,jk) = zc0 330 ze1(ji,jj,jk) = zc1 331 zea(ji,jj,jk) = ( zc0 + zc1 ) * tmask(ji,jj,jk) 332 END DO 333 END DO 334 END DO 335 ! clem: store attenuation coefficient of the first ocean level 336 IF ( ln_qsr_ice ) THEN 337 DO jj = 1, jpj 338 DO ji = 1, jpi 339 zzc0 = rn_abs * EXP( - fse3t(ji,jj,1) * xsi0r ) 340 zzc1 = zcoef * EXP( - fse3t(ji,jj,1) * sf_kd490(1)%fnow(ji,jj,1) ) 341 fraqsr_1lev(ji,jj) = 1.0 - ( zzc0 + zzc1 ) * tmask(ji,jj,2) 342 END DO 343 END DO 344 ENDIF 345 ! 346 DO jk = 1, nksr ! compute and add qsr trend to ta 347 qsr_hc(:,:,jk) = r1_rau0_rcp * ( zea(:,:,jk) - zea(:,:,jk+1) ) 348 END DO 349 zea(:,:,nksr+1:jpk) = 0.e0 ! 350 CALL iom_put( 'qsr3d', zea ) ! Shortwave Radiation 3D distribution 351 ! 352 ENDIF ! use KD490 data 353 !slwa 308 354 ! 309 355 ! Add to the general trend … … 374 420 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files 375 421 TYPE(FLD_N) :: sn_chl ! informations about the chlorofyl field to be read 376 !! 377 NAMELIST/namtra_qsr/ sn_chl, cn_dir, ln_traqsr, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, ln_qsr_ice, & 378 & nn_chldta, rn_abs, rn_si0, rn_si1 422 TYPE(FLD_N) :: sn_kd490 ! informations about the kd490 field to be read 423 !! 424 NAMELIST/namtra_qsr/ sn_chl, sn_kd490, cn_dir, ln_traqsr, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, ln_qsr_ice, & 425 & nn_chldta, rn_abs, rn_si0, rn_si1, nn_kd490dta 379 426 !!---------------------------------------------------------------------- 380 427 … … 409 456 WRITE(numout,*) ' RGB & 2 bands: shortess depth of extinction rn_si0 = ', rn_si0 410 457 WRITE(numout,*) ' 2 bands: longest depth of extinction rn_si1 = ', rn_si1 458 WRITE(numout,*) ' read in KD490 data nn_kd490dta = ', nn_kd490dta 411 459 ENDIF 412 460 … … 422 470 IF( ln_qsr_2bd ) ioptio = ioptio + 1 423 471 IF( ln_qsr_bio ) ioptio = ioptio + 1 472 IF( nn_kd490dta == 1 ) ioptio = ioptio + 1 424 473 ! 425 474 IF( ioptio /= 1 ) & … … 431 480 IF( ln_qsr_2bd ) nqsr = 3 432 481 IF( ln_qsr_bio ) nqsr = 4 482 IF( nn_kd490dta == 1 ) nqsr = 5 433 483 ! 434 484 IF(lwp) THEN ! Print the choice … … 438 488 IF( nqsr == 3 ) WRITE(numout,*) ' 2 bands light penetration' 439 489 IF( nqsr == 4 ) WRITE(numout,*) ' bio-model light penetration' 490 IF( nqsr == 5 ) WRITE(numout,*) ' KD490 light penetration' 440 491 ENDIF 441 492 ! … … 447 498 xsi0r = 1.e0 / rn_si0 448 499 xsi1r = 1.e0 / rn_si1 500 IF( nn_kd490dta == 1 ) THEN !* KD490 data : set sf_kd490 structure 501 IF(lwp) WRITE(numout,*) 502 IF(lwp) WRITE(numout,*) ' KD490 read in a file' 503 ALLOCATE( sf_kd490(1), STAT=ierror ) 504 IF( ierror > 0 ) THEN 505 CALL ctl_stop( 'tra_qsr_init: unable to allocate sf_kd490 structure' ) ; RETURN 506 ENDIF 507 ALLOCATE( sf_kd490(1)%fnow(jpi,jpj,1) ) 508 IF( sn_kd490%ln_tint )ALLOCATE( sf_kd490(1)%fdta(jpi,jpj,1,2) ) 509 ! ! fill sf_kd490 with sn_kd490 and control print 510 CALL fld_fill( sf_kd490, (/ sn_kd490 /), cn_dir, 'tra_qsr_init', & 511 & 'Solar penetration function of read KD490', 'namtra_qsr' ) 449 512 ! ! ---------------------------------- ! 450 IF( ln_qsr_rgb ) THEN ! Red-Green-Blue light penetration !513 ELSEIF( ln_qsr_rgb ) THEN ! Red-Green-Blue light penetration ! 451 514 ! ! ---------------------------------- ! 452 515 ! -
branches/UKMO/r6232_collate_bgc_diagnostics/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r11132 r11134 25 25 USE trd_oce ! trends: ocean variables 26 26 USE trdtra ! trends manager: tracers 27 USE tradwl ! solar radiation penetration (downwell method) 27 28 ! 28 29 USE in_out_manager ! I/O manager … … 33 34 USE timing ! Timing 34 35 USE eosbn2 36 #if defined key_asminc 37 USE asminc ! Assimilation increment 38 #endif 35 39 36 40 IMPLICIT NONE … … 138 142 139 143 !!gm IF( .NOT.ln_traqsr ) qsr(:,:) = 0.e0 ! no solar radiation penetration 140 IF( .NOT.ln_traqsr ) THEN ! no solar radiation penetration144 IF( .NOT.ln_traqsr .and. .NOT.ln_tradwl ) THEN ! no solar radiation penetration 141 145 qns(:,:) = qns(:,:) + qsr(:,:) ! total heat flux in qns 142 146 qsr(:,:) = 0.e0 ! qsr set to zero … … 278 282 END DO 279 283 ENDIF 284 285 #if defined key_asminc 286 ! WARNING: THIS MAY WELL NOT BE REQUIRED - WE DON'T WANT TO CHANGE T&S BUT THIS MAY COMPENSATE ANOTHER TERM... 287 ! Rate of change in e3t for each level is ssh_iau*e3t_0/ht_0 288 ! Contribution to tsa should be rate of change in level / per m of ocean? (hence the division by fse3t_n) 289 IF( ln_sshinc ) THEN ! input of heat and salt due to assimilation 290 DO jj = 2, jpj 291 DO ji = fs_2, fs_jpim1 292 zdep = ssh_iau(ji,jj) / ( ht_0(ji,jj) + 1.0 - ssmask(ji, jj) ) 293 DO jk = 1, jpkm1 294 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) & 295 & + tsn(ji,jj,jk,jp_tem) * zdep * ( e3t_0(ji,jj,jk) / fse3t_n(ji,jj,jk) ) 296 tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) & 297 & + tsn(ji,jj,jk,jp_sal) * zdep * ( e3t_0(ji,jj,jk) / fse3t_n(ji,jj,jk) ) 298 END DO 299 END DO 300 END DO 301 ENDIF 302 #endif 280 303 281 304 IF( l_trdtra ) THEN ! send trends for further diagnostics
Note: See TracChangeset
for help on using the changeset viewer.
