Changeset 7282
- Timestamp:
- 2016-11-21T12:13:57+01:00 (8 years ago)
- Location:
- branches/2016/dev_CNRS_2016/NEMOGCM
- Files:
-
- 28 edited
- 2 copied
-
CONFIG/SHARED/namelist_pisces_ref (modified) (2 diffs)
-
NEMO/NST_SRC/agrif_lim2_interp.F90 (modified) (8 diffs)
-
NEMO/OPA_SRC/DIA/diadct.F90 (modified) (1 prop)
-
NEMO/OPA_SRC/DOM/domain.F90 (modified) (2 diffs)
-
NEMO/OPA_SRC/DYN/dynadv_cen2.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/DYN/dynadv_ubs.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/DYN/dynspg.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/DYN/dynzdf_imp.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/ICB/icbini.F90 (modified) (5 diffs)
-
NEMO/OPA_SRC/LBC/lib_mpp.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/SBC/sbcblk.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/SBC/sbccpl.F90 (modified) (14 diffs)
-
NEMO/OPA_SRC/ZDF/zdfric.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/timing.F90 (modified) (1 prop)
-
NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90 (modified) (12 diffs)
-
NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90 (modified) (4 diffs)
-
NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90 (modified) (4 diffs)
-
NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90 (modified) (4 diffs)
-
NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90 (modified) (6 diffs)
-
NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90 (modified) (2 diffs)
-
NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90 (modified) (4 diffs)
-
NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90 (modified) (3 diffs)
-
NEMO/TOP_SRC/TRP/trcsbc.F90 (modified) (1 diff)
-
NEMO/TOP_SRC/trcrst.F90 (modified) (1 diff)
-
NEMO/TOP_SRC/trcstp.F90 (modified) (4 diffs)
-
NEMO/TOP_SRC/trcsub.F90 (modified) (1 diff)
-
TOOLS/MISCELLANEOUS/README_uspcfg (copied) (copied from trunk/NEMOGCM/TOOLS/MISCELLANEOUS/README_uspcfg)
-
TOOLS/MISCELLANEOUS/make_usp_tar.sh (copied) (copied from trunk/NEMOGCM/TOOLS/MISCELLANEOUS/make_usp_tar.sh)
-
TOOLS/NESTING/agulhas (modified) (1 diff)
-
TOOLS/NESTING/src/agrif_types.f90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_CNRS_2016/NEMOGCM/CONFIG/SHARED/namelist_pisces_ref
r5385 r7282 66 66 qdfelim = 7.E-6 ! Optimal quota of diatoms 67 67 caco3r = 0.3 ! mean rain ratio 68 oxymin = 1.E-6 ! Half-saturation constant for anoxia 68 69 / 69 70 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' … … 162 163 xsiremlab = 0.03 ! fast remineralization rate of Si 163 164 xsilab = 0.5 ! Fraction of labile biogenic silica 164 oxymin = 1.E-6 ! Half-saturation constant for anoxia165 165 / 166 166 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90
r5656 r7282 392 392 INTEGER :: ji,jj,jn 393 393 REAL(wp) :: zalpha 394 REAL(wp), DIMENSION(jpi,jpj,7) :: tabice_agr395 394 !!----------------------------------------------------------------------- 396 395 ! … … 529 528 END DO 530 529 END DO 530 ELSE 531 DO jj=MAX(j1,2),j2 532 DO ji=MAX(i1,2),i2 533 uice_agr(ji,jj) = tabres(ji,jj) 534 END DO 535 END DO 531 536 ENDIF 532 537 #else … … 541 546 END DO 542 547 END DO 548 ELSE 549 DO jj= j1, j2 550 DO ji= i1, i2 551 uice_agr(ji,jj) = tabres(ji,jj) 552 END DO 553 END DO 543 554 ENDIF 544 555 #endif … … 566 577 tabres(ji,jj) = e1f(ji-1,jj-1) * v_ice(ji,jj) 567 578 ENDIF 579 END DO 580 END DO 581 ELSE 582 DO jj=MAX(j1,2),j2 583 DO ji=MAX(i1,2),i2 584 vice_agr(ji,jj) = tabres(ji,jj) 568 585 END DO 569 586 END DO … … 580 597 END DO 581 598 END DO 599 ELSE 600 DO jj= j1 ,j2 601 DO ji = i1, i2 602 vice_agr(ji,jj) = tabres(ji,jj) 603 END DO 604 END DO 582 605 ENDIF 583 606 #endif … … 585 608 586 609 587 SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2, before )610 SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2, k1, k2, before ) 588 611 !!----------------------------------------------------------------------- 589 612 !! *** ROUTINE interp_adv_ice *** … … 593 616 !! put -9999 where no ice for correct extrapolation 594 617 !!----------------------------------------------------------------------- 595 INTEGER, INTENT(in) :: i1, i2, j1, j2 596 REAL(wp), DIMENSION(i1:i2,j1:j2, 7), INTENT(inout) :: tabres618 INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 619 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 597 620 LOGICAL, INTENT(in) :: before 598 621 !! … … 601 624 ! 602 625 IF( before ) THEN 603 DO jj=j1,j2 604 DO ji=i1,i2 605 IF( tms(ji,jj) == 0. ) THEN 606 tabres(ji,jj,:) = -9999. 607 ELSE 608 tabres(ji,jj, 1) = frld (ji,jj) 609 tabres(ji,jj, 2) = hicif (ji,jj) 610 tabres(ji,jj, 3) = hsnif (ji,jj) 611 tabres(ji,jj, 4) = tbif (ji,jj,1) 612 tabres(ji,jj, 5) = tbif (ji,jj,2) 613 tabres(ji,jj, 6) = tbif (ji,jj,3) 614 tabres(ji,jj, 7) = qstoif(ji,jj) 615 ENDIF 616 END DO 617 END DO 626 DO jj=j1,j2 627 DO ji=i1,i2 628 IF( tms(ji,jj) == 0. ) THEN 629 tabres(ji,jj,:) = -9999 630 ELSE 631 tabres(ji,jj, 1) = frld (ji,jj) 632 tabres(ji,jj, 2) = hicif (ji,jj) 633 tabres(ji,jj, 3) = hsnif (ji,jj) 634 tabres(ji,jj, 4) = tbif (ji,jj,1) 635 tabres(ji,jj, 5) = tbif (ji,jj,2) 636 tabres(ji,jj, 6) = tbif (ji,jj,3) 637 tabres(ji,jj, 7) = qstoif(ji,jj) 638 ENDIF 639 END DO 640 END DO 641 ELSE 642 DO jj=j1,j2 643 DO ji=i1,i2 644 DO jk=k1, k2 645 tabice_agr(ji,jj,jk) = tabres(ji,jj,jk) 646 END DO 647 END DO 648 END DO 618 649 ENDIF 619 650 ! -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
- Property svn:executable deleted
-
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
r7277 r7282 153 153 ! 154 154 ! before ! now ! after ! 155 ;gdept_b = gdept_0 ; gdept_n = gdept_0 ! --- ! depth of grid-points156 ;gdepw_b = gdepw_0 ; gdepw_n = gdepw_0 ! --- !157 ; ;gde3w_n = gde3w_0 ! --- !155 gdept_b = gdept_0 ; gdept_n = gdept_0 ! --- ! depth of grid-points 156 gdepw_b = gdepw_0 ; gdepw_n = gdepw_0 ! --- ! 157 gde3w_n = gde3w_0 ! --- ! 158 158 ! 159 ;e3t_b = e3t_0 ; e3t_n = e3t_0 ; e3t_a = e3t_0 ! scale factors160 ;e3u_b = e3u_0 ; e3u_n = e3u_0 ; e3u_a = e3u_0 !161 ;e3v_b = e3v_0 ; e3v_n = e3v_0 ; e3v_a = e3v_0 !162 ; ;e3f_n = e3f_0 ! --- !163 ;e3w_b = e3w_0 ; e3w_n = e3w_0 ! --- !164 ;e3uw_b = e3uw_0 ; e3uw_n = e3uw_0 ! --- !165 ;e3vw_b = e3vw_0 ; e3vw_n = e3vw_0 ! --- !159 e3t_b = e3t_0 ; e3t_n = e3t_0 ; e3t_a = e3t_0 ! scale factors 160 e3u_b = e3u_0 ; e3u_n = e3u_0 ; e3u_a = e3u_0 ! 161 e3v_b = e3v_0 ; e3v_n = e3v_0 ; e3v_a = e3v_0 ! 162 e3f_n = e3f_0 ! --- ! 163 e3w_b = e3w_0 ; e3w_n = e3w_0 ! --- ! 164 e3uw_b = e3uw_0 ; e3uw_n = e3uw_0 ! --- ! 165 e3vw_b = e3vw_0 ; e3vw_n = e3vw_0 ! --- ! 166 166 ! 167 167 z1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) ) ! _i mask due to ISF … … 169 169 ! 170 170 ! before ! now ! after ! 171 ; ;ht_n = ht_0 ! ! water column thickness172 ;hu_b = hu_0 ; hu_n = hu_0 ; hu_a = hu_0 !173 ;hv_b = hv_0 ; hv_n = hv_0 ; hv_a = hv_0 !174 ;r1_hu_b = z1_hu_0 ; r1_hu_n = z1_hu_0 ; r1_hu_a = z1_hu_0 ! inverse of water column thickness175 ;r1_hv_b = z1_hv_0 ; r1_hv_n = z1_hv_0 ; r1_hv_a = z1_hv_0 !171 ht_n = ht_0 ! ! water column thickness 172 hu_b = hu_0 ; hu_n = hu_0 ; hu_a = hu_0 ! 173 hv_b = hv_0 ; hv_n = hv_0 ; hv_a = hv_0 ! 174 r1_hu_b = z1_hu_0 ; r1_hu_n = z1_hu_0 ; r1_hu_a = z1_hu_0 ! inverse of water column thickness 175 r1_hv_b = z1_hv_0 ; r1_hv_n = z1_hv_0 ; r1_hv_a = z1_hv_0 ! 176 176 ! 177 177 ! -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90
r6140 r7282 118 118 ENDIF 119 119 DO jk = 2, jpkm1 ! interior advective fluxes 120 DO jj = 2, jpj m1! 1/4 * Vertical transport121 DO ji = fs_2, fs_jpim1120 DO jj = 2, jpj ! 1/4 * Vertical transport 121 DO ji = 2, jpi 122 122 zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk) 123 123 END DO -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90
r6140 r7282 211 211 ENDIF 212 212 DO jk = 2, jpkm1 ! interior fluxes 213 DO jj = 2, jpj m1214 DO ji = fs_2, fs_jpim1213 DO jj = 2, jpj 214 DO ji = 2, jpi 215 215 zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk) 216 216 END DO -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
r7280 r7282 205 205 ENDIF 206 206 ! ! Control of surface pressure gradient scheme options 207 ;nspg = np_NO ; ioptio = 0207 nspg = np_NO ; ioptio = 0 208 208 IF( ln_dynspg_exp ) THEN ; nspg = np_EXP ; ioptio = ioptio + 1 ; ENDIF 209 209 IF( ln_dynspg_ts ) THEN ; nspg = np_TS ; ioptio = ioptio + 1 ; ENDIF -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r6140 r7282 294 294 ze3va = ( 1._wp - r_vvl ) * e3v_n(ji,jj,1) + r_vvl * e3v_a(ji,jj,1) 295 295 va(ji,jj,1) = va(ji,jj,1) + p2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) & 296 & / ( ze3va * rau0 ) 296 & / ( ze3va * rau0 ) * vmask(ji,jj,1) 297 297 END DO 298 298 END DO -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/ICB/icbini.F90
r7280 r7282 120 120 ! first entry with narea for this processor is left hand interior index 121 121 ! last entry is right hand interior index 122 jj = jpj/2122 jj = nlcj/2 123 123 nicbdi = -1 124 124 nicbei = -1 … … 136 136 ! 137 137 ! repeat for j direction 138 ji = jpi/2138 ji = nlci/2 139 139 nicbdj = -1 140 140 nicbej = -1 … … 153 153 ! special for east-west boundary exchange we save the destination index 154 154 i1 = MAX( nicbdi-1, 1) 155 i3 = INT( src_calving(i1, jpj/2) )155 i3 = INT( src_calving(i1,nlcj/2) ) 156 156 jj = INT( i3/nicbpack ) 157 157 ricb_left = REAL( i3 - nicbpack*jj, wp ) 158 158 i1 = MIN( nicbei+1, jpi ) 159 i3 = INT( src_calving(i1, jpj/2) )159 i3 = INT( src_calving(i1,nlcj/2) ) 160 160 jj = INT( i3/nicbpack ) 161 161 ricb_right = REAL( i3 - nicbpack*jj, wp ) … … 196 196 WRITE(numicb,*) 'berg left ', ricb_left 197 197 WRITE(numicb,*) 'berg right ', ricb_right 198 jj = jpj/2198 jj = nlcj/2 199 199 WRITE(numicb,*) "central j line:" 200 200 WRITE(numicb,*) "i processor" … … 202 202 WRITE(numicb,*) "i point" 203 203 WRITE(numicb,*) (INT(src_calving(ji,jj)), ji=1,jpi) 204 ji = jpi/2204 ji = nlci/2 205 205 WRITE(numicb,*) "central i line:" 206 206 WRITE(numicb,*) "j processor" -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r7280 r7282 2983 2983 !!---------------------------------------------------------------------- 2984 2984 ! 2985 ALLOCATE( ztab(jpiglo,4,num_fields), znorthloc(jpi,4,num_fields), zfoldwk(jpi,4,num_fields), znorthgloio(jpi,4,num_fields,jpni) ) ! expanded to 3 dimensions 2985 ALLOCATE( ztab(jpiglo,4,num_fields), znorthloc(jpi,4,num_fields), zfoldwk(jpi,4,num_fields), & 2986 & znorthgloio(jpi,4,num_fields,jpni) ) ! expanded to 3 dimensions 2986 2987 ALLOCATE( ztabl(jpi,4,num_fields), ztabr(jpi*jpmaxngh, 4,num_fields) ) 2987 2988 ! -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk.F90
r7280 r7282 281 281 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 282 282 qlw_ice(:,:,1) = sf(jp_qlw )%fnow(:,:,1) 283 qsr_ice(:,:,1) = sf(jp_qsr )%fnow(:,:,1) 283 IF( ln_dm2dc ) THEN ; qsr_ice(:,:,1) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) 284 ELSE ; qsr_ice(:,:,1) = sf(jp_qsr)%fnow(:,:,1) 285 ENDIF 284 286 tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1) 285 287 qatm_ice(:,:) = sf(jp_humi)%fnow(:,:,1) -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r7278 r7282 1327 1327 !! *** ROUTINE sbc_cpl_ice_flx *** 1328 1328 !! 1329 !! ** Purpose : provide the heat and freshwater fluxes of the 1330 !! ocean-ice system. 1329 !! ** Purpose : provide the heat and freshwater fluxes of the ocean-ice system 1331 1330 !! 1332 1331 !! ** Method : transform the fields received from the atmosphere into 1333 1332 !! surface heat and fresh water boundary condition for the 1334 1333 !! ice-ocean system. The following fields are provided: 1335 !! * total non solar, solar and freshwater fluxes (qns_tot,1334 !! * total non solar, solar and freshwater fluxes (qns_tot, 1336 1335 !! qsr_tot and emp_tot) (total means weighted ice-ocean flux) 1337 1336 !! NB: emp_tot include runoffs and calving. 1338 !! * fluxes over ice (qns_ice, qsr_ice, emp_ice) where1337 !! * fluxes over ice (qns_ice, qsr_ice, emp_ice) where 1339 1338 !! emp_ice = sublimation - solid precipitation as liquid 1340 1339 !! precipitation are re-routed directly to the ocean and 1341 !! runoffs and calving directly enter the ocean.1342 !! * solid precipitation (sprecip), used to add to qns_tot1340 !! calving directly enter the ocean (runoffs are read but included in trasbc.F90) 1341 !! * solid precipitation (sprecip), used to add to qns_tot 1343 1342 !! the heat lost associated to melting solid precipitation 1344 1343 !! over the ocean fraction. 1345 !! ===>> CAUTION here this changes the net heat flux received from 1346 !! the atmosphere 1347 !! 1348 !! - the fluxes have been separated from the stress as 1349 !! (a) they are updated at each ice time step compare to 1350 !! an update at each coupled time step for the stress, and 1351 !! (b) the conservative computation of the fluxes over the 1352 !! sea-ice area requires the knowledge of the ice fraction 1353 !! after the ice advection and before the ice thermodynamics, 1354 !! so that the stress is updated before the ice dynamics 1355 !! while the fluxes are updated after it. 1344 !! * heat content of rain, snow and evap can also be provided, 1345 !! otherwise heat flux associated with these mass flux are 1346 !! guessed (qemp_oce, qemp_ice) 1347 !! 1348 !! - the fluxes have been separated from the stress as 1349 !! (a) they are updated at each ice time step compare to 1350 !! an update at each coupled time step for the stress, and 1351 !! (b) the conservative computation of the fluxes over the 1352 !! sea-ice area requires the knowledge of the ice fraction 1353 !! after the ice advection and before the ice thermodynamics, 1354 !! so that the stress is updated before the ice dynamics 1355 !! while the fluxes are updated after it. 1356 !! 1357 !! ** Details 1358 !! qns_tot = pfrld * qns_oce + ( 1 - pfrld ) * qns_ice => provided 1359 !! + qemp_oce + qemp_ice => recalculated and added up to qns 1360 !! 1361 !! qsr_tot = pfrld * qsr_oce + ( 1 - pfrld ) * qsr_ice => provided 1362 !! 1363 !! emp_tot = emp_oce + emp_ice => calving is provided and added to emp_tot (and emp_oce) 1364 !! river runoff (rnf) is provided but not included here 1356 1365 !! 1357 1366 !! ** Action : update at each nf_ice time step: 1358 1367 !! qns_tot, qsr_tot non-solar and solar total heat fluxes 1359 1368 !! qns_ice, qsr_ice non-solar and solar heat fluxes over the ice 1360 !! emp_tot total evaporation - precipitation(liquid and solid) (-runoff)(-calving)1361 !! emp_ice 1362 !! dqns_ice 1363 !! sprecip 1369 !! emp_tot total evaporation - precipitation(liquid and solid) (-calving) 1370 !! emp_ice ice sublimation - solid precipitation over the ice 1371 !! dqns_ice d(non-solar heat flux)/d(Temperature) over the ice 1372 !! sprecip solid precipitation over the ocean 1364 1373 !!---------------------------------------------------------------------- 1365 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction[0 to 1]1374 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction [0 to 1] 1366 1375 ! optional arguments, used only in 'mixed oce-ice' case 1367 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo1368 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature[Celsius]1369 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature[Kelvin]1370 ! 1371 INTEGER :: jl ! dummy loop index1376 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1377 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1378 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1379 ! 1380 INTEGER :: jl ! dummy loop index 1372 1381 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, ztmp, zicefr, zmsk, zsnw 1373 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap , zevap_ice, zdevap_ice1382 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice 1374 1383 REAL(wp), POINTER, DIMENSION(:,: ) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 1375 1384 REAL(wp), POINTER, DIMENSION(:,:,:) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice 1376 1385 !!---------------------------------------------------------------------- 1377 1386 ! 1378 IF( nn_timing == 1 ) 1387 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_flx') 1379 1388 ! 1380 1389 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zsnw ) 1381 CALL wrk_alloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap , zevap_ice, zdevap_ice )1390 CALL wrk_alloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 1382 1391 CALL wrk_alloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 1383 1392 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice ) … … 1388 1397 ! 1389 1398 ! ! ========================= ! 1390 ! ! freshwater budget ! (emp )1399 ! ! freshwater budget ! (emp_tot) 1391 1400 ! ! ========================= ! 1392 1401 ! 1393 ! ! total Precipitation - total Evaporation (emp_tot)1394 ! ! solid precipitation - sublimation (emp_ice)1395 ! ! solid Precipitation (sprecip)1396 ! ! liquid + solid Precipitation (tprecip)1402 ! ! solid Precipitation (sprecip) 1403 ! ! liquid + solid Precipitation (tprecip) 1404 ! ! total Evaporation - total Precipitation (emp_tot) 1405 ! ! sublimation - solid precipitation (cell average) (emp_ice) 1397 1406 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 1398 CASE( 'conservative' 1399 zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here1400 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here1401 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:)1402 zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1)1403 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) )! liquid precipitation1407 CASE( 'conservative' ) ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp 1408 zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here 1409 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 1410 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1411 zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * zicefr(:,:) 1412 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1404 1413 IF( iom_use('hflx_rain_cea') ) & 1405 CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip. 1406 IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') ) & 1407 ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 1414 & CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip. 1408 1415 IF( iom_use('evap_ao_cea' ) ) & 1409 CALL iom_put( 'evap_ao_cea' , ztmp )! ice-free oce evap (cell average)1416 & CALL iom_put( 'evap_ao_cea' , frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! ice-free oce evap (cell average) 1410 1417 IF( iom_use('hflx_evap_cea') ) & 1411 CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) )! heat flux from from evap (cell average)1412 CASE( 'oce and ice' 1418 & CALL iom_put( 'hflx_evap_cea', ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) * zcptn(:,:) ) ! heat flux from from evap (cell average) 1419 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1413 1420 zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 1414 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 1421 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * zicefr(:,:) 1415 1422 zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 1416 1423 ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) 1417 1424 END SELECT 1425 1418 1426 #if defined key_lim3 1419 ! zsnw = snow percentage over ice after wind blowing 1420 zsnw(:,:) = 0._wp 1421 CALL lim_thd_snwblow( p_frld, zsnw ) 1427 ! zsnw = snow fraction over ice after wind blowing 1428 zsnw(:,:) = 0._wp ; CALL lim_thd_snwblow( p_frld, zsnw ) 1422 1429 1423 ! --- evaporation (used later in sbccpl) --- ! 1424 zevap(:,:) = zemp_tot(:,:) + ztprecip(:,:) 1430 ! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- ! 1431 zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( zicefr(:,:) - zsnw(:,:) ) ! emp_ice = A * sublimation - zsnw * sprecip 1432 zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:) ! emp_oce = emp_tot - emp_ice 1433 1434 ! --- evaporation over ocean (used later for qemp) --- ! 1435 zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 1425 1436 1426 1437 ! --- evaporation over ice (kg/m2/s) --- ! … … 1430 1441 zdevap_ice(:,:) = 0._wp 1431 1442 1432 ! --- evaporation minus precipitation corrected for the effect of wind blowing on snow --- !1433 zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:) - zsprecip * (1._wp - zsnw)1434 zemp_ice(:,:) = zemp_ice(:,:) + zsprecip * (1._wp - zsnw)1435 1436 1443 ! --- runoffs (included in emp later on) --- ! 1437 1444 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) … … 1443 1450 CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) ) 1444 1451 ENDIF 1445 1452 1446 1453 IF( ln_mixcpl ) THEN 1447 1454 emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) … … 1465 1472 ENDDO 1466 1473 ENDIF 1467 1468 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea', zevap_ice(:,:) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average)1469 CALL iom_put( 'snowpre' , sprecip ) ! Snow1470 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea', sprecip(:,:) * ( 1._wp - zsnw ) ) ! Snow over ice-free ocean (cell average)1471 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zsnw ) ! Snow over sea-ice (cell average)1474 1475 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea', zevap_ice(:,:) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1476 CALL iom_put( 'snowpre' , sprecip(:,:) ) ! Snow 1477 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea', sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average) 1478 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average) 1472 1479 #else 1473 ! Sublimation over sea-ice (cell average)1474 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )1475 1480 ! runoffs and calving (put in emp_tot) 1476 1481 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) … … 1492 1497 ENDIF 1493 1498 1494 CALL iom_put( 'snowpre' , sprecip ) ! Snow 1495 IF( iom_use('snow_ao_cea') ) & 1496 CALL iom_put( 'snow_ao_cea', sprecip(:,:) * p_frld(:,:) ) ! Snow over ice-free ocean (cell average) 1497 IF( iom_use('snow_ai_cea') ) & 1498 CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1499 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1500 CALL iom_put( 'snowpre' , sprecip(:,:) ) ! Snow 1501 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea', sprecip(:,:) * p_frld(:,:) ) ! Snow over ice-free ocean (cell average) 1502 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1499 1503 #endif 1500 1504 … … 1502 1506 SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) ! non solar heat fluxes ! (qns) 1503 1507 ! ! ========================= ! 1504 CASE( 'oce only' ) 1505 zqns_tot(:,: 1506 CASE( 'conservative' ) 1507 zqns_tot(:,: 1508 CASE( 'oce only' ) ! the required field is directly provided 1509 zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 1510 CASE( 'conservative' ) ! the required fields are directly provided 1511 zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 1508 1512 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1509 1513 zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 1510 1514 ELSE 1511 ! Set all category values equal for the moment1512 1515 DO jl=1,jpl 1513 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1516 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) ! Set all category values equal 1514 1517 ENDDO 1515 1518 ENDIF 1516 CASE( 'oce and ice' ) 1517 zqns_tot(:,: 1519 CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes 1520 zqns_tot(:,:) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 1518 1521 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1519 1522 DO jl=1,jpl … … 1522 1525 ENDDO 1523 1526 ELSE 1524 qns_tot(:,: 1527 qns_tot(:,:) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1525 1528 DO jl=1,jpl 1526 1529 zqns_tot(:,: ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) … … 1528 1531 ENDDO 1529 1532 ENDIF 1530 CASE( 'mixed oce-ice' ) 1533 CASE( 'mixed oce-ice' ) ! the ice flux is cumputed from the total flux, the SST and ice informations 1531 1534 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1532 1535 zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1533 1536 zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) & 1534 1537 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:) & 1535 & + pist(:,:,1)* zicefr(:,:) ) )1538 & + pist(:,:,1) * zicefr(:,:) ) ) 1536 1539 END SELECT 1537 1540 !!gm … … 1543 1546 !! similar job should be done for snow and precipitation temperature 1544 1547 ! 1545 IF( srcv(jpr_cal)%laction ) THEN ! Iceberg melting 1546 ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting 1547 zqns_tot(:,:) = zqns_tot(:,:) - ztmp(:,:) 1548 IF( iom_use('hflx_cal_cea') ) & 1549 CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from calving 1550 ENDIF 1551 1552 ztmp(:,:) = p_frld(:,:) * zsprecip(:,:) * lfus 1553 IF( iom_use('hflx_snow_cea') ) CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average) 1548 IF( srcv(jpr_cal)%laction ) THEN ! Iceberg melting 1549 zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting 1550 ! we suppose it melts at 0deg, though it should be temp. of surrounding ocean 1551 IF( iom_use('hflx_cal_cea') ) CALL iom_put( 'hflx_cal_cea', - frcv(jpr_cal)%z3(:,:,1) * lfus ) ! heat flux from calving 1552 ENDIF 1554 1553 1555 1554 #if defined key_lim3 … … 1560 1559 1561 1560 ! --- heat flux associated with emp (W/m2) --- ! 1562 zqemp_oce(:,:) = - zevap(:,:) * p_frld(:,:) * zcptn(:,:) &! evap1563 & + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptn(:,:) & ! liquid precip1564 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean1561 zqemp_oce(:,:) = - zevap_oce(:,:) * zcptn(:,:) & ! evap 1562 & + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptn(:,:) & ! liquid precip 1563 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean + snow melting 1565 1564 ! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptn(:,:) & ! ice evap 1566 1565 ! & + zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice 1567 1566 zqemp_ice(:,:) = zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice (only) 1568 ! qevap_ice=0 since we consider Tice=0 °C1567 ! qevap_ice=0 since we consider Tice=0degC 1569 1568 1570 ! --- heat content ofprecip over ice in J/m3 (to be used in 1D-thermo) --- !1569 ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- ! 1571 1570 zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus ) 1572 1571 1573 1572 ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- ! 1574 1573 DO jl = 1, jpl 1575 zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * cpic ) but we do not have Tice, so we consider Tice=0 °C1574 zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * cpic ) but we do not have Tice, so we consider Tice=0degC 1576 1575 END DO 1577 1576 … … 1599 1598 qemp_ice (:,: ) = zqemp_ice (:,: ) 1600 1599 ENDIF 1600 1601 !! clem: we should output qemp_oce and qemp_ice (at least) 1602 IF( iom_use('hflx_snow_cea') ) CALL iom_put( 'hflx_snow_cea', sprecip(:,:) * ( zcptn(:,:) - Lfus ) ) ! heat flux from snow (cell average) 1603 !! these diags are not outputed yet 1604 !! IF( iom_use('hflx_rain_cea') ) CALL iom_put( 'hflx_rain_cea', ( tprecip(:,:) - sprecip(:,:) ) * zcptn(:,:) ) ! heat flux from rain (cell average) 1605 !! IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put( 'hflx_snow_ao_cea', sprecip(:,:) * ( zcptn(:,:) - Lfus ) * (1._wp - zsnw(:,:)) ) ! heat flux from snow (cell average) 1606 !! IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put( 'hflx_snow_ai_cea', sprecip(:,:) * ( zcptn(:,:) - Lfus ) * zsnw(:,:) ) ! heat flux from snow (cell average) 1607 1601 1608 #else 1602 ! clem: this formulation is certainly wrong... but better than it was before...1609 ! clem: this formulation is certainly wrong... but better than it was... 1603 1610 zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: 1604 1611 & - ztmp(:,:) & ! remove the latent heat flux of solid precip. melting 1605 1612 & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 1606 & - zemp_ice(:,:) * zicefr(:,:)) * zcptn(:,:)1613 & - zemp_ice(:,:) ) * zcptn(:,:) 1607 1614 1608 1615 IF( ln_mixcpl ) THEN … … 1616 1623 qns_ice(:,:,:) = zqns_ice(:,:,:) 1617 1624 ENDIF 1618 !1619 1625 #endif 1626 1620 1627 ! ! ========================= ! 1621 1628 SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) ! solar heat fluxes ! (qsr) … … 1724 1731 1725 1732 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zsnw ) 1726 CALL wrk_dealloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap , zevap_ice, zdevap_ice )1733 CALL wrk_dealloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 1727 1734 CALL wrk_dealloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 1728 1735 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice ) -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90
r7278 r7282 162 162 & + avmv(ji,jj,jk) + avmv(ji,jj-1,jk) ) & 163 163 & + avtb(jk) * tmask(ji,jj,jk) 164 ! ! Add the background coefficient on eddy viscosity 164 END DO 165 END DO 166 DO jj = 2, jpjm1 ! Add the background coefficient on eddy viscosity 167 DO ji = fs_2, fs_jpim1 165 168 avmu(ji,jj,jk) = avmu(ji,jj,jk) + avmb(jk) * umask(ji,jj,jk) 166 169 avmv(ji,jj,jk) = avmv(ji,jj,jk) + avmb(jk) * vmask(ji,jj,jk) -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/timing.F90
- Property svn:executable deleted
-
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90
r6291 r7282 31 31 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sio3eq ! chemistry of Si 32 32 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: fekeq ! chemistry of Fe 33 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,: ):: chemc ! Solubilities of O2 and CO233 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: chemc ! Solubilities of O2 and CO2 34 34 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: chemo2 ! Solubilities of O2 and CO2 35 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tempis ! In situ temperature 35 36 36 37 REAL(wp), PUBLIC :: atcox = 0.20946 ! units atm … … 39 40 REAL(wp) :: o2atm = 1. / ( 1000. * 0.20946 ) 40 41 41 REAL(wp) :: akcc1 = -171.9065 ! coeff. for apparent solubility equilibrium 42 REAL(wp) :: akcc2 = -0.077993 ! Millero et al. 1995 from Mucci 1983 43 REAL(wp) :: akcc3 = 2839.319 44 REAL(wp) :: akcc4 = 71.595 45 REAL(wp) :: akcc5 = -0.77712 46 REAL(wp) :: akcc6 = 0.00284263 47 REAL(wp) :: akcc7 = 178.34 48 REAL(wp) :: akcc8 = -0.07711 49 REAL(wp) :: akcc9 = 0.0041249 50 51 REAL(wp) :: rgas = 83.143 ! universal gas constants 42 REAL(wp) :: rgas = 83.14472 ! universal gas constants 52 43 REAL(wp) :: oxyco = 1. / 22.4144 ! converts from liters of an ideal gas to moles 53 44 54 45 REAL(wp) :: bor1 = 0.00023 ! borat constants 55 46 REAL(wp) :: bor2 = 1. / 10.82 56 57 REAL(wp) :: ca0 = -162.8301 ! WEISS & PRICE 1980, units mol/(kg atm)58 REAL(wp) :: ca1 = 218.296859 REAL(wp) :: ca2 = 90.924160 REAL(wp) :: ca3 = -1.4769661 REAL(wp) :: ca4 = 0.02569562 REAL(wp) :: ca5 = -0.02522563 REAL(wp) :: ca6 = 0.004986764 65 REAL(wp) :: c10 = -3670.7 ! Coeff. for 1. dissoc. of carbonic acid (Edmond and Gieskes, 1970)66 REAL(wp) :: c11 = 62.00867 REAL(wp) :: c12 = -9.794468 REAL(wp) :: c13 = 0.011869 REAL(wp) :: c14 = -0.00011670 71 REAL(wp) :: c20 = -1394.7 ! coeff. for 2. dissoc. of carbonic acid (Millero, 1995)72 REAL(wp) :: c21 = -4.77773 REAL(wp) :: c22 = 0.018474 REAL(wp) :: c23 = -0.00011875 47 76 48 REAL(wp) :: st1 = 0.14 ! constants for calculate concentrations for sulfate … … 144 116 REAL(wp) :: ztgg , ztgg2, ztgg3 , ztgg4 , ztgg5 145 117 REAL(wp) :: zpres, ztc , zcl , zcpexp, zoxy , zcpexp2 146 REAL(wp) :: zsqrt, ztr , zlogt , zcek1 147 REAL(wp) :: zis , zis2 , zsal15, zisqrt 118 REAL(wp) :: zsqrt, ztr , zlogt , zcek1, zc1, zplat 119 REAL(wp) :: zis , zis2 , zsal15, zisqrt, za1 , za2 148 120 REAL(wp) :: zckb , zck1 , zck2 , zckw , zak1 , zak2 , zakb , zaksp0, zakw 149 121 REAL(wp) :: zst , zft , zcks , zckf , zaksp1 … … 151 123 ! 152 124 IF( nn_timing == 1 ) CALL timing_start('p4z_che') 125 ! 126 ! Computations of chemical constants require in situ temperature 127 ! Here a quite simple formulation is used to convert 128 ! potential temperature to in situ temperature. The errors is less than 129 ! 0.04°C relative to an exact computation 130 ! --------------------------------------------------------------------- 131 DO jk = 1, jpk 132 DO jj = 1, jpj 133 DO ji = 1, jpi 134 zpres = gdept_n(ji,jj,jk) / 1000. 135 za1 = 0.04 * ( 1.0 + 0.185 * tsn(ji,jj,jk,jp_tem) + 0.035 * (tsn(ji,jj,jk,jp_sal) - 35.0) ) 136 za2 = 0.0075 * ( 1.0 - tsn(ji,jj,jk,jp_tem) / 30.0 ) 137 tempis(ji,jj,jk) = tsn(ji,jj,jk,jp_tem) - za1 * zpres + za2 * zpres**2 138 END DO 139 END DO 140 END DO 153 141 ! 154 142 ! CHEMICAL CONSTANTS - SURFACE LAYER … … 157 145 DO ji = 1, jpi 158 146 ! ! SET ABSOLUTE TEMPERATURE 159 ztkel = t sn(ji,jj,1,jp_tem) + 273.15147 ztkel = tempis(ji,jj,1) + 273.15 160 148 zt = ztkel * 0.01 161 149 zt2 = zt * zt … … 165 153 ! ! LN(K0) OF SOLUBILITY OF CO2 (EQ. 12, WEISS, 1980) 166 154 ! ! AND FOR THE ATMOSPHERE FOR NON IDEAL GAS 167 zcek1 = ca0 + ca1 / zt + ca2 * zlogt + ca3 * zt2 + zsal * ( ca4 + ca5 * zt + ca6 * zt2 ) 155 zcek1 = 9345.17/ztkel - 60.2409 + 23.3585 * LOG(zt) + zsal*(0.023517 - 0.00023656*ztkel & 156 & + 0.0047036e-4*ztkel**2) 168 157 ! ! SET SOLUBILITIES OF O2 AND CO2 169 chemc(ji,jj) = EXP( zcek1 ) * 1.e-6 * rhop(ji,jj,1) / 1000. ! mol/(L uatm) 158 chemc(ji,jj,1) = EXP( zcek1 ) * 1.e-6 * rhop(ji,jj,1) / 1000. ! mol/(kg uatm) 159 chemc(ji,jj,2) = -1636.75 + 12.0408*ztkel - 0.0327957*ztkel**2 + 0.0000316528*ztkel**3 160 chemc(ji,jj,3) = 57.7 - 0.118*ztkel 170 161 ! 171 162 END DO … … 177 168 DO jj = 1, jpj 178 169 DO ji = 1, jpi 179 ztkel = t sn(ji,jj,jk,jp_tem) + 273.15170 ztkel = tempis(ji,jj,jk) + 273.15 180 171 zsal = tsn(ji,jj,jk,jp_sal) + ( 1.- tmask(ji,jj,jk) ) * 35. 181 172 zsal2 = zsal * zsal 182 ztgg = LOG( ( 298.15 - t sn(ji,jj,jk,jp_tem) ) / ztkel ) ! Set the GORDON & GARCIA scaled temperature173 ztgg = LOG( ( 298.15 - tempis(ji,jj,jk) ) / ztkel ) ! Set the GORDON & GARCIA scaled temperature 183 174 ztgg2 = ztgg * ztgg 184 175 ztgg3 = ztgg2 * ztgg … … 200 191 DO ji = 1, jpi 201 192 202 ! SET PRESSION 203 zpres = 1.025e-1 * gdept_n(ji,jj,jk) 193 ! SET PRESSION ACCORDING TO SAUNDER (1980) 194 zplat = SIN ( ABS(gphit(ji,jj)*3.141592654/180.) ) 195 zc1 = 5.92E-3 + zplat**2 * 5.25E-3 196 zpres = ((1-zc1)-SQRT(((1-zc1)**2)-(8.84E-6*gdept_n(ji,jj,jk)))) / 4.42E-6 197 zpres = zpres / 10.0 204 198 205 199 ! SET ABSOLUTE TEMPERATURE 206 ztkel = t sn(ji,jj,jk,jp_tem) + 273.15200 ztkel = tempis(ji,jj,jk) + 273.15 207 201 zsal = tsn(ji,jj,jk,jp_sal) + ( 1.-tmask(ji,jj,jk) ) * 35. 208 202 zsqrt = SQRT( zsal ) … … 213 207 zis2 = zis * zis 214 208 zisqrt = SQRT( zis ) 215 ztc = t sn(ji,jj,jk,jp_tem) + ( 1.- tmask(ji,jj,jk) ) * 20.209 ztc = tempis(ji,jj,jk) + ( 1.- tmask(ji,jj,jk) ) * 20. 216 210 217 211 ! CHLORINITY (WOOSTER ET AL., 1969) … … 246 240 247 241 248 zck1 = c10 * ztr + c11 + c12 * zlogt + c13 * zsal + c14 * zsal * zsal 249 zck2 = c20 * ztr + c21 + c22 * zsal + c23 * zsal**2 242 ! DISSOCIATION COEFFICIENT FOR CARBONATE ACCORDING TO 243 ! MEHRBACH (1973) REFIT BY MILLERO (1995), seawater scale 244 zck1 = -1.0*(3633.86*ztr - 61.2172 + 9.6777*zlogt & 245 - 0.011555*zsal + 0.0001152*zsal*zsal) 246 zck2 = -1.0*(471.78*ztr + 25.9290 - 3.16967*zlogt & 247 - 0.01781*zsal + 0.0001122*zsal*zsal) 250 248 251 249 ! PKW (H2O) (DICKSON AND RILEY, 1979) … … 256 254 ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE IN SEAWATER 257 255 ! (S=27-43, T=2-25 DEG C) at pres =0 (atmos. pressure) (MUCCI 1983) 258 zaksp0 = akcc1 + akcc2 * ztkel + akcc3 * ztr + akcc4 * LOG10( ztkel ) & 259 & + ( akcc5 + akcc6 * ztkel + akcc7 * ztr ) * zsqrt + akcc8 * zsal + akcc9 * zsal15 256 zaksp0 = -171.9065 -0.077993*ztkel + 2839.319*ztr + 71.595*LOG10( ztkel ) & 257 & + (-0.77712 + 0.00284263*ztkel + 178.34*ztr) * zsqrt & 258 & - 0.07711*zsal + 0.0041249*zsal15 260 259 261 260 ! K1, K2 OF CARBONIC ACID, KB OF BORIC ACID, KW (H2O) (LIT.?) … … 327 326 !! *** ROUTINE p4z_che_alloc *** 328 327 !!---------------------------------------------------------------------- 329 ALLOCATE( sio3eq(jpi,jpj,jpk), fekeq(jpi,jpj,jpk), chemc(jpi,jpj ), chemo2(jpi,jpj,jpk), &330 & STAT=p4z_che_alloc )328 ALLOCATE( sio3eq(jpi,jpj,jpk), fekeq(jpi,jpj,jpk), chemc(jpi,jpj,3), chemo2(jpi,jpj,jpk), & 329 & tempis(jpi,jpj,jpk), STAT=p4z_che_alloc ) 331 330 ! 332 331 IF( p4z_che_alloc /= 0 ) CALL ctl_warn('p4z_che_alloc : failed to allocate arrays.') -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90
r6291 r7282 84 84 REAL(wp) :: ztc, ztc2, ztc3, ztc4, zws, zkgwan 85 85 REAL(wp) :: zfld, zflu, zfld16, zflu16, zfact 86 REAL(wp) :: zvapsw, zsal, zfco2, zxc2, xCO2approx, ztkel, zfugcoeff 86 87 REAL(wp) :: zph, zah2, zbot, zdic, zalk, zsch_o2, zalka, zsch_co2 87 88 REAL(wp) :: zyr_dec, zdco2dt 88 89 CHARACTER (len=25) :: charout 89 REAL(wp), POINTER, DIMENSION(:,:) :: zkgco2, zkgo2, zh2co3, zoflx, zw2d 90 REAL(wp), POINTER, DIMENSION(:,:) :: zkgco2, zkgo2, zh2co3, zoflx, zw2d, zpco2atm 90 91 !!--------------------------------------------------------------------- 91 92 ! 92 93 IF( nn_timing == 1 ) CALL timing_start('p4z_flx') 93 94 ! 94 CALL wrk_alloc( jpi, jpj, zkgco2, zkgo2, zh2co3, zoflx )95 CALL wrk_alloc( jpi, jpj, zkgco2, zkgo2, zh2co3, zoflx, zpco2atm ) 95 96 ! 96 97 … … 177 178 DO jj = 1, jpj 178 179 DO ji = 1, jpi 180 ztkel = tsn(ji,jj,1,jp_tem) + 273.15 181 zsal = tsn(ji,jj,1,jp_sal) + ( 1.- tmask(ji,jj,1) ) * 35. 182 zvapsw = EXP(24.4543 - 67.4509*(100.0/ztkel) - 4.8489*LOG(ztkel/100) - 0.000544*zsal) 183 zpco2atm(ji,jj) = satmco2(ji,jj) * ( patm(ji,jj) - zvapsw ) 184 zxc2 = ( 1.0 - zpco2atm(ji,jj) * 1E-6 )**2 185 zfugcoeff = EXP( patm(ji,jj) * (chemc(ji,jj,2) + 2.0 * zxc2 * chemc(ji,jj,3) ) & 186 & / ( 82.05736 * ztkel )) 187 zfco2 = zpco2atm(ji,jj) * zfugcoeff 188 179 189 ! Compute CO2 flux for the sea and air 180 zfld = satmco2(ji,jj) * patm(ji,jj) * tmask(ji,jj,1) * chemc(ji,jj) * zkgco2(ji,jj)! (mol/L) * (m/s)181 zflu = zh2co3(ji,jj) * tmask(ji,jj,1) *zkgco2(ji,jj) ! (mol/L) (m/s) ?190 zfld = zfco2 * chemc(ji,jj,1) * zkgco2(ji,jj) ! (mol/L) * (m/s) 191 zflu = zh2co3(ji,jj) * zkgco2(ji,jj) ! (mol/L) (m/s) ? 182 192 oce_co2(ji,jj) = ( zfld - zflu ) * rfact2 * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000. 183 193 ! compute the trend 184 tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) * rfact2 / e3t_n(ji,jj,1) 194 tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) * rfact2 / e3t_n(ji,jj,1) * tmask(ji,jj,1) 185 195 186 196 ! Compute O2 flux 187 zfld16 = patm(ji,jj) * chemo2(ji,jj,1) * tmask(ji,jj,1) *zkgo2(ji,jj) ! (mol/L) * (m/s)188 zflu16 = trb(ji,jj,1,jpoxy) * tmask(ji,jj,1) *zkgo2(ji,jj)189 zoflx(ji,jj) = zfld16 - zflu16197 zfld16 = patm(ji,jj) * chemo2(ji,jj,1) * zkgo2(ji,jj) ! (mol/L) * (m/s) 198 zflu16 = trb(ji,jj,1,jpoxy) * zkgo2(ji,jj) 199 zoflx(ji,jj) = ( zfld16 - zflu16 ) * tmask(ji,jj,1) 190 200 tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) * rfact2 / e3t_n(ji,jj,1) 191 201 END DO … … 218 228 ENDIF 219 229 IF( iom_use( "Dpco2" ) ) THEN 220 zw2d(:,:) = ( satmco2(:,:) * patm(:,:) - zh2co3(:,:) / ( chemc(:,:) + rtrn ) ) * tmask(:,:,1)230 zw2d(:,:) = ( zpco2atm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1) 221 231 CALL iom_put( "Dpco2" , zw2d ) 222 232 ENDIF … … 234 244 trc2d(:,:,jp_pcs0_2d + 1) = zoflx(:,:) * 1000 * tmask(:,:,1) 235 245 trc2d(:,:,jp_pcs0_2d + 2) = zkgco2(:,:) * tmask(:,:,1) 236 trc2d(:,:,jp_pcs0_2d + 3) = ( satmco2(:,:) * patm(:,:) - zh2co3(:,:) / ( chemc(:,:) + rtrn ) ) * tmask(:,:,1)237 ENDIF 238 ENDIF 239 ! 240 CALL wrk_dealloc( jpi, jpj, zkgco2, zkgo2, zh2co3, zoflx )246 trc2d(:,:,jp_pcs0_2d + 3) = ( zpco2atm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1) 247 ENDIF 248 ENDIF 249 ! 250 CALL wrk_dealloc( jpi, jpj, zkgco2, zkgo2, zh2co3, zoflx, zpco2atm ) 241 251 ! 242 252 IF( nn_timing == 1 ) CALL timing_stop('p4z_flx') -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90
r5836 r7282 44 44 REAL(wp), PUBLIC :: xkdoc !: 2nd half-sat. of DOC remineralization 45 45 REAL(wp), PUBLIC :: concbfe !: Fe half saturation for bacteria 46 REAL(wp), PUBLIC :: oxymin !: half saturation constant for anoxia 46 47 REAL(wp), PUBLIC :: qnfelim !: optimal Fe quota for nanophyto 47 48 REAL(wp), PUBLIC :: qdfelim !: optimal Fe quota for diatoms … … 186 187 END DO 187 188 ! 189 DO jk = 1, jpkm1 190 DO jj = 1, jpj 191 DO ji = 1, jpi 192 ! denitrification factor computed from O2 levels 193 nitrfac(ji,jj,jk) = MAX( 0.e0, 0.4 * ( 6.e-6 - trb(ji,jj,jk,jpoxy) ) & 194 & / ( oxymin + trb(ji,jj,jk,jpoxy) ) ) 195 nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) ) 196 END DO 197 END DO 198 END DO 188 199 ! 189 200 IF( lk_iomput .AND. knt == nrdttrc ) THEN ! save output diagnostics … … 215 226 NAMELIST/nampislim/ concnno3, concdno3, concnnh4, concdnh4, concnfer, concdfer, concbfe, & 216 227 & concbno3, concbnh4, xsizedia, xsizephy, xsizern, xsizerd, & 217 & xksi1, xksi2, xkdoc, qnfelim, qdfelim, caco3r 228 & xksi1, xksi2, xkdoc, qnfelim, qdfelim, caco3r, oxymin 218 229 INTEGER :: ios ! Local integer output status for namelist read 219 230 … … 248 259 WRITE(numout,*) ' Minimum size criteria for nanophyto xsizephy = ', xsizephy 249 260 WRITE(numout,*) ' Fe half saturation for bacteria concbfe = ', concbfe 261 WRITE(numout,*) ' halk saturation constant for anoxia oxymin =' , oxymin 250 262 WRITE(numout,*) ' optimal Fe quota for nano. qnfelim = ', qnfelim 251 263 WRITE(numout,*) ' Optimal Fe quota for diatoms qdfelim = ', qdfelim 252 264 ENDIF 253 265 ! 266 nitrfac (:,:,:) = 0._wp 267 ! 254 268 END SUBROUTINE p4z_lim_init 255 269 -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90
r6291 r7282 65 65 REAL(wp) :: zomegaca, zexcess, zexcess0 66 66 CHARACTER (len=25) :: charout 67 REAL(wp), POINTER, DIMENSION(:,:,:) :: zco3, zc aldiss67 REAL(wp), POINTER, DIMENSION(:,:,:) :: zco3, zco3sat, zcaldiss 68 68 !!--------------------------------------------------------------------- 69 69 ! 70 70 IF( nn_timing == 1 ) CALL timing_start('p4z_lys') 71 71 ! 72 CALL wrk_alloc( jpi, jpj, jpk, zco3, zc aldiss )72 CALL wrk_alloc( jpi, jpj, jpk, zco3, zco3sat, zcaldiss ) 73 73 ! 74 74 zco3 (:,:,:) = 0. … … 117 117 zcalcon = calcon * ( tsn(ji,jj,jk,jp_sal) / 35._wp ) 118 118 zfact = rhop(ji,jj,jk) / 1000._wp 119 zomegaca = ( zcalcon * zco3(ji,jj,jk) * zfact ) / aksp(ji,jj,jk) 119 zomegaca = ( zcalcon * zco3(ji,jj,jk) ) / ( aksp(ji,jj,jk) * zfact + rtrn ) 120 zco3sat(ji,jj,jk) = aksp(ji,jj,jk) * zfact / ( zcalcon + rtrn ) 120 121 121 122 ! SET DEGREE OF UNDER-/SUPERSATURATION … … 146 147 IF( lk_iomput .AND. knt == nrdttrc ) THEN 147 148 IF( iom_use( "PH" ) ) CALL iom_put( "PH" , -1. * LOG10( hi(:,:,:) ) * tmask(:,:,:) ) 148 IF( iom_use( "CO3" ) ) CALL iom_put( "CO3" , zco3(:,:,:) * 1.e+3* tmask(:,:,:) )149 IF( iom_use( "CO3sat" ) ) CALL iom_put( "CO3sat", aksp(:,:,:) * 1.e+3 / calcon* tmask(:,:,:) )150 IF( iom_use( "DCAL" ) ) CALL iom_put( "DCAL" , zcaldiss(:,:,:) * 1.e+3 * rfact2r 149 IF( iom_use( "CO3" ) ) CALL iom_put( "CO3" , zco3(:,:,:) * 1.e+3 * tmask(:,:,:) ) 150 IF( iom_use( "CO3sat" ) ) CALL iom_put( "CO3sat", zco3sat(:,:,:) * 1.e+3 * tmask(:,:,:) ) 151 IF( iom_use( "DCAL" ) ) CALL iom_put( "DCAL" , zcaldiss(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ) 151 152 ELSE 152 153 IF( ln_diatrc ) THEN 153 154 trc3d(:,:,:,jp_pcs0_3d ) = -1. * LOG10( hi(:,:,:) ) * tmask(:,:,:) 154 155 trc3d(:,:,:,jp_pcs0_3d + 1) = zco3(:,:,:) * tmask(:,:,:) 155 trc3d(:,:,:,jp_pcs0_3d + 2) = aksp(:,:,:) / calcon* tmask(:,:,:)156 trc3d(:,:,:,jp_pcs0_3d + 2) = zco3sat(:,:,:) * tmask(:,:,:) 156 157 ENDIF 157 158 ENDIF … … 163 164 ENDIF 164 165 ! 165 CALL wrk_dealloc( jpi, jpj, jpk, zco3, zc aldiss )166 CALL wrk_dealloc( jpi, jpj, jpk, zco3, zco3sat, zcaldiss ) 166 167 ! 167 168 IF( nn_timing == 1 ) CALL timing_stop('p4z_lys') -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
r7278 r7282 110 110 ! ! -------------------------------------- 111 111 IF( l_trcdm2dc ) THEN ! diurnal cycle 112 ! ! 1% of qsr to compute euphotic layer113 zqsr100(:,:) = 0.01 * qsr_mean(:,:) ! daily mean qsr114 112 ! 115 113 zqsr_corr(:,:) = qsr_mean(:,:) / ( 1. - fr_i(:,:) + rtrn ) 116 114 ! 117 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3 )115 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 ) 118 116 ! 119 117 DO jk = 1, nksrp … … 132 130 ! 133 131 ELSE 134 ! ! 1% of qsr to compute euphotic layer135 zqsr100(:,:) = 0.01 * qsr(:,:) ! daily mean qsr136 132 ! 137 133 zqsr_corr(:,:) = qsr(:,:) / ( 1. - fr_i(:,:) + rtrn ) 138 134 ! 139 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3 )135 CALL p4z_opt_par( kt, zqsr_corr, ze1, ze2, ze3, pqsr100 = zqsr100 ) 140 136 ! 141 137 DO jk = 1, nksrp … … 165 161 DO jj = 1, jpj 166 162 DO ji = 1, jpi 167 IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.43 *zqsr100(ji,jj) ) THEN163 IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= zqsr100(ji,jj) ) THEN 168 164 neln(ji,jj) = jk+1 ! Euphotic level : 1rst T-level strictly below Euphotic layer 169 165 ! ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint … … 234 230 END SUBROUTINE p4z_opt 235 231 236 SUBROUTINE p4z_opt_par( kt, pqsr, pe1, pe2, pe3, pe0 )232 SUBROUTINE p4z_opt_par( kt, pqsr, pe1, pe2, pe3, pe0, pqsr100 ) 237 233 !!---------------------------------------------------------------------- 238 234 !! *** routine p4z_opt_par *** … … 247 243 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pe1 , pe2 , pe3 ! PAR ( R-G-B) 248 244 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout), OPTIONAL :: pe0 245 REAL(wp), DIMENSION(jpi,jpj) , INTENT(out) , OPTIONAL :: pqsr100 249 246 !! * local variables 250 247 INTEGER :: ji, jj, jk ! dummy loop indices … … 256 253 ELSE ; zqsr(:,:) = xparsw * pqsr(:,:) 257 254 ENDIF 258 ! 255 256 ! Light at the euphotic depth 257 IF( PRESENT( pqsr100 ) ) pqsr100(:,:) = 0.01 * 3. * zqsr(:,:) 258 259 259 IF( PRESENT( pe0 ) ) THEN ! W-level 260 260 ! -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90
r7278 r7282 279 279 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * zmixdiat(ji,jj) 280 280 ENDIF 281 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 282 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 281 283 END DO 282 284 END DO … … 315 317 END DO 316 318 317 IF( ln_newprod ) THEN 318 DO jk = 1, jpkm1 319 DO jj = 1, jpj 320 DO ji = 1, jpi 321 IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 322 zprnch(ji,jj,jk) = zprnch(ji,jj,jk) * zmixnano(ji,jj) 323 zprdch(ji,jj,jk) = zprdch(ji,jj,jk) * zmixdiat(ji,jj) 324 ENDIF 325 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 326 ! production terms for nanophyto. ( chlorophyll ) 327 znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 328 zprod = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 329 zprochln(ji,jj,jk) = chlcmin * 12. * zprorca (ji,jj,jk) 330 zprochln(ji,jj,jk) = zprochln(ji,jj,jk) + (chlcnm-chlcmin) * 12. * zprod / & 331 & ( zpislopead(ji,jj,jk) * znanotot +rtrn) 332 ! production terms for diatomees ( chlorophyll ) 333 zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 334 zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 335 zprochld(ji,jj,jk) = chlcmin * 12. * zprorcad(ji,jj,jk) 336 zprochld(ji,jj,jk) = zprochld(ji,jj,jk) + (chlcdm-chlcmin) * 12. * zprod / & 337 & ( zpislopead2(ji,jj,jk) * zdiattot +rtrn ) 338 ENDIF 339 END DO 340 END DO 341 END DO 342 ELSE 343 DO jk = 1, jpkm1 344 DO jj = 1, jpj 345 DO ji = 1, jpi 346 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 347 ! production terms for nanophyto. ( chlorophyll ) 348 znanotot = enano(ji,jj,jk) 349 zprod = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * trb(ji,jj,jk,jpphy) * xlimphy(ji,jj,jk) 350 zprochln(ji,jj,jk) = chlcmin * 12. * zprorca (ji,jj,jk) 351 zprochln(ji,jj,jk) = zprochln(ji,jj,jk) + (chlcnm-chlcmin) * 144. * zprod & 352 & / ( zpislopead(ji,jj,jk) * trb(ji,jj,jk,jpnch) * znanotot +rtrn ) 353 ! production terms for diatomees ( chlorophyll ) 354 zdiattot = ediat(ji,jj,jk) 355 zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * trb(ji,jj,jk,jpdia) * xlimdia(ji,jj,jk) 356 zprochld(ji,jj,jk) = chlcmin * 12. * zprorcad(ji,jj,jk) 357 zprochld(ji,jj,jk) = zprochld(ji,jj,jk) + (chlcdm-chlcmin) * 144. * zprod & 358 & / ( zpislopead2(ji,jj,jk) * trb(ji,jj,jk,jpdch) * zdiattot +rtrn ) 359 ENDIF 360 END DO 361 END DO 362 END DO 363 ENDIF 319 DO jk = 1, jpkm1 320 DO jj = 1, jpj 321 DO ji = 1, jpi 322 IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 323 zprnch(ji,jj,jk) = zprnch(ji,jj,jk) * zmixnano(ji,jj) 324 zprdch(ji,jj,jk) = zprdch(ji,jj,jk) * zmixdiat(ji,jj) 325 ENDIF 326 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 327 ! production terms for nanophyto. ( chlorophyll ) 328 znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 329 zprod = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 330 zprochln(ji,jj,jk) = chlcmin * 12. * zprorca (ji,jj,jk) 331 zprochln(ji,jj,jk) = zprochln(ji,jj,jk) + (chlcnm-chlcmin) * 12. * zprod / & 332 & ( zpislopead(ji,jj,jk) * znanotot +rtrn) 333 ! production terms for diatomees ( chlorophyll ) 334 zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 335 zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 336 zprochld(ji,jj,jk) = chlcmin * 12. * zprorcad(ji,jj,jk) 337 zprochld(ji,jj,jk) = zprochld(ji,jj,jk) + (chlcdm-chlcmin) * 12. * zprod / & 338 & ( zpislopead2(ji,jj,jk) * zdiattot +rtrn ) 339 ENDIF 340 END DO 341 END DO 342 END DO 364 343 365 344 ! Update the arrays TRA which contain the biological sources and sinks -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90
r6140 r7282 44 44 REAL(wp), PUBLIC :: xsiremlab !: fast remineralisation rate of POC 45 45 REAL(wp), PUBLIC :: xsilab !: fraction of labile biogenic silica 46 REAL(wp), PUBLIC :: oxymin !: halk saturation constant for anoxia47 46 48 47 … … 109 108 zdepprod(ji,jj,jk) = zdepmin**0.273 110 109 ENDIF 111 END DO112 END DO113 END DO114 115 DO jk = 1, jpkm1116 DO jj = 1, jpj117 DO ji = 1, jpi118 ! denitrification factor computed from O2 levels119 nitrfac(ji,jj,jk) = MAX( 0.e0, 0.4 * ( 6.e-6 - trb(ji,jj,jk,jpoxy) ) &120 & / ( oxymin + trb(ji,jj,jk,jpoxy) ) )121 nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) )122 110 END DO 123 111 END DO … … 355 343 !! 356 344 !!---------------------------------------------------------------------- 357 NAMELIST/nampisrem/ xremik, xremip, nitrif, xsirem, xsiremlab, xsilab, & 358 & oxymin 345 NAMELIST/nampisrem/ xremik, xremip, nitrif, xsirem, xsiremlab, xsilab 359 346 INTEGER :: ios ! Local integer output status for namelist read 360 347 … … 378 365 WRITE(numout,*) ' fraction of labile biogenic silica xsilab =', xsilab 379 366 WRITE(numout,*) ' NH4 nitrification rate nitrif =', nitrif 380 WRITE(numout,*) ' halk saturation constant for anoxia oxymin =', oxymin381 367 ENDIF 382 368 ! 383 nitrfac (:,:,:) = 0._wp384 369 denitr (:,:,:) = 0._wp 385 370 denitnh4(:,:,:) = 0._wp -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90
r6140 r7282 155 155 IF( ln_ndepo ) THEN 156 156 IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_ndep > 1 ) ) THEN 157 CALL fld_read( kt, 1, sf_ndepo ) 158 DO jj = 1, jpj 159 DO ji = 1, jpi 160 nitdep(ji,jj) = sf_ndepo(1)%fnow(ji,jj,1) / rno3 / ( 14E6 * ryyss * e3t_n(ji,jj,1) + rtrn ) 161 END DO 162 END DO 157 zcoef = rno3 * 14E6 * ryyss 158 CALL fld_read( kt, 1, sf_ndepo ) 159 nitdep(:,:) = sf_ndepo(1)%fnow(:,:,1) / zcoef / e3t_n(:,:,1) 160 ENDIF 161 IF( .NOT.ln_linssh ) THEN 162 zcoef = rno3 * 14E6 * ryyss 163 nitdep(:,:) = sf_ndepo(1)%fnow(:,:,1) / zcoef / e3t_n(:,:,1) 163 164 ENDIF 164 165 ENDIF … … 461 462 ironsed(:,:,jpk) = 0._wp 462 463 DO jk = 1, jpkm1 463 ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( e3t_ n(:,:,jk) * rday )464 ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( e3t_0(:,:,jk) * rday ) 464 465 END DO 465 466 DEALLOCATE( zcmask) … … 479 480 CALL iom_close( numhydro ) 480 481 ! 481 hydrofe(:,:,:) = ( hydrofe(:,:,:) * hratio ) / ( cvol(:,:,:) * ryyss + rtrn ) / 1000._wp 482 DO jk = 1, jpk 483 hydrofe(:,:,jk) = ( hydrofe(:,:,jk) * hratio ) / ( e1e2t(:,:) * e3t_0(:,:,jk) * ryyss + rtrn ) / 1000._wp 484 ENDDO 482 485 ! 483 486 ENDIF -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
r7277 r7282 100 100 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 101 101 102 IF( ln_rsttr .AND. .NOT.ln_top_euler .AND. 102 IF( ln_rsttr .AND. .NOT.ln_top_euler .AND. & ! Restart: read in restart file 103 103 iom_varid( numrtr, 'sbc_'//TRIM(ctrcnm(1))//'_b', ldstop = .FALSE. ) > 0 ) THEN 104 104 IF(lwp) WRITE(numout,*) ' nittrc000-nn_dttrc surface tracer content forcing fields red in the restart file' -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r6140 r7282 295 295 IF(lwp) WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax, zdrift 296 296 END DO 297 WRITE(numout,*)297 IF(lwp) WRITE(numout,*) 298 298 9000 FORMAT(' tracer nb :',i2,' name :',a10,' mean :',e18.10,' min :',e18.10, & 299 299 & ' max :',e18.10,' drift :',e18.10, ' %') -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
r6140 r7282 32 32 REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE :: qsr_arr ! save qsr during TOP time-step 33 33 REAL(wp) :: rdt_sampl 34 INTEGER :: nb_rec_per_day s35 INTEGER :: isecfst, iseclast34 INTEGER :: nb_rec_per_day 35 REAL(wp) :: rsecfst, rseclast 36 36 LOGICAL :: llnew 37 37 … … 108 108 END DO 109 109 IF( lwp ) WRITE(numstr,9300) kt, ztrai / areatot 110 9300 FORMAT(i10, e18.10)110 9300 FORMAT(i10,D23.16) 111 111 ! 112 112 IF( nn_timing == 1 ) CALL timing_stop('trc_stp') 113 113 ! 114 114 END SUBROUTINE trc_stp 115 116 115 117 116 SUBROUTINE trc_mean_qsr( kt ) … … 122 121 !! of diurnal cycle 123 122 !! 124 !! ** Method : store in TOP the qsr every hour ( or every time-step the latter123 !! ** Method : store in TOP the qsr every hour ( or every time-step if the latter 125 124 !! is greater than 1 hour ) and then, compute the mean with 126 125 !! a moving average over 24 hours. … … 129 128 INTEGER, INTENT(in) :: kt 130 129 INTEGER :: jn 131 !!---------------------------------------------------------------------- 132 ! 130 REAL(wp) :: zkt 131 CHARACTER(len=1) :: cl1 ! 1 character 132 CHARACTER(len=2) :: cl2 ! 2 characters 133 133 134 IF( kt == nittrc000 ) THEN 134 135 IF( ln_cpl ) THEN 135 rdt_sampl = 86400./ ncpl_qsr_freq136 nb_rec_per_day s= ncpl_qsr_freq136 rdt_sampl = rday / ncpl_qsr_freq 137 nb_rec_per_day = ncpl_qsr_freq 137 138 ELSE 138 rdt_sampl = MAX( 3600., rdt * nn_dttrc )139 nb_rec_per_day s = INT( 86400/ rdt_sampl )139 rdt_sampl = MAX( 3600., rdttrc ) 140 nb_rec_per_day = INT( rday / rdt_sampl ) 140 141 ENDIF 141 142 ! 142 143 IF( lwp ) THEN 143 144 WRITE(numout,*) 144 WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's',' Number of sampling per day nrec = ', nb_rec_per_day s145 WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's',' Number of sampling per day nrec = ', nb_rec_per_day 145 146 WRITE(numout,*) 146 147 ENDIF 147 148 ! 148 ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_days ) ) 149 DO jn = 1, nb_rec_per_days 150 qsr_arr(:,:,jn) = qsr(:,:) 149 ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_day ) ) 150 ! 151 ! !* Restart: read in restart file 152 IF( ln_rsttr .AND. iom_varid( numrtr, 'qsr_mean' , ldstop = .FALSE. ) > 0 .AND. & 153 iom_varid( numrtr, 'qsr_arr_1', ldstop = .FALSE. ) > 0 .AND. & 154 iom_varid( numrtr, 'ktdcy' , ldstop = .FALSE. ) > 0 ) THEN 155 CALL iom_get( numrtr, 'ktdcy', zkt ) ! A mean of qsr 156 rsecfst = INT( zkt ) * rdttrc 157 IF(lwp) WRITE(numout,*) 'trc_qsr_mean: qsr_mean read in the restart file at time-step rsecfst =', rsecfst, ' s ' 158 CALL iom_get( numrtr, jpdom_autoglo, 'qsr_mean', qsr_mean ) ! A mean of qsr 159 DO jn = 1, nb_rec_per_day 160 IF( jn <= 9 ) THEN 161 WRITE(cl1,'(i1)') jn 162 CALL iom_get( numrtr, jpdom_autoglo, 'qsr_arr_'//cl1, qsr_arr(:,:,jn) ) ! A mean of qsr 163 ELSE 164 WRITE(cl2,'(i2.2)') jn 165 CALL iom_get( numrtr, jpdom_autoglo, 'qsr_arr_'//cl2, qsr_arr(:,:,jn) ) ! A mean of qsr 166 ENDIF 167 ENDDO 168 ELSE !* no restart: set from nit000 values 169 IF(lwp) WRITE(numout,*) 'trc_qsr_mean: qsr_mean set to nit000 values' 170 rsecfst = kt * rdttrc 171 ! 172 qsr_mean(:,:) = qsr(:,:) 173 DO jn = 1, nb_rec_per_day 174 qsr_arr(:,:,jn) = qsr_mean(:,:) 175 ENDDO 176 ENDIF 177 ! 178 ENDIF 179 ! 180 rseclast = kt * rdttrc 181 ! 182 llnew = ( rseclast - rsecfst ) .ge. rdt_sampl ! new shortwave to store 183 IF( llnew ) THEN 184 IF( lwp ) WRITE(numout,*) ' New shortwave to sample for TOP at time kt = ', kt, & 185 & ' time = ', rseclast/3600.,'hours ' 186 rsecfst = rseclast 187 DO jn = 1, nb_rec_per_day - 1 188 qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1) 189 ENDDO 190 qsr_arr (:,:,nb_rec_per_day) = qsr(:,:) 191 qsr_mean(:,: ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_day 192 ENDIF 193 ! 194 IF( lrst_trc ) THEN !* Write the mean of qsr in restart file 195 IF(lwp) WRITE(numout,*) 196 IF(lwp) WRITE(numout,*) 'trc_mean_qsr : write qsr_mean in restart file kt =', kt 197 IF(lwp) WRITE(numout,*) '~~~~~~~' 198 zkt = REAL( kt, wp ) 199 CALL iom_rstput( kt, nitrst, numrtw, 'ktdcy', zkt ) 200 DO jn = 1, nb_rec_per_day 201 IF( jn <= 9 ) THEN 202 WRITE(cl1,'(i1)') jn 203 CALL iom_rstput( kt, nitrst, numrtw, 'qsr_arr_'//cl1, qsr_arr(:,:,jn) ) 204 ELSE 205 WRITE(cl2,'(i2.2)') jn 206 CALL iom_rstput( kt, nitrst, numrtw, 'qsr_arr_'//cl2, qsr_arr(:,:,jn) ) 207 ENDIF 151 208 ENDDO 152 qsr_mean(:,:) = qsr(:,:) 153 ! 154 isecfst = nsec_year + nsec1jan000 ! number of seconds between Jan. 1st 00h of nit000 year and the middle of time step 155 iseclast = isecfst 156 ! 157 ENDIF 158 ! 159 iseclast = nsec_year + nsec1jan000 160 llnew = ( iseclast - isecfst ) > INT( rdt_sampl ) ! new shortwave to store 161 IF( kt /= nittrc000 .AND. llnew ) THEN 162 IF( lwp ) WRITE(numout,*) ' New shortwave to sample for TOP at time kt = ', kt, & 163 & ' time = ', (iseclast+rdt*nn_dttrc/2.)/3600.,'hours ' 164 isecfst = iseclast 165 DO jn = 1, nb_rec_per_days - 1 166 qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1) 167 END DO 168 qsr_arr (:,:,nb_rec_per_days) = qsr(:,:) 169 qsr_mean(:,: ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_days 209 CALL iom_rstput( kt, nitrst, numrtw, 'qsr_mean', qsr_mean(:,:) ) 170 210 ENDIF 171 211 ! -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/TOP_SRC/trcsub.F90
r6140 r7282 16 16 USE in_out_manager 17 17 USE lbclnk 18 #if defined key_zdftke19 USE zdftke ! twice TKE (en)20 #endif21 #if defined key_zdfgls22 USE zdfgls, ONLY: en23 #endif24 18 USE trabbl 25 19 USE zdf_oce -
branches/2016/dev_CNRS_2016/NEMOGCM/TOOLS/NESTING/agulhas
r5656 r7282 41 41 N = 31 42 42 ldbletanh = .FALSE. 43 p pa2= 0.043 pa2 = 0.0 44 44 ppkth2 = 0.0 45 45 ppacr2 = 0.0 -
branches/2016/dev_CNRS_2016/NEMOGCM/TOOLS/NESTING/src/agrif_types.f90
r5656 r7282 76 76 NAMELIST /nesting/imin,imax,jmin,jmax,rho,rhot,bathy_update,updated_parent_file 77 77 ! 78 NAMELIST /vertical_grid/ppkth,ppacr,ppdzmin,pphmax,psur,pa0,pa1,N,ldbletanh,p pa2,ppkth2,ppacr278 NAMELIST /vertical_grid/ppkth,ppacr,ppdzmin,pphmax,psur,pa0,pa1,N,ldbletanh,pa2,ppkth2,ppacr2 79 79 ! 80 80 NAMELIST /partial_cells/partial_steps,parent_bathy_meter,parent_batmet_name,e3zps_min,e3zps_rat
Note: See TracChangeset
for help on using the changeset viewer.
