Changeset 8440
- Timestamp:
- 2017-08-16T14:47:00+02:00 (7 years ago)
- Location:
- branches/UKMO/dev_r5518_GO6_package_asm_surf_bgc/NEMOGCM/NEMO
- Files:
-
- 5 edited
-
OPA_SRC/ASM/asmbkg.F90 (modified) (1 diff)
-
OPA_SRC/ASM/asminc.F90 (modified) (5 diffs)
-
OPA_SRC/ASM/asmlogchlbal_hadocc.F90 (modified) (7 diffs)
-
OPA_SRC/ASM/asmlogchlbal_medusa.F90 (modified) (12 diffs)
-
TOP_SRC/trcrst.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_package_asm_surf_bgc/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90
r8436 r8440 139 139 CALL iom_rstput( kt, nitbkg_r, inum, 'avt' , avt ) 140 140 #if defined key_hadocc 141 CALL iom_rstput( kt, nitbkg_r, inum, 'pgrow_avg' 142 CALL iom_rstput( kt, nitbkg_r, inum, 'ploss_avg' 143 CALL iom_rstput( kt, nitbkg_r, inum, 'phyt_avg' 144 CALL iom_rstput( kt, nitbkg_r, inum, 'mld_max' 145 CALL iom_rstput( kt, nitbkg_r, inum, ' nutrients', trn(:,:,:,jp_had_nut) )146 CALL iom_rstput( kt, nitbkg_r, inum, ' phytoplankton', trn(:,:,:,jp_had_phy) )147 CALL iom_rstput( kt, nitbkg_r, inum, ' zooplankton', trn(:,:,:,jp_had_zoo) )148 CALL iom_rstput( kt, nitbkg_r, inum, ' detritus', trn(:,:,:,jp_had_pdn) )149 CALL iom_rstput( kt, nitbkg_r, inum, ' dic', trn(:,:,:,jp_had_dic) )150 CALL iom_rstput( kt, nitbkg_r, inum, ' alkalinity', trn(:,:,:,jp_had_alk) )151 CALL iom_rstput( kt, nitbkg_r, inum, ' chlorophyll', HADOCC_CHL(:,:,1) )152 CALL iom_rstput( kt, nitbkg_r, inum, ' c_to_chl', cchl_p(:,:,1) )141 CALL iom_rstput( kt, nitbkg_r, inum, 'pgrow_avg' , pgrow_avg ) 142 CALL iom_rstput( kt, nitbkg_r, inum, 'ploss_avg' , ploss_avg ) 143 CALL iom_rstput( kt, nitbkg_r, inum, 'phyt_avg' , phyt_avg ) 144 CALL iom_rstput( kt, nitbkg_r, inum, 'mld_max' , mld_max ) 145 CALL iom_rstput( kt, nitbkg_r, inum, 'hadocc_nut' , trn(:,:,:,jp_had_nut) ) 146 CALL iom_rstput( kt, nitbkg_r, inum, 'hadocc_phy' , trn(:,:,:,jp_had_phy) ) 147 CALL iom_rstput( kt, nitbkg_r, inum, 'hadocc_zoo' , trn(:,:,:,jp_had_zoo) ) 148 CALL iom_rstput( kt, nitbkg_r, inum, 'hadocc_pdn' , trn(:,:,:,jp_had_pdn) ) 149 CALL iom_rstput( kt, nitbkg_r, inum, 'hadocc_dic' , trn(:,:,:,jp_had_dic) ) 150 CALL iom_rstput( kt, nitbkg_r, inum, 'hadocc_alk' , trn(:,:,:,jp_had_alk) ) 151 CALL iom_rstput( kt, nitbkg_r, inum, 'hadocc_chl' , HADOCC_CHL(:,:,1) ) 152 CALL iom_rstput( kt, nitbkg_r, inum, 'hadocc_cchl' , cchl_p(:,:,1) ) 153 153 #elif defined key_medusa && defined key_foam_medusa 154 CALL iom_rstput( kt, nitbkg_r, inum, 'pgrow_avg' , pgrow_avg ) 155 CALL iom_rstput( kt, nitbkg_r, inum, 'ploss_avg' , ploss_avg ) 156 CALL iom_rstput( kt, nitbkg_r, inum, 'phyt_avg' , phyt_avg ) 157 CALL iom_rstput( kt, nitbkg_r, inum, 'mld_max' , mld_max ) 158 CALL iom_rstput( kt, nitbkg_r, inum, 'nutrients' , trn(:,:,:,jpdin) ) 159 CALL iom_rstput( kt, nitbkg_r, inum, 'phytoplankton' , trn(:,:,:,jpphn) + trn(:,:,:,jpphd) ) 160 CALL iom_rstput( kt, nitbkg_r, inum, 'zooplankton' , trn(:,:,:,jpzmi) + trn(:,:,:,jpzme) ) 161 CALL iom_rstput( kt, nitbkg_r, inum, 'detritus' , trn(:,:,:,jpdet) ) 162 CALL iom_rstput( kt, nitbkg_r, inum, 'dic' , trn(:,:,:,jpdic) ) 163 CALL iom_rstput( kt, nitbkg_r, inum, 'alkalinity' , trn(:,:,:,jpalk) ) 164 CALL iom_rstput( kt, nitbkg_r, inum, 'chlorophyll' , trn(:,:,1,jpchn) + trn(:,:,1,jpchd) ) 154 CALL iom_rstput( kt, nitbkg_r, inum, 'pgrow_avg' , pgrow_avg ) 155 CALL iom_rstput( kt, nitbkg_r, inum, 'ploss_avg' , ploss_avg ) 156 CALL iom_rstput( kt, nitbkg_r, inum, 'phyt_avg' , phyt_avg ) 157 CALL iom_rstput( kt, nitbkg_r, inum, 'mld_max' , mld_max ) 158 CALL iom_rstput( kt, nitbkg_r, inum, 'medusa_chn' , trn(:,:,:,jpchn) ) 159 CALL iom_rstput( kt, nitbkg_r, inum, 'medusa_chd' , trn(:,:,:,jpchd) ) 160 CALL iom_rstput( kt, nitbkg_r, inum, 'medusa_phn' , trn(:,:,:,jpphn) ) 161 CALL iom_rstput( kt, nitbkg_r, inum, 'medusa_phd' , trn(:,:,:,jpphd) ) 162 CALL iom_rstput( kt, nitbkg_r, inum, 'medusa_pds' , trn(:,:,:,jppds) ) 163 CALL iom_rstput( kt, nitbkg_r, inum, 'medusa_zmi' , trn(:,:,:,jpzmi) ) 164 CALL iom_rstput( kt, nitbkg_r, inum, 'medusa_zme' , trn(:,:,:,jpzme) ) 165 CALL iom_rstput( kt, nitbkg_r, inum, 'medusa_din' , trn(:,:,:,jpdin) ) 166 CALL iom_rstput( kt, nitbkg_r, inum, 'medusa_sil' , trn(:,:,:,jpsil) ) 167 CALL iom_rstput( kt, nitbkg_r, inum, 'medusa_fer' , trn(:,:,:,jpfer) ) 168 CALL iom_rstput( kt, nitbkg_r, inum, 'medusa_det' , trn(:,:,:,jpdet) ) 169 CALL iom_rstput( kt, nitbkg_r, inum, 'medusa_dtc' , trn(:,:,:,jpdtc) ) 170 CALL iom_rstput( kt, nitbkg_r, inum, 'medusa_dic' , trn(:,:,:,jpdic) ) 171 CALL iom_rstput( kt, nitbkg_r, inum, 'medusa_alk' , trn(:,:,:,jpalk) ) 172 CALL iom_rstput( kt, nitbkg_r, inum, 'medusa_oxy' , trn(:,:,:,jpoxy) ) 165 173 #endif 166 174 ! -
branches/UKMO/dev_r5518_GO6_package_asm_surf_bgc/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
r8436 r8440 127 127 #endif 128 128 #if defined key_hadocc || (defined key_medusa && defined key_foam_medusa) 129 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pgrow_avg_bkg !: Background phyto growth for logchl balancing 130 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ploss_avg_bkg !: Background phyto loss for logchl balancing 131 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: phyt_avg_bkg !: Background phyto for logchl balancing 132 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: mld_max_bkg !: Background max MLD for logchl balancing 129 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pgrow_avg_bkg !: Background phyto growth for logchl balancing 130 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ploss_avg_bkg !: Background phyto loss for logchl balancing 131 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: phyt_avg_bkg !: Background phyto for logchl balancing 132 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: mld_max_bkg !: Background max MLD for logchl balancing 133 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tracer_bkg !: Background tracer state variables 134 #endif 135 #if defined key_hadocc 136 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: chl_bkg !: Background surface chlorophyll 137 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: cchl_p_bkg !: Background surface carbon:chlorophyll 133 138 #endif 134 139 REAL(wp) :: rn_maxchlinc = -999.0 !: maximum absolute non-log chlorophyll increment from logchl assimilation … … 630 635 IF ( ln_logchlinc ) THEN 631 636 632 ALLOCATE( pgrow_avg_bkg(jpi,jpj) ) 633 ALLOCATE( ploss_avg_bkg(jpi,jpj) ) 634 ALLOCATE( phyt_avg_bkg(jpi,jpj) ) 635 ALLOCATE( mld_max_bkg(jpi,jpj) ) 636 pgrow_avg_bkg(:,:) = 0.0 637 ploss_avg_bkg(:,:) = 0.0 638 phyt_avg_bkg(:,:) = 0.0 639 mld_max_bkg(:,:) = 0.0 637 ALLOCATE( pgrow_avg_bkg(jpi,jpj) ) 638 ALLOCATE( ploss_avg_bkg(jpi,jpj) ) 639 ALLOCATE( phyt_avg_bkg(jpi,jpj) ) 640 ALLOCATE( mld_max_bkg(jpi,jpj) ) 641 ALLOCATE( tracer_bkg(jpi,jpj,jpk,jptra) ) 642 pgrow_avg_bkg(:,:) = 0.0 643 ploss_avg_bkg(:,:) = 0.0 644 phyt_avg_bkg(:,:) = 0.0 645 mld_max_bkg(:,:) = 0.0 646 tracer_bkg(:,:,:,:) = 0.0 647 648 #if defined key_hadocc 649 ALLOCATE( chl_bkg(jpi,jpj) ) 650 ALLOCATE( cchl_p_bkg(jpi,jpj) ) 651 chl_bkg(:,:) = 0.0 652 cchl_p_bkg(:,:) = 0.0 653 #endif 654 655 !-------------------------------------------------------------------- 656 ! Read background variables for logchl assimilation 657 ! Some only required if performing balancing 658 !-------------------------------------------------------------------- 659 660 CALL iom_open( c_asmbkg, inum ) 661 662 #if defined key_hadocc 663 CALL iom_get( inum, jpdom_autoglo, 'hadocc_chl', chl_bkg ) 664 CALL iom_get( inum, jpdom_autoglo, 'hadocc_cchl', cchl_p_bkg ) 665 chl_bkg(:,:) = chl_bkg(:,:) * tmask(:,:,1) 666 cchl_p_bkg(:,:) = cchl_p_bkg(:,:) * tmask(:,:,1) 667 #elif defined key_medusa 668 CALL iom_get( inum, jpdom_autoglo, 'medusa_chn', tracer_bkg(:,:,:,jpchn) ) 669 CALL iom_get( inum, jpdom_autoglo, 'medusa_chd', tracer_bkg(:,:,:,jpchd) ) 670 #endif 640 671 641 672 IF ( ln_logchlbal ) THEN 642 643 !--------------------------------------------------------------------644 ! Read background variables for logchl balancing645 !--------------------------------------------------------------------646 647 CALL iom_open( c_asmbkg, inum )648 673 649 674 CALL iom_get( inum, jpdom_autoglo, 'pgrow_avg', pgrow_avg_bkg ) … … 656 681 mld_max_bkg(:,:) = mld_max_bkg(:,:) * tmask(:,:,1) 657 682 658 CALL iom_close( inum ) 683 #if defined key_hadocc 684 CALL iom_get( inum, jpdom_autoglo, 'hadocc_nut', tracer_bkg(:,:,:,jp_had_nut) ) 685 CALL iom_get( inum, jpdom_autoglo, 'hadocc_phy', tracer_bkg(:,:,:,jp_had_phy) ) 686 CALL iom_get( inum, jpdom_autoglo, 'hadocc_zoo', tracer_bkg(:,:,:,jp_had_zoo) ) 687 CALL iom_get( inum, jpdom_autoglo, 'hadocc_pdn', tracer_bkg(:,:,:,jp_had_pdn) ) 688 CALL iom_get( inum, jpdom_autoglo, 'hadocc_dic', tracer_bkg(:,:,:,jp_had_dic) ) 689 CALL iom_get( inum, jpdom_autoglo, 'hadocc_alk', tracer_bkg(:,:,:,jp_had_alk) ) 690 #elif defined key_medusa 691 CALL iom_get( inum, jpdom_autoglo, 'medusa_phn', tracer_bkg(:,:,:,jpphn) ) 692 CALL iom_get( inum, jpdom_autoglo, 'medusa_phd', tracer_bkg(:,:,:,jpphd) ) 693 CALL iom_get( inum, jpdom_autoglo, 'medusa_pds', tracer_bkg(:,:,:,jppds) ) 694 CALL iom_get( inum, jpdom_autoglo, 'medusa_zmi', tracer_bkg(:,:,:,jpzmi) ) 695 CALL iom_get( inum, jpdom_autoglo, 'medusa_zme', tracer_bkg(:,:,:,jpzme) ) 696 CALL iom_get( inum, jpdom_autoglo, 'medusa_din', tracer_bkg(:,:,:,jpdin) ) 697 CALL iom_get( inum, jpdom_autoglo, 'medusa_sil', tracer_bkg(:,:,:,jpsil) ) 698 CALL iom_get( inum, jpdom_autoglo, 'medusa_fer', tracer_bkg(:,:,:,jpfer) ) 699 CALL iom_get( inum, jpdom_autoglo, 'medusa_det', tracer_bkg(:,:,:,jpdet) ) 700 CALL iom_get( inum, jpdom_autoglo, 'medusa_dtc', tracer_bkg(:,:,:,jpdtc) ) 701 CALL iom_get( inum, jpdom_autoglo, 'medusa_dic', tracer_bkg(:,:,:,jpdic) ) 702 CALL iom_get( inum, jpdom_autoglo, 'medusa_alk', tracer_bkg(:,:,:,jpalk) ) 703 CALL iom_get( inum, jpdom_autoglo, 'medusa_oxy', tracer_bkg(:,:,:,jpoxy) ) 704 #endif 705 ENDIF 706 707 CALL iom_close( inum ) 659 708 660 ENDIF 709 DO jt = 1, jptra 710 tracer_bkg(:,:,:,jt) = tracer_bkg(:,:,:,jt) * tmask(:,:,:) 711 END DO 661 712 662 713 ENDIF … … 1312 1363 & pgrow_avg_bkg, ploss_avg_bkg, & 1313 1364 & phyt_avg_bkg, mld_max_bkg, & 1314 & logchl_balinc )1365 & tracer_bkg, logchl_balinc ) 1315 1366 #elif defined key_hadocc 1316 1367 CALL asm_logchl_bal_hadocc( logchl_bkginc, zincper, mld_choice_bgc, & … … 1318 1369 & pgrow_avg_bkg, ploss_avg_bkg, & 1319 1370 & phyt_avg_bkg, mld_max_bkg, & 1320 & logchl_balinc ) 1371 & chl_bkg, cchl_p_bkg, & 1372 & tracer_bkg, logchl_balinc ) 1321 1373 #else 1322 1374 CALL ctl_stop( 'Attempting to assimilate logchl, ', & -
branches/UKMO/dev_r5518_GO6_package_asm_surf_bgc/NEMOGCM/NEMO/OPA_SRC/ASM/asmlogchlbal_hadocc.F90
r8436 r8440 24 24 USE zdfmxl ! mixed layer depth 25 25 USE iom ! i/o 26 USE trc, ONLY: trn, trb, & ! HadOCC variables27 & HADOCC_CHL28 26 USE par_hadocc ! HadOCC parameters 29 27 USE had_bgc_stnd, ONLY: kmt ! HadOCC parameters … … 74 72 & pgrow_avg_bkg, ploss_avg_bkg, & 75 73 & phyt_avg_bkg, mld_max_bkg, & 76 & logchl_balinc ) 74 & chl_bkg, cchl_p_bkg, & 75 & tracer_bkg, logchl_balinc ) 77 76 !!--------------------------------------------------------------------------- 78 77 !! *** ROUTINE asm_logchl_bal_hadocc *** … … 98 97 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: phyt_avg_bkg ! Avg phyto 99 98 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: mld_max_bkg ! Max MLD 99 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: chl_bkg ! Surface chlorophyll 100 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: cchl_p_bkg ! Surface C:Chl 101 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj,jpk,jptra) :: tracer_bkg ! State variables 100 102 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk,jptra) :: logchl_balinc ! Balancing increments 101 103 !! … … 122 124 DO jj = 1, jpj 123 125 DO ji = 1, jpi 124 IF ( HADOCC_CHL(ji,jj,1) > 0.0 ) THEN125 chl_inc(ji,jj) = 10**( LOG10( HADOCC_CHL(ji,jj,1) ) + logchl_bkginc(ji,jj) ) - HADOCC_CHL(ji,jj,1)126 IF ( chl_bkg(ji,jj) > 0.0 ) THEN 127 chl_inc(ji,jj) = 10**( LOG10( chl_bkg(ji,jj) ) + logchl_bkginc(ji,jj) ) - chl_bkg(ji,jj) 126 128 IF ( k_maxchlinc > 0.0 ) THEN 127 129 chl_inc(ji,jj) = MAX( -1.0 * k_maxchlinc, MIN( chl_inc(ji,jj), k_maxchlinc ) ) … … 210 212 211 213 ! Set background state 212 bstate(:,:,:,i_tracer(1)) = tr b(:,:,:,jp_had_nut)213 bstate(:,:,:,i_tracer(2)) = tr b(:,:,:,jp_had_phy)214 bstate(:,:,:,i_tracer(3)) = tr b(:,:,:,jp_had_zoo)215 bstate(:,:,:,i_tracer(4)) = tr b(:,:,:,jp_had_pdn)216 bstate(:,:,:,i_tracer(5)) = tr b(:,:,:,jp_had_dic)217 bstate(:,:,:,i_tracer(6)) = tr b(:,:,:,jp_had_alk)214 bstate(:,:,:,i_tracer(1)) = tracer_bkg(:,:,:,jp_had_nut) 215 bstate(:,:,:,i_tracer(2)) = tracer_bkg(:,:,:,jp_had_phy) 216 bstate(:,:,:,i_tracer(3)) = tracer_bkg(:,:,:,jp_had_zoo) 217 bstate(:,:,:,i_tracer(4)) = tracer_bkg(:,:,:,jp_had_pdn) 218 bstate(:,:,:,i_tracer(5)) = tracer_bkg(:,:,:,jp_had_dic) 219 bstate(:,:,:,i_tracer(6)) = tracer_bkg(:,:,:,jp_had_alk) 218 220 219 221 ! Call nitrogen balancing routine 220 CALL bio_analysis( jpi, jpj, jpk, ZDZ(:,:,:), i_tracer, modparm, &221 & n2be_p, n2be_z, n2be_d, assimparm, &222 & INT(aincper), 1, kmt(:,:), tmask(:,:,:), &223 & zmld(:,:), mld_max_bkg(:,:), chl_inc(:,:), cchl_p (:,:,1), &224 & nbal_active, phyt_avg_bkg(:,:), &225 & gl_active, pgrow_avg_bkg(:,:), ploss_avg_bkg(:,:), &226 & subsurf_active, deepneg_active, &227 & deeppos_active, nutprof_active, &228 & bstate, outincs, &229 & diag_active, diag, &222 CALL bio_analysis( jpi, jpj, jpk, ZDZ(:,:,:), i_tracer, modparm, & 223 & n2be_p, n2be_z, n2be_d, assimparm, & 224 & INT(aincper), 1, kmt(:,:), tmask(:,:,:), & 225 & zmld(:,:), mld_max_bkg(:,:), chl_inc(:,:), cchl_p_bkg(:,:), & 226 & nbal_active, phyt_avg_bkg(:,:), & 227 & gl_active, pgrow_avg_bkg(:,:), ploss_avg_bkg(:,:), & 228 & subsurf_active, deepneg_active, & 229 & deeppos_active, nutprof_active, & 230 & bstate, outincs, & 231 & diag_active, diag, & 230 232 & diag_fulldepth_active, diag_fulldepth ) 231 233 … … 244 246 245 247 ! Convert surface chlorophyll increment to phytoplankton nitrogen 246 logchl_balinc(:,:,1,jp_had_phy) = ( cchl_p (:,:,1) / (mw_carbon * c2n_p) ) * chl_inc(:,:)248 logchl_balinc(:,:,1,jp_had_phy) = ( cchl_p_bkg(:,:) / (mw_carbon * c2n_p) ) * chl_inc(:,:) 247 249 248 250 ! Propagate through mixed layer … … 283 285 CONTAINS 284 286 SUBROUTINE asm_logchl_bal_hadocc( logchl_bkginc, aincper, mld_choice_bgc, & 285 & k_maxchlinc, logchl_balinc ) 287 & k_maxchlinc, ld_logchlbal, & 288 & pgrow_avg_bkg, ploss_avg_bkg, & 289 & phyt_avg_bkg, mld_max_bkg, & 290 & chl_bkg, cchl_p_bkg, & 291 & tracer_bkg, logchl_balinc ) 286 292 REAL :: logchl_bkginc(:,:) 287 293 REAL :: aincper 288 294 INTEGER :: mld_choice_bgc 289 295 REAL :: k_maxchlinc 290 REAL( :: logchl_balinc(:,:,:,:) 296 LOGICAL :: ld_logchlbal 297 REAL :: pgrow_avg_bkg(:,:) 298 REAL :: ploss_avg_bkg(:,:) 299 REAL :: phyt_avg_bkg(:,:) 300 REAL :: mld_max_bkg(:,:) 301 REAL :: chl_bkg(:,:) 302 REAL :: cchl_p_bkg(:,:) 303 REAL :: tracer_bkg(:,:,:,:) 304 REAL :: logchl_balinc(:,:,:,:) 291 305 WRITE(*,*) 'asm_logchl_bal_hadocc: You should not have seen this print! error?' 292 306 END SUBROUTINE asm_logchl_bal_hadocc -
branches/UKMO/dev_r5518_GO6_package_asm_surf_bgc/NEMOGCM/NEMO/OPA_SRC/ASM/asmlogchlbal_medusa.F90
r8436 r8440 25 25 USE zdfmxl ! mixed layer depth 26 26 USE iom ! i/o 27 USE trc, ONLY: trn, trb ! MEDUSA variables28 27 USE sms_medusa ! MEDUSA parameters 29 28 USE par_medusa ! MEDUSA parameters … … 73 72 & pgrow_avg_bkg, ploss_avg_bkg, & 74 73 & phyt_avg_bkg, mld_max_bkg, & 75 & logchl_balinc )74 & tracer_bkg, logchl_balinc ) 76 75 !!--------------------------------------------------------------------------- 77 76 !! *** ROUTINE asm_logchl_bal_medusa *** … … 99 98 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: phyt_avg_bkg ! Avg phyto 100 99 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: mld_max_bkg ! Max MLD 100 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj,jpk,jptra) :: tracer_bkg ! State variables 101 101 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk,jptra) :: logchl_balinc ! Balancing increments 102 102 !! … … 136 136 ! 3) Subtract background from analysis to get chl incs 137 137 ! If k_maxchlinc > 0 then cap total absolute chlorophyll increment at that value 138 medusa_chl(:,:) = tr b(:,:,1,jpchn) + trb(:,:,1,jpchd)138 medusa_chl(:,:) = tracer_bkg(:,:,1,jpchn) + tracer_bkg(:,:,1,jpchd) 139 139 DO jj = 1, jpj 140 140 DO ji = 1, jpi … … 233 233 234 234 ! Set background state 235 bstate(:,:,:,i_tracer(1)) = tr b(:,:,:,jpdin)236 bstate(:,:,:,i_tracer(2)) = tr b(:,:,:,jpphn) + trb(:,:,:,jpphd)237 bstate(:,:,:,i_tracer(3)) = tr b(:,:,:,jpzmi) + trb(:,:,:,jpzme)238 bstate(:,:,:,i_tracer(4)) = tr b(:,:,:,jpdet)239 bstate(:,:,:,i_tracer(5)) = tr b(:,:,:,jpdic)240 bstate(:,:,:,i_tracer(6)) = tr b(:,:,:,jpalk)235 bstate(:,:,:,i_tracer(1)) = tracer_bkg(:,:,:,jpdin) 236 bstate(:,:,:,i_tracer(2)) = tracer_bkg(:,:,:,jpphn) + tracer_bkg(:,:,:,jpphd) 237 bstate(:,:,:,i_tracer(3)) = tracer_bkg(:,:,:,jpzmi) + tracer_bkg(:,:,:,jpzme) 238 bstate(:,:,:,i_tracer(4)) = tracer_bkg(:,:,:,jpdet) 239 bstate(:,:,:,i_tracer(5)) = tracer_bkg(:,:,:,jpdic) 240 bstate(:,:,:,i_tracer(6)) = tracer_bkg(:,:,:,jpalk) 241 241 242 242 ! Calculate carbon to chlorophyll ratio for combined phytoplankton 243 243 ! and nitrogen to biomass equivalent for PZD 244 244 ! Hardwire nitrogen mass to 14.01 for now as it doesn't seem to be set in MEDUSA 245 !cchl_p(:,:) = ( trb(:,:,1,jpchn) + trb(:,:,1,jpchd ) ) / &246 ! & ( ( trb(:,:,1,jpphn) * xthetapn ) + ( trb(:,:,1,jpphd) * xthetapd ) )247 245 cchl_p(:,:) = 0.0 248 246 DO jj = 1, jpj 249 247 DO ji = 1, jpi 250 IF ( ( tr b(ji,jj,1,jpchn) + trb(ji,jj,1,jpchd ) ) .GT. 0.0 ) THEN251 cchl_p(ji,jj) = ( ( tr b(ji,jj,1,jpphn) * xthetapn ) + ( trb(ji,jj,1,jpphd) * xthetapd ) ) / &252 & ( tr b(ji,jj,1,jpchn) + trb(ji,jj,1,jpchd ) )248 IF ( ( tracer_bkg(ji,jj,1,jpchn) + tracer_bkg(ji,jj,1,jpchd ) ) .GT. 0.0 ) THEN 249 cchl_p(ji,jj) = ( ( tracer_bkg(ji,jj,1,jpphn) * xthetapn ) + ( tracer_bkg(ji,jj,1,jpphd) * xthetapd ) ) / & 250 & ( tracer_bkg(ji,jj,1,jpchn) + tracer_bkg(ji,jj,1,jpchd ) ) 253 251 ENDIF 254 252 END DO … … 257 255 n2be_z = 14.01 + ( xmassc * ( ( xthetazmi + xthetazme ) / 2.0 ) ) 258 256 n2be_d = 14.01 + ( xmassc * xthetad ) 259 260 WRITE(numout,*) 'DAF: nproc, min/max cchl_p, min/max chl_inc = ', nproc, MINVAL(cchl_p), MAXVAL(cchl_p), MINVAL(chl_inc), MAXVAL(chl_inc)261 257 262 258 ! Call nitrogen balancing routine … … 273 269 & diag_fulldepth_active, diag_fulldepth ) 274 270 275 WRITE(numout,*) 'DAF: nproc, min/max outincs(phy)1,20 = ', nproc, MINVAL(outincs(:,:,1,i_tracer(2))), MAXVAL(outincs(:,:,1,i_tracer(2))), MINVAL(outincs(:,:,20,i_tracer(2))), MAXVAL(outincs(:,:,20,i_tracer(2)))276 277 271 ! Loop over each grid point partioning the increments 278 272 logchl_balinc(:,:,:,:) = 0.0 … … 281 275 DO ji = 1, jpi 282 276 283 IF ( ( tr b(ji,jj,jk,jpphn) > 0.0 ) .AND. ( trb(ji,jj,jk,jpphd) > 0.0 ) ) THEN277 IF ( ( tracer_bkg(ji,jj,jk,jpphn) > 0.0 ) .AND. ( tracer_bkg(ji,jj,jk,jpphd) > 0.0 ) ) THEN 284 278 ! Phytoplankton nitrogen and silicate split up based on existing ratios 285 zfrac_phn = tr b(ji,jj,jk,jpphn) / (trb(ji,jj,jk,jpphn) + trb(ji,jj,jk,jpphd))279 zfrac_phn = tracer_bkg(ji,jj,jk,jpphn) / (tracer_bkg(ji,jj,jk,jpphn) + tracer_bkg(ji,jj,jk,jpphd)) 286 280 zfrac_phd = 1.0 - zfrac_phn 287 zrat_pds_phd = tr b(ji,jj,jk,jppds) / trb(ji,jj,jk,jpphd)281 zrat_pds_phd = tracer_bkg(ji,jj,jk,jppds) / tracer_bkg(ji,jj,jk,jpphd) 288 282 logchl_balinc(ji,jj,jk,jpphn) = outincs(ji,jj,jk,i_tracer(2)) * zfrac_phn 289 283 logchl_balinc(ji,jj,jk,jpphd) = outincs(ji,jj,jk,i_tracer(2)) * zfrac_phd … … 293 287 ! Not using chl_inc directly as it's only 2D 294 288 ! This method should give same results at surface as splitting chl_inc would 295 zrat_chn_phn = tr b(ji,jj,jk,jpchn) / trb(ji,jj,jk,jpphn)296 zrat_chd_phd = tr b(ji,jj,jk,jpchd) / trb(ji,jj,jk,jpphd)289 zrat_chn_phn = tracer_bkg(ji,jj,jk,jpchn) / tracer_bkg(ji,jj,jk,jpphn) 290 zrat_chd_phd = tracer_bkg(ji,jj,jk,jpchd) / tracer_bkg(ji,jj,jk,jpphd) 297 291 logchl_balinc(ji,jj,jk,jpchn) = logchl_balinc(ji,jj,jk,jpphn) * zrat_chn_phn 298 292 logchl_balinc(ji,jj,jk,jpchd) = logchl_balinc(ji,jj,jk,jpphd) * zrat_chd_phd 299 293 ENDIF 300 294 301 IF ( ( tr b(ji,jj,jk,jpzmi) > 0.0 ) .AND. ( trb(ji,jj,jk,jpzme) > 0.0 ) ) THEN295 IF ( ( tracer_bkg(ji,jj,jk,jpzmi) > 0.0 ) .AND. ( tracer_bkg(ji,jj,jk,jpzme) > 0.0 ) ) THEN 302 296 ! Zooplankton nitrogen split up based on existing ratios 303 zfrac_zmi = tr b(ji,jj,jk,jpzmi) / (trb(ji,jj,jk,jpzmi) + trb(ji,jj,jk,jpzme))297 zfrac_zmi = tracer_bkg(ji,jj,jk,jpzmi) / (tracer_bkg(ji,jj,jk,jpzmi) + tracer_bkg(ji,jj,jk,jpzme)) 304 298 zfrac_zme = 1.0 - zfrac_zmi 305 299 logchl_balinc(ji,jj,jk,jpzmi) = outincs(ji,jj,jk,i_tracer(3)) * zfrac_zmi … … 320 314 321 315 ! Remove diatom silicate increment from nutrient silicate to conserve mass 322 IF ( ( tr b(ji,jj,jk,jpsil) - logchl_balinc(ji,jj,jk,jppds) ) > 0.0 ) THEN316 IF ( ( tracer_bkg(ji,jj,jk,jpsil) - logchl_balinc(ji,jj,jk,jppds) ) > 0.0 ) THEN 323 317 logchl_balinc(ji,jj,jk,jpsil) = logchl_balinc(ji,jj,jk,jppds) * (-1.0) 324 318 ENDIF 325 319 326 IF ( ( tr b(ji,jj,jk,jpdet) > 0.0 ) .AND. ( trb(ji,jj,jk,jpdtc) > 0.0 ) ) THEN320 IF ( ( tracer_bkg(ji,jj,jk,jpdet) > 0.0 ) .AND. ( tracer_bkg(ji,jj,jk,jpdtc) > 0.0 ) ) THEN 327 321 ! Carbon detritus based on existing ratios 328 zrat_dtc_det = tr b(ji,jj,jk,jpdtc) / trb(ji,jj,jk,jpdet)322 zrat_dtc_det = tracer_bkg(ji,jj,jk,jpdtc) / tracer_bkg(ji,jj,jk,jpdet) 329 323 logchl_balinc(ji,jj,jk,jpdtc) = logchl_balinc(ji,jj,jk,jpdet) * zrat_dtc_det 330 324 ENDIF … … 348 342 DO ji = 1, jpi 349 343 IF ( medusa_chl(ji,jj) > 0.0 ) THEN 350 zfrac_chn = tr b(ji,jj,1,jpchn) / medusa_chl(ji,jj)344 zfrac_chn = tracer_bkg(ji,jj,1,jpchn) / medusa_chl(ji,jj) 351 345 zfrac_chd = 1.0 - zfrac_chn 352 346 logchl_balinc(ji,jj,1,jpchn) = chl_inc(ji,jj) * zfrac_chn … … 402 396 CONTAINS 403 397 SUBROUTINE asm_logchl_bal_medusa( logchl_bkginc, aincper, mld_choice_bgc, & 404 & k_maxchlinc, logchl_balinc ) 398 & k_maxchlinc, ld_logchlbal, & 399 & pgrow_avg_bkg, ploss_avg_bkg, & 400 & phyt_avg_bkg, mld_max_bkg, & 401 & tracer_bkg, logchl_balinc ) 405 402 REAL :: logchl_bkginc(:,:) 406 403 REAL :: aincper 407 404 INTEGER :: mld_choice_bgc 408 405 REAL :: k_maxchlinc 409 REAL( :: logchl_balinc(:,:,:,:) 406 LOGICAL :: ld_logchlbal 407 REAL :: pgrow_avg_bkg(:,:) 408 REAL :: ploss_avg_bkg(:,:) 409 REAL :: phyt_avg_bkg(:,:) 410 REAL :: mld_max_bkg(:,:) 411 REAL :: tracer_bkg(:,:,:,:) 412 REAL :: logchl_balinc(:,:,:,:) 410 413 WRITE(*,*) 'asm_logchl_bal_medusa: You should not have seen this print! error?' 411 414 END SUBROUTINE asm_logchl_bal_medusa -
branches/UKMO/dev_r5518_GO6_package_asm_surf_bgc/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r8436 r8440 346 346 # endif 347 347 # endif 348 # if defined key_foam_medusa349 !! Fields for ocean colour assimilation on first timestep350 IF( iom_varid( numrtr, 'pgrow_avg', ldstop = .FALSE. ) > 0 ) THEN351 IF(lwp) WRITE(numout,*) ' MEDUSA pgrow_avg present - reading in ...'352 CALL iom_get( numrtr, jpdom_autoglo, 'pgrow_avg', pgrow_avg(:,:) )353 CALL iom_get( numrtr, jpdom_autoglo, 'ploss_avg', ploss_avg(:,:) )354 CALL iom_get( numrtr, jpdom_autoglo, 'phyt_avg', phyt_avg(:,:) )355 CALL iom_get( numrtr, jpdom_autoglo, 'mld_max', mld_max(:,:) )356 ELSE357 IF(lwp) WRITE(numout,*) ' MEDUSA pgrow_avg absent - setting to zero ...'358 pgrow_avg(:,:) = 0.0359 ploss_avg(:,:) = 0.0360 phyt_avg(:,:) = 0.0361 mld_max(:,:) = 0.0362 ENDIF363 # endif364 348 365 349 … … 530 514 call trc_rst_dia_stat( f2_ccd_arg(:,:),'CCD_ARG') 531 515 !! 532 # endif 533 # if defined key_foam_medusa 534 !! Fields for assimilation and observation operator on first timestep 535 IF(lwp) WRITE(numout,*) ' MEDUSA OBS/ASM fields - writing out ...' 536 # if defined key_roam 537 CALL iom_rstput( kt, nitrst, numrtw, 'PCO2W', f2_pco2w(:,:) ) 538 CALL iom_rstput( kt, nitrst, numrtw, 'FCO2W', f2_fco2w(:,:) ) 516 # if defined key_foam_medusa 517 !! Fields for observation operator on first timestep 518 IF(lwp) WRITE(numout,*) ' MEDUSA OBS fields - writing out ...' 519 CALL iom_rstput( kt, nitrst, numrtw, 'PCO2W', f2_pco2w(:,:) ) 520 CALL iom_rstput( kt, nitrst, numrtw, 'FCO2W', f2_fco2w(:,:) ) 539 521 # endif 540 CALL iom_rstput( kt, nitrst, numrtw, 'pgrow_avg', pgrow_avg(:,:) )541 CALL iom_rstput( kt, nitrst, numrtw, 'ploss_avg', ploss_avg(:,:) )542 CALL iom_rstput( kt, nitrst, numrtw, 'phyt_avg', phyt_avg(:,:) )543 CALL iom_rstput( kt, nitrst, numrtw, 'mld_max', mld_max(:,:) )544 522 # endif 545 523 !!
Note: See TracChangeset
for help on using the changeset viewer.
