Changeset 9208 for branches/NERC
- Timestamp:
- 2018-01-10T17:06:13+01:00 (7 years ago)
- Location:
- branches/NERC/dev_r5518_GO6_conserv_check_up/NEMOGCM/NEMO
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/NERC/dev_r5518_GO6_conserv_check_up/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r6823 r9208 851 851 CALL wrk_alloc( jpi,jpj, rgt33 ) 852 852 ! 853 #if defined key_coare_bulk_patch 854 rgt33 = MIN(zw10, 22.) 855 !! cd_neutral_10m = 1.e-3 * ( 2.7/rgt33 + 0.142 + 0.06*rgt33 + 856 !! 0.0025*rgt33 **2 - 1.25e-9*rgt33 **6) 857 !! A new version May 31st! 858 cd_neutral_10m = 1.e-3 * ( 2.4/rgt33 + 0.15 + 0.095*rgt33 + 0.0008*rgt33 **2 - 1.0e-9*rgt33 **6) 859 #else 853 860 !! When wind speed > 33 m/s => Cyclone conditions => special treatment 854 861 rgt33 = 0.5_wp + SIGN( 0.5_wp, (zw10 - 33._wp) ) ! If zw10 < 33. => 0, else => 1 … … 856 863 & (1._wp - rgt33)*( 2.7_wp/zw10 + 0.142_wp + zw10/13.09_wp - 3.14807E-10*zw10**6) & ! zw10< 33. 857 864 & + rgt33 * 2.34 ) ! zw10 >= 33. 865 #endif 858 866 ! 859 867 CALL wrk_dealloc( jpi,jpj, rgt33) -
branches/NERC/dev_r5518_GO6_conserv_check_up/NEMOGCM/NEMO/TOP_SRC/trc.F90
r9114 r9208 33 33 !! -------------------------------------------------- 34 34 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: trai !: initial total tracer 35 # if defined key_medusa && key_roam 36 !! AXY (17/11/2017): elemental cycle initial totals 37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: cycletot !: initial elemental cycle total 38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: cycletot2 !: initial elemental cycle total excl. halo in mpp_sum 39 # endif 35 40 REAL(wp), PUBLIC :: areatot !: total volume 36 41 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,: ) :: cvol !: volume correction -degrad option- … … 266 271 & cvol(jpi,jpj,jpk) , rdttrc(jpk) , trai(jptra) , & 267 272 & ctrcnm(jptra) , ctrcln(jptra) , ctrcun(jptra) , & 273 # if defined key_medusa && defined key_roam 274 & cycletot(6), cycletot2(6) , & 275 # endif 268 276 & ln_trc_ini(jptra) , ln_trc_wri(jptra) , qsr_mean(jpi,jpj) , STAT = trc_alloc ) 269 277 -
branches/NERC/dev_r5518_GO6_conserv_check_up/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r8442 r9208 28 28 USE trcini_idtra ! idealize tracer initialisation 29 29 USE trcini_medusa ! MEDUSA initialisation 30 USE par_medusa ! MEDUSA parameters (needed for elemental cycles) 30 31 USE trcdta ! initialisation from files 31 32 USE daymod ! calendar manager … … 35 36 USE sbc_oce 36 37 USE trcice ! tracers in sea ice 37 38 USE sms_medusa ! MEDUSA initialisation 38 39 IMPLICIT NONE 39 40 PRIVATE … … 62 63 !! or read data or analytical formulation 63 64 !!--------------------------------------------------------------------- 64 INTEGER :: jk, jn, jl ! dummy loop indices 65 INTEGER :: ji, jj, jk, jn, jl ! dummy loop indices 66 # if defined key_medusa && defined key_roam 67 !! AXY (23/11/2017) 68 REAL(wp) :: zsum3d, zsum2d 69 REAL(wp) :: zq1, zq2, loc_vol, loc_area 70 REAL(wp), DIMENSION(6) :: loc_cycletot3, loc_cycletot2 71 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztot3d 72 REAL(wp), DIMENSION(jpi,jpj) :: ztot2d, carea 73 # endif 65 74 CHARACTER (len=25) :: charout 66 75 !!--------------------------------------------------------------------- … … 98 107 ! ! total volume of the ocean 99 108 areatot = glob_sum( cvol(:,:,:) ) 109 carea(:,:) = e1e2t(:,:) * tmask(:,:,1) 100 110 101 111 IF( lk_pisces ) CALL trc_ini_pisces ! PISCES bio-model … … 192 202 ENDIF 193 203 204 # if defined key_medusa && defined key_roam 205 ! AXY (17/11/2017): calculate initial totals of elemental cycles 206 ! 207 ! This is done in a very hard-wired way here; in future, this could be 208 ! replaced with loops and using a 2D array; one dimension would cover 209 ! the tracers, the other would be for the elements; each tracer would 210 ! have a factor for each element to say how much of that element was 211 ! in that tracer; for example, PHN would be 1.0 for N, xrfn for Fe and 212 ! xthetapn for C, with the other elements 0.0; the array entry for PHN 213 ! would then be (1. 0. xrfn xthetapn 0. 0.) for (N, Si, Fe, C, A, O2); 214 ! saving this for the next iteration 215 ! 216 cycletot(:) = 0._wp 217 ! report elemental totals at initialisation as we go along 218 IF ( lwp ) WRITE(numout,*) 219 IF ( lwp ) WRITE(numout,*) ' Elemental cycle totals: ' 220 IF ( lwp ) CALL flush(numout) 221 ! nitrogen 222 ztot3d(:,:,:) = trn(:,:,:,jpphn) + trn(:,:,:,jpphd) + trn(:,:,:,jpzmi) + & 223 trn(:,:,:,jpzme) + trn(:,:,:,jpdet) + trn(:,:,:,jpdin) 224 ztot2d(:,:) = zn_sed_n(:,:) 225 zsum3d = glob_sum( ztot3d(:,:,:) * cvol(:,:,:) ) 226 zsum2d = glob_sum( ztot2d(:,:) * carea(:,:) ) 227 cycletot(1) = zsum3d + zsum2d 228 IF ( lwp ) WRITE(numout,9010) 'nitrogen', zsum3d, zsum2d, cycletot(1) 229 IF ( lwp ) CALL flush(numout) 230 ! silicon 231 ztot3d(:,:,:) = trn(:,:,:,jppds) + trn(:,:,:,jpsil) 232 ztot2d(:,:) = zn_sed_si(:,:) 233 zsum3d = glob_sum( ztot3d(:,:,:) * cvol(:,:,:) ) 234 zsum2d = glob_sum( ztot2d(:,:) * carea(:,:) ) 235 cycletot(2) = zsum3d + zsum2d 236 IF ( lwp ) WRITE(numout,9010) 'silicon', zsum3d, zsum2d, cycletot(2) 237 IF ( lwp ) CALL flush(numout) 238 ! iron 239 ztot3d(:,:,:) = ((trn(:,:,:,jpphn) + trn(:,:,:,jpphd) + trn(:,:,:,jpzmi) + & 240 trn(:,:,:,jpzme) + trn(:,:,:,jpdet)) * xrfn) + trn(:,:,:,jpfer) 241 ztot2d(:,:) = zn_sed_fe(:,:) 242 zsum3d = glob_sum( ztot3d(:,:,:) * cvol(:,:,:) ) 243 zsum2d = glob_sum( ztot2d(:,:) * carea(:,:) ) 244 cycletot(3) = zsum3d + zsum2d 245 IF ( lwp ) WRITE(numout,9010) 'iron', zsum3d, zsum2d, cycletot(3) 246 IF ( lwp ) CALL flush(numout) 247 ! carbon (uses fixed C:N ratios on plankton tracers) 248 ztot3d(:,:,:) = (trn(:,:,:,jpphn) * xthetapn) + (trn(:,:,:,jpphd) * xthetapd) + & 249 (trn(:,:,:,jpzmi) * xthetazmi) + (trn(:,:,:,jpzme) * xthetazme) + & 250 trn(:,:,:,jpdtc) + trn(:,:,:,jpdic) 251 ztot2d(:,:) = zn_sed_c(:,:) + zn_sed_ca(:,:) 252 zsum3d = glob_sum( ztot3d(:,:,:) * cvol(:,:,:) ) 253 zsum2d = glob_sum( ztot2d(:,:) * carea(:,:) ) 254 cycletot(4) = zsum3d + zsum2d 255 IF ( lwp ) WRITE(numout,9010) 'carbon', zsum3d, zsum2d, cycletot(4) 256 IF ( lwp ) CALL flush(numout) 257 ! alkalinity (note benthic correction) 258 ztot3d(:,:,:) = trn(:,:,:,jpalk) 259 ztot2d(:,:) = zn_sed_ca(:,:) * 2._wp 260 zsum3d = glob_sum( ztot3d(:,:,:) * cvol(:,:,:) ) 261 zsum2d = glob_sum( ztot2d(:,:) * carea(:,:) ) 262 cycletot(5) = zsum3d + zsum2d 263 IF ( lwp ) WRITE(numout,9010) 'alkalinity', zsum3d, zsum2d, cycletot(5) 264 IF ( lwp ) CALL flush(numout) 265 ! oxygen (note no benthic) 266 ztot3d(:,:,:) = trn(:,:,:,jpoxy) 267 ztot2d(:,:) = 0._wp 268 zsum3d = glob_sum( ztot3d(:,:,:) * cvol(:,:,:) ) 269 zsum2d = glob_sum( ztot2d(:,:) * carea(:,:) ) 270 cycletot(6) = zsum3d + zsum2d 271 IF ( lwp ) WRITE(numout,9010) 'oxygen', zsum3d, zsum2d, cycletot(6) 272 IF ( lwp ) CALL flush(numout) 273 ! Check 274 zsum3d = glob_sum( cvol(:,:,:) ) 275 zsum2d = glob_sum( carea(:,:) ) 276 IF ( lwp ) WRITE(numout,*) 277 IF ( lwp ) WRITE(numout,*) ' check : cvol : ', zsum3d 278 IF ( lwp ) WRITE(numout,*) ' check : carea : ', zsum2d 279 IF ( lwp ) WRITE(numout,*) 280 IF ( lwp ) CALL flush(numout) 281 ! 282 # endif 283 194 284 IF(lwp) WRITE(numout,*) 195 285 IF(lwp) WRITE(numout,*) 'trc_init : passive tracer set up completed' … … 202 292 203 293 9000 FORMAT(' tracer nb : ',i2,' name :',a10,' initial content :',e18.10) 294 9010 FORMAT(' element:',a10, & 295 ' 3d sum:',e18.10,' 2d sum:',e18.10, & 296 ' total:',e18.10) 204 297 ! 205 298 IF( nn_timing == 1 ) CALL timing_stop('trc_init') -
branches/NERC/dev_r5518_GO6_conserv_check_up/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r9163 r9208 30 30 USE daymod 31 31 !! AXY (05/11/13): need these for MEDUSA to input/output benthic reservoirs 32 USE par_medusa 32 33 USE sms_medusa 33 34 USE trcsms_medusa … … 53 54 PUBLIC trc_rst_cal 54 55 PUBLIC trc_rst_stat 56 #if defined key_medusa && defined key_roam 57 PUBLIC trc_rst_conserve 58 #endif 55 59 56 60 !! * Substitutions … … 539 543 IF( kt == nitrst ) THEN 540 544 CALL trc_rst_stat ! statistics 545 #if defined key_medusa && defined key_roam 546 CALL trc_rst_conserve ! conservation check 547 #endif 541 548 CALL iom_close( numrtw ) ! close the restart file (only at last time step) 542 549 #if ! defined key_trdmxl_trc … … 705 712 706 713 714 # if defined key_medusa && defined key_roam 715 SUBROUTINE trc_rst_conserve 716 !!---------------------------------------------------------------------- 717 !! *** trc_rst_conserve *** 718 !! 719 !! ** purpose : Compute tracers conservation statistics 720 !! 721 !! AXY (17/11/2017) 722 !! This routine calculates the "now" inventories of the elemental 723 !! cycles of MEDUSA and compares them to those calculate when the 724 !! model was initialised / restarted; the cycles calculated are: 725 !! nitrogen, silicon, iron, carbon, alkalinity and oxygen 726 !!---------------------------------------------------------------------- 727 INTEGER :: ji, jj, jk, jn 728 REAL(wp) :: zsum3d, zsum2d, zinvt, zdelta, zratio, loc_vol, loc_are 729 REAL(wp) :: zq1, zq2, loc_vol, loc_area 730 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d, zvol 731 REAL(wp), DIMENSION(jpi,jpj) :: z2d, zarea 732 REAL(wp), DIMENSION(6) :: loc_cycletot3, loc_cycletot2 733 !!---------------------------------------------------------------------- 734 ! 735 IF( lwp ) THEN 736 WRITE(numout,*) 737 WRITE(numout,*) ' ----TRACER CONSERVATION---- ' 738 WRITE(numout,*) 739 ENDIF 740 ! 741 ! ocean volume 742 DO jk = 1, jpk 743 zvol(:,:,jk) = e1e2t(:,:) * fse3t_a(:,:,jk) * tmask(:,:,jk) 744 END DO 745 ! 746 ! ocean area (for sediments) 747 zarea(:,:) = e1e2t(:,:) * tmask(:,:,1) 748 ! 749 !---------------------------------------------------------------------- 750 ! nitrogen 751 z3d(:,:,:) = trn(:,:,:,jpphn) + trn(:,:,:,jpphd) + trn(:,:,:,jpzmi) + & 752 trn(:,:,:,jpzme) + trn(:,:,:,jpdet) + trn(:,:,:,jpdin) 753 z2d(:,:) = zn_sed_n(:,:) 754 zsum3d = glob_sum( z3d(:,:,:) * zvol(:,:,:) ) 755 zsum2d = glob_sum( z2d(:,:) * zarea(:,:) ) 756 ! total tracer, and delta 757 zinvt = zsum3d + zsum2d 758 zdelta = zinvt - cycletot(1) 759 zratio = 1.0e2 * zdelta / cycletot(1) 760 ! 761 IF ( lwp ) WRITE(numout,9010) 'nitrogen', zsum3d, zsum2d, zinvt, & 762 cycletot(1), zdelta, zratio 763 IF ( lwp ) WRITE(numout,*) 764 ! 765 !---------------------------------------------------------------------- 766 ! silicon 767 z3d(:,:,:) = trn(:,:,:,jppds) + trn(:,:,:,jpsil) 768 z2d(:,:) = zn_sed_si(:,:) 769 zsum3d = glob_sum( z3d(:,:,:) * zvol(:,:,:) ) 770 zsum2d = glob_sum( z2d(:,:) * zarea(:,:) ) 771 ! total tracer, and delta 772 zinvt = zsum3d + zsum2d 773 zdelta = zinvt - cycletot(2) 774 zratio = 1.0e2 * zdelta / cycletot(2) 775 ! 776 IF ( lwp ) WRITE(numout,9010) 'silicon', zsum3d, zsum2d, zinvt, & 777 cycletot(2), zdelta, zratio 778 IF ( lwp ) WRITE(numout,*) 779 ! 780 !---------------------------------------------------------------------- 781 ! iron 782 z3d(:,:,:) = ((trn(:,:,:,jpphn) + trn(:,:,:,jpphd) + trn(:,:,:,jpzmi) + & 783 trn(:,:,:,jpzme) + trn(:,:,:,jpdet)) * xrfn) + trn(:,:,:,jpfer) 784 z2d(:,:) = zn_sed_fe(:,:) 785 zsum3d = glob_sum( z3d(:,:,:) * zvol(:,:,:) ) 786 zsum2d = glob_sum( z2d(:,:) * zarea(:,:) ) 787 ! total tracer, and delta 788 zinvt = zsum3d + zsum2d 789 zdelta = zinvt - cycletot(3) 790 zratio = 1.0e2 * zdelta / cycletot(3) 791 ! 792 IF ( lwp ) WRITE(numout,9010) 'iron', zsum3d, zsum2d, zinvt, & 793 cycletot(3), zdelta, zratio 794 IF ( lwp ) WRITE(numout,*) 795 ! 796 !---------------------------------------------------------------------- 797 ! carbon 798 z3d(:,:,:) = (trn(:,:,:,jpphn) * xthetapn) + (trn(:,:,:,jpphd) * xthetapd) + & 799 (trn(:,:,:,jpzmi) * xthetazmi) + (trn(:,:,:,jpzme) * xthetazme) + & 800 trn(:,:,:,jpdtc) + trn(:,:,:,jpdic) 801 z2d(:,:) = zn_sed_c(:,:) + zn_sed_ca(:,:) 802 zsum3d = glob_sum( z3d(:,:,:) * zvol(:,:,:) ) 803 zsum2d = glob_sum( z2d(:,:) * zarea(:,:) ) 804 ! total tracer, and delta 805 zinvt = zsum3d + zsum2d 806 zdelta = zinvt - cycletot(4) 807 zratio = 1.0e2 * zdelta / cycletot(4) 808 ! 809 IF ( lwp ) WRITE(numout,9010) 'carbon', zsum3d, zsum2d, zinvt, & 810 cycletot(4), zdelta, zratio 811 IF ( lwp ) WRITE(numout,*) 812 ! 813 !---------------------------------------------------------------------- 814 ! alkalinity 815 z3d(:,:,:) = trn(:,:,:,jpalk) 816 z2d(:,:) = zn_sed_ca(:,:) * 2.0 817 zsum3d = glob_sum( z3d(:,:,:) * zvol(:,:,:) ) 818 zsum2d = glob_sum( z2d(:,:) * zarea(:,:) ) 819 ! total tracer, and delta 820 zinvt = zsum3d + zsum2d 821 zdelta = zinvt - cycletot(5) 822 zratio = 1.0e2 * zdelta / cycletot(5) 823 ! 824 IF ( lwp ) WRITE(numout,9010) 'alkalinity', zsum3d, zsum2d, zinvt, & 825 cycletot(5), zdelta, zratio 826 IF ( lwp ) WRITE(numout,*) 827 ! 828 !---------------------------------------------------------------------- 829 ! oxygen 830 z3d(:,:,:) = trn(:,:,:,jpoxy) 831 z2d(:,:) = 0.0 832 zsum3d = glob_sum( z3d(:,:,:) * zvol(:,:,:) ) 833 zsum2d = glob_sum( z2d(:,:) * zarea(:,:) ) 834 ! total tracer, and delta 835 zinvt = zsum3d + zsum2d 836 zdelta = zinvt - cycletot(6) 837 zratio = 1.0e2 * zdelta / cycletot(6) 838 ! 839 IF ( lwp ) WRITE(numout,9010) 'oxygen', zsum3d, zsum2d, zinvt, & 840 cycletot(6), zdelta, zratio 841 ! 842 !---------------------------------------------------------------------- 843 ! Check 844 zsum3d = glob_sum( zvol(:,:,:) ) 845 zsum2d = glob_sum( zarea(:,:) ) 846 IF ( lwp ) WRITE(numout,*) 847 IF ( lwp ) WRITE(numout,*) ' check : cvol : ', zsum3d 848 IF ( lwp ) WRITE(numout,*) ' check : carea : ', zsum2d 849 IF ( lwp ) WRITE(numout,*) 850 IF ( lwp ) CALL flush(numout) 851 ! 852 9010 FORMAT(' element:',a10, & 853 ' 3d sum:',e18.10,' 2d sum:',e18.10, & 854 ' total:',e18.10,' initial:',e18.10, & 855 ' delta:',e18.10,' %:',e18.10) 856 ! 857 END SUBROUTINE trc_rst_conserve 858 # endif 859 860 707 861 #else 708 862 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.