- Timestamp:
- 2017-08-14T15:22:09+02:00 (7 years ago)
- Location:
- branches/UKMO/dev_r5518_GO6_package_asm_surf_bgc/NEMOGCM/NEMO
- Files:
-
- 6 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_package_asm_surf_bgc/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90
r8400 r8436 49 49 #if defined key_lim3 50 50 USE ice 51 #endif 52 #if defined key_hadocc 53 USE trc, ONLY: trn, & 54 & pgrow_avg, & 55 & ploss_avg, & 56 & phyt_avg, & 57 & mld_max, & 58 & HADOCC_CHL 59 USE had_bgc_const, ONLY: cchl_p 60 USE par_hadocc 61 #elif defined key_medusa && defined key_foam_medusa 62 USE trc, ONLY: trn 63 USE sms_medusa, ONLY: pgrow_avg, & 64 & ploss_avg, & 65 & phyt_avg, & 66 & mld_max 67 USE par_medusa 51 68 #endif 52 69 IMPLICIT NONE … … 121 138 ! CALL iom_rstput( kt, nitbkg_r, inum, 'gcx' , gcx ) 122 139 CALL iom_rstput( kt, nitbkg_r, inum, 'avt' , avt ) 140 #if defined key_hadocc 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, '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) ) 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) ) 165 #endif 123 166 ! 124 167 CALL iom_close( inum ) -
branches/UKMO/dev_r5518_GO6_package_asm_surf_bgc/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
r8428 r8436 126 126 REAL(wp), PUBLIC, DIMENSION(:,:,:,:), ALLOCATABLE :: logchl_balinc !: Increment to BGC variables from logchl assim 127 127 #endif 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 133 #endif 128 134 REAL(wp) :: rn_maxchlinc = -999.0 !: maximum absolute non-log chlorophyll increment from logchl assimilation 129 135 !: <= 0 implies no maximum applied (switch turned off) … … 620 626 621 627 ENDIF 628 629 #if defined key_hadocc || (defined key_medusa && defined key_foam_medusa) 630 IF ( ln_logchlinc ) THEN 631 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 640 641 IF ( ln_logchlbal ) THEN 642 643 !-------------------------------------------------------------------- 644 ! Read background variables for logchl balancing 645 !-------------------------------------------------------------------- 646 647 CALL iom_open( c_asmbkg, inum ) 648 649 CALL iom_get( inum, jpdom_autoglo, 'pgrow_avg', pgrow_avg_bkg ) 650 CALL iom_get( inum, jpdom_autoglo, 'ploss_avg', ploss_avg_bkg ) 651 CALL iom_get( inum, jpdom_autoglo, 'phyt_avg', phyt_avg_bkg ) 652 CALL iom_get( inum, jpdom_autoglo, 'mld_max', mld_max_bkg ) 653 pgrow_avg_bkg(:,:) = pgrow_avg_bkg(:,:) * tmask(:,:,1) 654 ploss_avg_bkg(:,:) = ploss_avg_bkg(:,:) * tmask(:,:,1) 655 phyt_avg_bkg(:,:) = phyt_avg_bkg(:,:) * tmask(:,:,1) 656 mld_max_bkg(:,:) = mld_max_bkg(:,:) * tmask(:,:,1) 657 658 CALL iom_close( inum ) 659 660 ENDIF 661 662 ENDIF 663 #endif 622 664 ! 623 665 END SUBROUTINE asm_inc_init … … 1266 1308 1267 1309 #if defined key_medusa && defined key_foam_medusa 1268 !CALL asm_logchl_bal_medusa() 1269 CALL ctl_stop( 'Attempting to assimilate logchl into MEDUSA, ', & 1270 & 'but not fully implemented yet' ) 1310 CALL asm_logchl_bal_medusa( logchl_bkginc, zincper, mld_choice_bgc, & 1311 & rn_maxchlinc, ln_logchlbal, & 1312 & pgrow_avg_bkg, ploss_avg_bkg, & 1313 & phyt_avg_bkg, mld_max_bkg, & 1314 & logchl_balinc ) 1271 1315 #elif defined key_hadocc 1272 1316 CALL asm_logchl_bal_hadocc( logchl_bkginc, zincper, mld_choice_bgc, & 1273 & rn_maxchlinc, ln_logchlbal, logchl_balinc ) 1317 & rn_maxchlinc, ln_logchlbal, & 1318 & pgrow_avg_bkg, ploss_avg_bkg, & 1319 & phyt_avg_bkg, mld_max_bkg, & 1320 & logchl_balinc ) 1274 1321 #else 1275 1322 CALL ctl_stop( 'Attempting to assimilate logchl, ', & -
branches/UKMO/dev_r5518_GO6_package_asm_surf_bgc/NEMOGCM/NEMO/OPA_SRC/ASM/asmlogchlbal_hadocc.F90
r8428 r8436 25 25 USE iom ! i/o 26 26 USE trc, ONLY: trn, trb, & ! HadOCC variables 27 & HADOCC_CHL, & 28 & pgrow_avg, & 29 & ploss_avg, & 30 & phyt_avg, & 31 & mld_max 27 & HADOCC_CHL 32 28 USE par_hadocc ! HadOCC parameters 33 29 USE had_bgc_stnd, ONLY: kmt ! HadOCC parameters … … 75 71 76 72 SUBROUTINE asm_logchl_bal_hadocc( logchl_bkginc, aincper, mld_choice_bgc, & 77 & k_maxchlinc, ld_logchlbal, logchl_balinc ) 73 & k_maxchlinc, ld_logchlbal, & 74 & pgrow_avg_bkg, ploss_avg_bkg, & 75 & phyt_avg_bkg, mld_max_bkg, & 76 & logchl_balinc ) 78 77 !!--------------------------------------------------------------------------- 79 78 !! *** ROUTINE asm_logchl_bal_hadocc *** … … 95 94 REAL(wp), INTENT(in ) :: k_maxchlinc ! Max chl increment 96 95 LOGICAL, INTENT(in ) :: ld_logchlbal ! Balancing y/n 96 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: pgrow_avg_bkg ! Avg phyto growth 97 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: ploss_avg_bkg ! Avg phyto loss 98 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: phyt_avg_bkg ! Avg phyto 99 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: mld_max_bkg ! Max MLD 97 100 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk,jptra) :: logchl_balinc ! Balancing increments 98 101 !! 99 INTEGER :: ji, jj, jk 102 INTEGER :: ji, jj, jk, jn ! Loop counters 100 103 INTEGER :: jkmax ! Loop index 101 104 INTEGER, DIMENSION(6) :: i_tracer ! Tracer indices … … 215 218 216 219 ! Call nitrogen balancing routine 217 CALL bio_analysis( jpi, jpj, jpk, ZDZ(:,:,:), i_tracer, modparm, &218 & n2be_p, n2be_z, n2be_d, assimparm, &219 & INT(aincper), 1, kmt(:,:), tmask(:,:,:), &220 & zmld(:,:), mld_max (:,:), chl_inc(:,:), cchl_p(:,:,1),&221 & nbal_active, phyt_avg (:,:),&222 & gl_active, pgrow_avg (:,:), ploss_avg(:,:),&223 & subsurf_active, deepneg_active, &224 & deeppos_active, nutprof_active, &225 & bstate, outincs, &226 & diag_active, diag, &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, & 227 230 & diag_fulldepth_active, diag_fulldepth ) 228 231 -
branches/UKMO/dev_r5518_GO6_package_asm_surf_bgc/NEMOGCM/NEMO/OPA_SRC/ASM/asmlogchlbal_medusa.F90
r8428 r8436 1 MODULE asmlogchlbal_ hadocc1 MODULE asmlogchlbal_medusa 2 2 !!====================================================================== 3 !! *** MODULE asmlogchlbal_ hadocc***4 !! Calculate increments to HadOCCbased on surface logchl increments3 !! *** MODULE asmlogchlbal_medusa *** 4 !! Calculate increments to MEDUSA based on surface logchl increments 5 5 !! 6 6 !! IMPORTANT NOTE: This calls the bioanalysis routine of Hemmings et al. … … 10 10 !! 11 11 !!====================================================================== 12 !! History : 3.6 ! 2017-08 (D. Ford) Adapted from bioanal.F9013 !!---------------------------------------------------------------------- 14 #if defined key_asminc && defined key_ hadocc12 !! History : 3.6 ! 2017-08 (D. Ford) Adapted from asmlogchlbal_hadocc 13 !!---------------------------------------------------------------------- 14 #if defined key_asminc && defined key_medusa && defined key_foam_medusa 15 15 !!---------------------------------------------------------------------- 16 16 !! 'key_asminc' : assimilation increment interface 17 !! 'key_hadocc' : HadOCC model 18 !!---------------------------------------------------------------------- 19 !! asm_logchl_bal_hadocc : routine to calculate increments to HadOCC 17 !! 'key_medusa' : MEDUSA model 18 !! 'key_foam_medusa' : MEDUSA extras for FOAM OBS and ASM 19 !!---------------------------------------------------------------------- 20 !! asm_logchl_bal_medusa : routine to calculate increments to MEDUSA 20 21 !!---------------------------------------------------------------------- 21 22 USE par_kind, ONLY: wp ! kind parameters … … 24 25 USE zdfmxl ! mixed layer depth 25 26 USE iom ! i/o 26 USE trc, ONLY: trn, trb, & ! HadOCC variables 27 & HADOCC_CHL, & 28 & pgrow_avg, & 29 & ploss_avg, & 30 & phyt_avg, & 31 & mld_max 32 USE par_hadocc ! HadOCC parameters 33 USE had_bgc_stnd, ONLY: kmt ! HadOCC parameters 34 USE had_bgc_const ! HadOCC parameters 27 USE trc, ONLY: trn, trb ! MEDUSA variables 28 USE sms_medusa ! MEDUSA parameters 29 USE par_medusa ! MEDUSA parameters 35 30 USE par_trc, ONLY: jptra ! Tracer parameters 36 31 USE bioanalysis ! Nitrogen balancing … … 39 34 PRIVATE 40 35 41 PUBLIC asm_logchl_bal_ hadocc36 PUBLIC asm_logchl_bal_medusa 42 37 43 38 ! Default values for biological assimilation parameters … … 74 69 CONTAINS 75 70 76 SUBROUTINE asm_logchl_bal_hadocc( logchl_bkginc, aincper, mld_choice_bgc, & 77 & k_maxchlinc, ld_logchlbal, logchl_balinc ) 71 SUBROUTINE asm_logchl_bal_medusa( logchl_bkginc, aincper, mld_choice_bgc, & 72 & k_maxchlinc, ld_logchlbal, & 73 & pgrow_avg_bkg, ploss_avg_bkg, & 74 & phyt_avg_bkg, mld_max_bkg, & 75 & logchl_balinc ) 78 76 !!--------------------------------------------------------------------------- 79 !! *** ROUTINE asm_logchl_bal_ hadocc***80 !! 81 !! ** Purpose : calculate increments to HadOCCfrom logchl increments77 !! *** ROUTINE asm_logchl_bal_medusa *** 78 !! 79 !! ** Purpose : calculate increments to MEDUSA from logchl increments 82 80 !! 83 81 !! ** Method : convert logchl increments to chl increments 82 !! average up MEDUSA to look like HadOCC 84 83 !! call nitrogen balancing scheme 84 !! separate back out to MEDUSA 85 85 !! 86 86 !! ** Action : populate logchl_balinc … … 95 95 REAL(wp), INTENT(in ) :: k_maxchlinc ! Max chl increment 96 96 LOGICAL, INTENT(in ) :: ld_logchlbal ! Balancing y/n 97 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: pgrow_avg_bkg ! Avg phyto growth 98 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: ploss_avg_bkg ! Avg phyto loss 99 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: phyt_avg_bkg ! Avg phyto 100 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: mld_max_bkg ! Max MLD 97 101 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk,jptra) :: logchl_balinc ! Balancing increments 98 102 !! 99 INTEGER :: ji, jj, jk 103 INTEGER :: ji, jj, jk, jn ! Loop counters 100 104 INTEGER :: jkmax ! Loop index 101 105 INTEGER, DIMENSION(6) :: i_tracer ! Tracer indices 106 REAL(wp) :: n2be_p ! N:biomass for total phy 107 REAL(wp) :: n2be_z ! N:biomass for total zoo 108 REAL(wp) :: n2be_d ! N:biomass for detritus 109 REAL(wp) :: zfrac_chn ! Fraction of jpchn 110 REAL(wp) :: zfrac_chd ! Fraction of jpchd 111 REAL(wp) :: zfrac_phn ! Fraction of jpphn 112 REAL(wp) :: zfrac_phd ! Fraction of jpphd 113 REAL(wp) :: zfrac_zmi ! Fraction of jpzmi 114 REAL(wp) :: zfrac_zme ! Fraction of jpzme 115 REAL(wp) :: zrat_pds_phd ! Ratio of jppds:jpphd 116 REAL(wp) :: zrat_chd_phd ! Ratio of jpchd:jpphd 117 REAL(wp) :: zrat_chn_phn ! Ratio of jpchn:jpphn 118 REAL(wp) :: zrat_dtc_det ! Ratio of jpdtc:jpdet 102 119 REAL(wp), DIMENSION(jpi,jpj) :: chl_inc ! Chlorophyll increments 120 REAL(wp), DIMENSION(jpi,jpj) :: medusa_chl ! MEDUSA total chlorophyll 121 REAL(wp), DIMENSION(jpi,jpj) :: cchl_p ! C:Chl for total phy 103 122 REAL(wp), DIMENSION(jpi,jpj) :: zmld ! Mixed layer depth 104 123 REAL(wp), DIMENSION(16) :: modparm ! Model parameters … … 117 136 ! 3) Subtract background from analysis to get chl incs 118 137 ! If k_maxchlinc > 0 then cap total absolute chlorophyll increment at that value 138 medusa_chl(:,:) = trb(:,:,1,jpchn) + trb(:,:,1,jpchd) 119 139 DO jj = 1, jpj 120 140 DO ji = 1, jpi 121 IF ( HADOCC_CHL(ji,jj,1) > 0.0 ) THEN122 chl_inc(ji,jj) = 10**( LOG10( HADOCC_CHL(ji,jj,1) ) + logchl_bkginc(ji,jj) ) - HADOCC_CHL(ji,jj,1)141 IF ( medusa_chl(ji,jj) > 0.0 ) THEN 142 chl_inc(ji,jj) = 10**( LOG10( medusa_chl(ji,jj) ) + logchl_bkginc(ji,jj) ) - medusa_chl(ji,jj) 123 143 IF ( k_maxchlinc > 0.0 ) THEN 124 144 chl_inc(ji,jj) = MAX( -1.0 * k_maxchlinc, MIN( chl_inc(ji,jj), k_maxchlinc ) ) … … 158 178 IF ( ld_logchlbal ) THEN ! Nitrogen balancing 159 179 160 ! Set up model parameters to be passed into Hemmings balancing routine 161 modparm(1) = grow_sat 162 modparm(2) = psmax 163 modparm(3) = par 164 modparm(4) = alpha 165 modparm(5) = resp_rate 166 modparm(6) = pmort_rate 167 modparm(7) = phyto_min 168 modparm(8) = z_mort_1 169 modparm(9) = z_mort_2 170 modparm(10) = c2n_p 171 modparm(11) = c2n_z 172 modparm(12) = c2n_d 173 modparm(13) = graze_threshold 174 modparm(14) = holling_coef 175 modparm(15) = graze_sat 176 modparm(16) = graze_max 180 ! Set up model parameters to be passed into Hemmings balancing routine. 181 ! For now these are hardwired to the standard HadOCC parameter values 182 ! (except C:N ratios) as this is what the scheme was developed for. 183 ! Obviously, HadOCC and MEDUSA are rather different models, so this 184 ! isn't ideal, but there's not always direct analogues between the two 185 ! parameter sets, so it's the easiest way to get something running. 186 ! In the longer term, some serious MarMOT-based development is required. 187 modparm(1) = 0.1 ! grow_sat 188 modparm(2) = 2.0 ! psmax 189 modparm(3) = 0.845 ! par 190 modparm(4) = 0.02 ! alpha 191 modparm(5) = 0.05 ! resp_rate 192 modparm(6) = 0.05 ! pmort_rate 193 modparm(7) = 0.01 ! phyto_min 194 modparm(8) = 0.05 ! z_mort_1 195 modparm(9) = 1.0 ! z_mort_2 196 modparm(10) = ( xthetapn + xthetapd ) / 2.0 ! c2n_p 197 modparm(11) = ( xthetazmi + xthetazme ) / 2.0 ! c2n_z 198 modparm(12) = xthetad ! c2n_d 199 modparm(13) = 0.01 ! graze_threshold 200 modparm(14) = 2.0 ! holling_coef 201 modparm(15) = 0.5 ! graze_sat 202 modparm(16) = 2.0 ! graze_max 177 203 178 204 ! Set up assimilation parameters to be passed into balancing routine … … 207 233 208 234 ! Set background state 209 bstate(:,:,:,i_tracer(1)) = trb(:,:,:,jp_had_nut) 210 bstate(:,:,:,i_tracer(2)) = trb(:,:,:,jp_had_phy) 211 bstate(:,:,:,i_tracer(3)) = trb(:,:,:,jp_had_zoo) 212 bstate(:,:,:,i_tracer(4)) = trb(:,:,:,jp_had_pdn) 213 bstate(:,:,:,i_tracer(5)) = trb(:,:,:,jp_had_dic) 214 bstate(:,:,:,i_tracer(6)) = trb(:,:,:,jp_had_alk) 235 bstate(:,:,:,i_tracer(1)) = trb(:,:,:,jpdin) 236 bstate(:,:,:,i_tracer(2)) = trb(:,:,:,jpphn) + trb(:,:,:,jpphd) 237 bstate(:,:,:,i_tracer(3)) = trb(:,:,:,jpzmi) + trb(:,:,:,jpzme) 238 bstate(:,:,:,i_tracer(4)) = trb(:,:,:,jpdet) 239 bstate(:,:,:,i_tracer(5)) = trb(:,:,:,jpdic) 240 bstate(:,:,:,i_tracer(6)) = trb(:,:,:,jpalk) 241 242 ! Calculate carbon to chlorophyll ratio for combined phytoplankton 243 ! and nitrogen to biomass equivalent for PZD 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 cchl_p(:,:) = 0.0 248 DO jj = 1, jpj 249 DO ji = 1, jpi 250 IF ( ( trb(ji,jj,1,jpchn) + trb(ji,jj,1,jpchd ) ) .GT. 0.0 ) THEN 251 cchl_p(ji,jj) = ( ( trb(ji,jj,1,jpphn) * xthetapn ) + ( trb(ji,jj,1,jpphd) * xthetapd ) ) / & 252 & ( trb(ji,jj,1,jpchn) + trb(ji,jj,1,jpchd ) ) 253 ENDIF 254 END DO 255 END DO 256 n2be_p = 14.01 + ( xmassc * ( ( xthetapn + xthetapd ) / 2.0 ) ) 257 n2be_z = 14.01 + ( xmassc * ( ( xthetazmi + xthetazme ) / 2.0 ) ) 258 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) 215 261 216 262 ! Call nitrogen balancing routine 217 CALL bio_analysis( jpi, jpj, jpk, ZDZ(:,:,:), i_tracer, modparm,&218 & n2be_p, n2be_z, n2be_d, assimparm, &219 & INT(aincper), 1, kmt(:,:), tmask(:,:,:),&220 & zmld(:,:), mld_max (:,:), chl_inc(:,:), cchl_p(:,:,1),&221 & nbal_active, phyt_avg (:,:),&222 & gl_active, pgrow_avg (:,:), ploss_avg(:,:),&223 & subsurf_active, deepneg_active, &224 & deeppos_active, nutprof_active, &225 & bstate, outincs, &226 & diag_active, diag, &263 CALL bio_analysis( jpi, jpj, jpk, gdepw_n(:,:,2:jpk), i_tracer, modparm, & 264 & n2be_p, n2be_z, n2be_d, assimparm, & 265 & INT(aincper), 1, INT(SUM(tmask,3)), tmask(:,:,:), & 266 & zmld(:,:), mld_max_bkg(:,:), chl_inc(:,:), cchl_p(:,:), & 267 & nbal_active, phyt_avg_bkg(:,:), & 268 & gl_active, pgrow_avg_bkg(:,:), ploss_avg_bkg(:,:), & 269 & subsurf_active, deepneg_active, & 270 & deeppos_active, nutprof_active, & 271 & bstate, outincs, & 272 & diag_active, diag, & 227 273 & diag_fulldepth_active, diag_fulldepth ) 228 229 ! Save balancing increments 230 logchl_balinc(:,:,:,jp_had_nut) = outincs(:,:,:,i_tracer(1)) 231 logchl_balinc(:,:,:,jp_had_phy) = outincs(:,:,:,i_tracer(2)) 232 logchl_balinc(:,:,:,jp_had_zoo) = outincs(:,:,:,i_tracer(3)) 233 logchl_balinc(:,:,:,jp_had_pdn) = outincs(:,:,:,i_tracer(4)) 234 logchl_balinc(:,:,:,jp_had_dic) = outincs(:,:,:,i_tracer(5)) 235 logchl_balinc(:,:,:,jp_had_alk) = outincs(:,:,:,i_tracer(6)) 274 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 ! Loop over each grid point partioning the increments 278 logchl_balinc(:,:,:,:) = 0.0 279 DO jk = 1, jpk 280 DO jj = 1, jpj 281 DO ji = 1, jpi 282 283 IF ( ( trb(ji,jj,jk,jpphn) > 0.0 ) .AND. ( trb(ji,jj,jk,jpphd) > 0.0 ) ) THEN 284 ! Phytoplankton nitrogen and silicate split up based on existing ratios 285 zfrac_phn = trb(ji,jj,jk,jpphn) / (trb(ji,jj,jk,jpphn) + trb(ji,jj,jk,jpphd)) 286 zfrac_phd = 1.0 - zfrac_phn 287 zrat_pds_phd = trb(ji,jj,jk,jppds) / trb(ji,jj,jk,jpphd) 288 logchl_balinc(ji,jj,jk,jpphn) = outincs(ji,jj,jk,i_tracer(2)) * zfrac_phn 289 logchl_balinc(ji,jj,jk,jpphd) = outincs(ji,jj,jk,i_tracer(2)) * zfrac_phd 290 logchl_balinc(ji,jj,jk,jppds) = logchl_balinc(ji,jj,jk,jpphd) * zrat_pds_phd 291 292 ! Chlorophyll split up based on existing ratios to phytoplankton nitrogen 293 ! Not using chl_inc directly as it's only 2D 294 ! This method should give same results at surface as splitting chl_inc would 295 zrat_chn_phn = trb(ji,jj,jk,jpchn) / trb(ji,jj,jk,jpphn) 296 zrat_chd_phd = trb(ji,jj,jk,jpchd) / trb(ji,jj,jk,jpphd) 297 logchl_balinc(ji,jj,jk,jpchn) = logchl_balinc(ji,jj,jk,jpphn) * zrat_chn_phn 298 logchl_balinc(ji,jj,jk,jpchd) = logchl_balinc(ji,jj,jk,jpphd) * zrat_chd_phd 299 ENDIF 300 301 IF ( ( trb(ji,jj,jk,jpzmi) > 0.0 ) .AND. ( trb(ji,jj,jk,jpzme) > 0.0 ) ) THEN 302 ! Zooplankton nitrogen split up based on existing ratios 303 zfrac_zmi = trb(ji,jj,jk,jpzmi) / (trb(ji,jj,jk,jpzmi) + trb(ji,jj,jk,jpzme)) 304 zfrac_zme = 1.0 - zfrac_zmi 305 logchl_balinc(ji,jj,jk,jpzmi) = outincs(ji,jj,jk,i_tracer(3)) * zfrac_zmi 306 logchl_balinc(ji,jj,jk,jpzme) = outincs(ji,jj,jk,i_tracer(3)) * zfrac_zme 307 ENDIF 308 309 ! Nitrogen nutrient straight from balancing scheme 310 logchl_balinc(ji,jj,jk,jpdin) = outincs(ji,jj,jk,i_tracer(1)) 311 312 ! Nitrogen detritus straight from balancing scheme 313 logchl_balinc(ji,jj,jk,jpdet) = outincs(ji,jj,jk,i_tracer(4)) 314 315 ! DIC straight from balancing scheme 316 logchl_balinc(ji,jj,jk,jpdic) = outincs(ji,jj,jk,i_tracer(5)) 317 318 ! Alkalinity straight from balancing scheme 319 logchl_balinc(ji,jj,jk,jpalk) = outincs(ji,jj,jk,i_tracer(6)) 320 321 ! Remove diatom silicate increment from nutrient silicate to conserve mass 322 IF ( ( trb(ji,jj,jk,jpsil) - logchl_balinc(ji,jj,jk,jppds) ) > 0.0 ) THEN 323 logchl_balinc(ji,jj,jk,jpsil) = logchl_balinc(ji,jj,jk,jppds) * (-1.0) 324 ENDIF 325 326 IF ( ( trb(ji,jj,jk,jpdet) > 0.0 ) .AND. ( trb(ji,jj,jk,jpdtc) > 0.0 ) ) THEN 327 ! Carbon detritus based on existing ratios 328 zrat_dtc_det = trb(ji,jj,jk,jpdtc) / trb(ji,jj,jk,jpdet) 329 logchl_balinc(ji,jj,jk,jpdtc) = logchl_balinc(ji,jj,jk,jpdet) * zrat_dtc_det 330 ENDIF 331 332 ! Do nothing with iron or oxygen for the time being 333 logchl_balinc(ji,jj,jk,jpfer) = 0.0 334 logchl_balinc(ji,jj,jk,jpoxy) = 0.0 335 336 END DO 337 END DO 338 END DO 236 339 237 340 ELSE ! No nitrogen balancing 238 341 239 ! Initialise phytoplankton increment to zero 240 logchl_balinc(:,:,:,jp_had_phy) = 0.0 342 ! Initialise individual chlorophyll increments to zero 343 logchl_balinc(:,:,:,jpchn) = 0.0 344 logchl_balinc(:,:,:,jpchd) = 0.0 241 345 242 ! Convert surface chlorophyll increment to phytoplankton nitrogen 243 logchl_balinc(:,:,1,jp_had_phy) = ( cchl_p(:,:,1) / (mw_carbon * c2n_p) ) * chl_inc(:,:) 346 ! Split up total surface chlorophyll increments 347 DO jj = 1, jpj 348 DO ji = 1, jpi 349 IF ( medusa_chl(ji,jj) > 0.0 ) THEN 350 zfrac_chn = trb(ji,jj,1,jpchn) / medusa_chl(ji,jj) 351 zfrac_chd = 1.0 - zfrac_chn 352 logchl_balinc(ji,jj,1,jpchn) = chl_inc(ji,jj) * zfrac_chn 353 logchl_balinc(ji,jj,1,jpchd) = chl_inc(ji,jj) * zfrac_chd 354 ENDIF 355 END DO 356 END DO 244 357 245 358 ! Propagate through mixed layer … … 257 370 ! 258 371 DO jk = 2, jkmax 259 logchl_balinc(ji,jj,jk,jp_had_phy) = logchl_balinc(ji,jj,1,jp_had_phy) 372 logchl_balinc(ji,jj,jk,jpchn) = logchl_balinc(ji,jj,1,jpchn) 373 logchl_balinc(ji,jj,jk,jpchd) = logchl_balinc(ji,jj,1,jpchd) 260 374 END DO 261 375 ! … … 264 378 265 379 ! Set other balancing increments to zero 266 logchl_balinc(:,:,:,jp_had_nut) = 0.0 267 logchl_balinc(:,:,:,jp_had_zoo) = 0.0 268 logchl_balinc(:,:,:,jp_had_pdn) = 0.0 269 logchl_balinc(:,:,:,jp_had_dic) = 0.0 270 logchl_balinc(:,:,:,jp_had_alk) = 0.0 271 380 logchl_balinc(:,:,:,jpphn) = 0.0 381 logchl_balinc(:,:,:,jpphd) = 0.0 382 logchl_balinc(:,:,:,jppds) = 0.0 383 logchl_balinc(:,:,:,jpzmi) = 0.0 384 logchl_balinc(:,:,:,jpzme) = 0.0 385 logchl_balinc(:,:,:,jpdin) = 0.0 386 logchl_balinc(:,:,:,jpsil) = 0.0 387 logchl_balinc(:,:,:,jpfer) = 0.0 388 logchl_balinc(:,:,:,jpdet) = 0.0 389 logchl_balinc(:,:,:,jpdtc) = 0.0 390 logchl_balinc(:,:,:,jpdic) = 0.0 391 logchl_balinc(:,:,:,jpalk) = 0.0 392 logchl_balinc(:,:,:,jpoxy) = 0.0 393 272 394 ENDIF 273 395 274 END SUBROUTINE asm_logchl_bal_ hadocc396 END SUBROUTINE asm_logchl_bal_medusa 275 397 276 398 #else … … 279 401 !!---------------------------------------------------------------------- 280 402 CONTAINS 281 SUBROUTINE asm_logchl_bal_ hadocc( logchl_bkginc, aincper, mld_choice_bgc, &403 SUBROUTINE asm_logchl_bal_medusa( logchl_bkginc, aincper, mld_choice_bgc, & 282 404 & k_maxchlinc, logchl_balinc ) 283 405 REAL :: logchl_bkginc(:,:) … … 286 408 REAL :: k_maxchlinc 287 409 REAL( :: logchl_balinc(:,:,:,:) 288 WRITE(*,*) 'asm_logchl_bal_ hadocc: You should not have seen this print! error?'289 END SUBROUTINE asm_logchl_bal_ hadocc410 WRITE(*,*) 'asm_logchl_bal_medusa: You should not have seen this print! error?' 411 END SUBROUTINE asm_logchl_bal_medusa 290 412 #endif 291 413 292 414 !!====================================================================== 293 END MODULE asmlogchlbal_ hadocc415 END MODULE asmlogchlbal_medusa -
branches/UKMO/dev_r5518_GO6_package_asm_surf_bgc/NEMOGCM/NEMO/TOP_SRC/MEDUSA/sms_medusa.F90
r8132 r8436 205 205 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: f2_ccd_arg !: 2D aragonite CCD depth 206 206 !! 207 #if defined key_foam_medusa 208 !! 2D fields of pCO2 and fCO2 for observation operator 209 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: f2_pco2w !: 2D pCO2 210 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: f2_fco2w !: 2D fCO2 211 !! 212 #endif 207 213 !! 2D fields of organic and inorganic material sedimented on the seafloor 208 214 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zb_sed_n !: 2D organic nitrogen (before) … … 434 440 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: cmask !: ??? 435 441 442 #if defined key_foam_medusa 443 !!---------------------------------------------------------------------- 444 !! Parameters required for ocean colour assimilation 445 !!---------------------------------------------------------------------- 446 !! 447 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: pgrow_avg !: Mixed layer average phytoplankton growth 448 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ploss_avg !: Mixed layer average phytoplankton loss 449 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: phyt_avg !: Mixed layer average phytoplankton 450 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: mld_max !: Maximum mixed layer depth 451 !! 452 #endif 453 436 454 !!---------------------------------------------------------------------- 437 455 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 446 464 !!---------------------------------------------------------------------- 447 465 USE lib_mpp , ONLY: ctl_warn 448 INTEGER :: ierr( 8) ! Local variables466 INTEGER :: ierr(9) ! Local variables 449 467 !!---------------------------------------------------------------------- 450 468 ierr(:) = 0 … … 456 474 !* 2D and 3D fields of carbonate system parameters 457 475 ALLOCATE( f2_ccd_cal(jpi,jpj) , f2_ccd_arg(jpi,jpj) , & 476 # if defined key_foam_medusa 477 f2_pco2w(jpi,jpj) , f2_fco2w(jpi,jpj) , & 478 # endif 458 479 & f3_pH(jpi,jpj,jpk) , f3_h2co3(jpi,jpj,jpk), & 459 480 & f3_hco3(jpi,jpj,jpk) , f3_co3(jpi,jpj,jpk) , & … … 504 525 & ffln(jpi,jpj,jpk) , fflf(jpi,jpj,jpk) , & 505 526 & ffls(jpi,jpj,jpk) , cmask(jpi,jpj) , STAT=ierr(8) ) 527 # if defined key_foam_medusa 528 ALLOCATE( pgrow_avg(jpi,jpj) , ploss_avg(jpi,jpj) , & 529 & phyt_avg(jpi,jpj) , mld_max(jpi,jpj) , STAT=ierr(9) ) 530 # endif 506 531 #endif 507 532 ! -
branches/UKMO/dev_r5518_GO6_package_asm_surf_bgc/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcbio_medusa.F90
r8224 r8436 80 80 # else 81 81 USE trcco2_medusa 82 # if defined key_foam_medusa 83 USE mocsy_mainmod 84 # endif 82 85 # endif 83 86 USE trcoxy_medusa … … 581 584 fslownflux(:,:) = 0.0 582 585 fslowcflux(:,:) = 0.0 586 587 # if defined key_foam_medusa 588 pgrow_avg(:,:) = 0.0 589 ploss_avg(:,:) = 0.0 590 phyt_avg(:,:) = 0.0 591 IF( kt == nittrc000 ) THEN 592 mld_max(:,:) = 0.0 593 ENDIF 594 # endif 583 595 584 596 !! … … 1347 1359 !! We want this to be start of month or if starting afresh from 1348 1360 !! climatology - marc 20/6/17 1361 #if defined key_foam_medusa 1362 !! DAF (Aug 2017): For FOAM we want to run daily 1363 If ( (kt == nittrc000 .AND. .NOT.ln_rsttr) .OR. & 1364 (mod(kt*rdt,86400.) == rdt) ) THEN 1365 #else 1349 1366 If ( (kt == nittrc000 .AND. .NOT.ln_rsttr) .OR. & 1350 1367 ((86400*mod(nn_date0,100) + mod(kt*rdt,2592000.)) == rdt) ) THEN 1368 #endif 1351 1369 !!---------------------------------------------------------------------- 1352 1370 !! Calculate the carbonate chemistry for the whole ocean on the first … … 1795 1813 iters, ' AT (', ji, ', ', jj, ', ', jk, ') AT ', kt 1796 1814 endif 1815 # if defined key_foam_medusa 1816 !! DAF (Aug 2017): calculate fCO2 for observation operator 1817 CALL p2fCO2( f_pco2w, ztmp, f_pp0, 0.0, 1, f_fco2w ) 1818 # endif 1797 1819 # endif 1798 1820 # else … … 1932 1954 fgco2(ji,jj) = f_co2flux * fthk * CO2flux_conv !! mmol-C/m3/d -> kg-CO2/m2/s 1933 1955 !! ENDIF 1956 # if defined key_foam_medusa 1957 !! DAF (Aug 2017): Save pCO2 and fCO2 for observation operator 1958 f2_pco2w(ji,jj) = f_pco2w 1959 f2_fco2w(ji,jj) = f_pco2w 1960 # endif 1934 1961 IF ( lk_iomput ) THEN 1935 1962 IF( med_diag%ATM_PCO2%dgsave ) THEN … … 3603 3630 CALL flush(numout) 3604 3631 3632 # if defined key_foam_medusa 3633 !!---------------------------------------------------------------------- 3634 !! Mixed layer averages for ocean colour assimilation 3635 !!---------------------------------------------------------------------- 3636 !! 3637 if (fdep1.le.hmld(ji,jj)) then 3638 !! this level is entirely in the mixed layer 3639 fq0 = 1.0 3640 elseif (fdep.ge.hmld(ji,jj)) then 3641 !! this level is entirely below the mixed layer 3642 fq0 = 0.0 3643 else 3644 !! this level straddles the mixed layer 3645 fq0 = (hmld(ji,jj) - fdep) / fthk 3646 endif 3647 !! 3648 pgrow_avg(ji,jj) = pgrow_avg(ji,jj) + ( & 3649 ( (fprn * zphn) + (fprd * zphd) ) * fthk * fq0) 3650 ploss_avg(ji,jj) = ploss_avg(ji,jj) + ( & 3651 ( fgmipn + fgmepn + fdpn + fdpn2 + fgmepd + fdpd + fdpd2 ) * fthk * fq0 ) 3652 phyt_avg(ji,jj) = phyt_avg(ji,jj) + ( & 3653 (zphn +zphd) * fthk * fq0 ) 3654 !! 3655 # endif 3605 3656 !!====================================================================== 3606 3657 !! LOCAL GRID CELL TRENDS … … 5331 5382 endif 5332 5383 5384 # if defined key_foam_medusa 5385 !!---------------------------------------------------------------------- 5386 !! Dianostics required for ocean colour assimilation: 5387 !! Mixed layer average phytoplankton growth, loss and concentration 5388 !! Maximum mixed layer depth 5389 !!---------------------------------------------------------------------- 5390 !! 5391 DO jj = 2,jpjm1 5392 DO ji = 2,jpim1 5393 pgrow_avg(ji,jj) = pgrow_avg(ji,jj) / hmld(ji,jj) 5394 ploss_avg(ji,jj) = ploss_avg(ji,jj) / hmld(ji,jj) 5395 phyt_avg(ji,jj) = phyt_avg(ji,jj) / hmld(ji,jj) 5396 IF ( hmld(ji,jj) .GT. mld_max(ji,jj) ) THEN 5397 mld_max(ji,jj) = hmld(ji,jj) 5398 ENDIF 5399 END DO 5400 END DO 5401 # endif 5402 5333 5403 IF( ln_diatrc ) THEN 5334 5404 !!---------------------------------------------------------------------- -
branches/UKMO/dev_r5518_GO6_package_asm_surf_bgc/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r8280 r8436 43 43 USE sbc_oce, ONLY: lk_oasis 44 44 USE oce, ONLY: CO2Flux_out_cpl, DMS_out_cpl, chloro_out_cpl !! Coupling variable 45 #if defined key_foam_medusa 46 USE obs_const, ONLY: obfillflt ! Observation operator fill value 47 #endif 45 48 46 49 IMPLICIT NONE … … 329 332 IF(lwp) WRITE(numout,*) 'Or don t start from uncomplete restart...' 330 333 ENDIF 334 ! 335 # if defined key_foam_medusa 336 !! 2D fields of pCO2 and fCO2 for observation operator on first timestep 337 IF( iom_varid( numrtr, 'PCO2W', ldstop = .FALSE. ) > 0 ) THEN 338 IF(lwp) WRITE(numout,*) ' MEDUSA pCO2 present - reading in ...' 339 CALL iom_get( numrtr, jpdom_autoglo, 'PCO2W', f2_pco2w(:,:) ) 340 CALL iom_get( numrtr, jpdom_autoglo, 'FCO2W', f2_fco2w(:,:) ) 341 ELSE 342 IF(lwp) WRITE(numout,*) ' MEDUSA pCO2 absent - setting to fill ...' 343 f2_pco2w(:,:) = obfillflt 344 f2_fco2w(:,:) = obfillflt 345 ENDIF 346 # endif 347 # endif 348 # if defined key_foam_medusa 349 !! Fields for ocean colour assimilation on first timestep 350 IF( iom_varid( numrtr, 'pgrow_avg', ldstop = .FALSE. ) > 0 ) THEN 351 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 ELSE 357 IF(lwp) WRITE(numout,*) ' MEDUSA pgrow_avg absent - setting to zero ...' 358 pgrow_avg(:,:) = 0.0 359 ploss_avg(:,:) = 0.0 360 phyt_avg(:,:) = 0.0 361 mld_max(:,:) = 0.0 362 ENDIF 331 363 # endif 332 364 … … 498 530 call trc_rst_dia_stat( f2_ccd_arg(:,:),'CCD_ARG') 499 531 !! 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(:,:) ) 539 # 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(:,:) ) 500 544 # endif 501 545 !!
Note: See TracChangeset
for help on using the changeset viewer.