Changeset 11990 for branches/UKMO/dev_r5518_GO6_package_asm_3d_bgc_3dnitbal/NEMOGCM/NEMO/OPA_SRC/ASM/asmbgc.F90
- Timestamp:
- 2019-11-27T16:43:05+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_package_asm_3d_bgc_3dnitbal/NEMOGCM/NEMO/OPA_SRC/ASM/asmbgc.F90
r9862 r11990 59 59 USE asmphyto2dbal_medusa, ONLY: & ! phyto2d balancing for MEDUSA 60 60 & asm_phyto2d_bal_medusa 61 USE asmphyto3dbal_medusa, ONLY: & ! phyto3d balancing for MEDUSA 62 & asm_phyto3d_bal_medusa 61 63 USE asmpco2bal, ONLY: & ! pCO2 balancing for MEDUSA 62 64 & asm_pco2_bal … … 71 73 & ploss_avg, & 72 74 & phyt_avg, & 75 & pgrow_avg_3d, & 76 & ploss_avg_3d, & 77 & phyt_avg_3d, & 73 78 & mld_max 74 79 #elif defined key_hadocc … … 172 177 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ploss_avg_bkg ! Background phyto loss 173 178 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: phyt_avg_bkg ! Background phyto conc 179 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: pgrow_avg_3d_bkg ! Background phyto growth 180 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ploss_avg_3d_bkg ! Background phyto loss 181 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: phyt_avg_3d_bkg ! Background phyto conc 174 182 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: mld_max_bkg ! Background max MLD 175 183 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tracer_bkg ! Background tracer state … … 213 221 & ( .NOT. ln_slchlnoninc ).AND.( .NOT. ln_schltotinc ).AND. & 214 222 & ( .NOT. ln_slphytotinc ).AND.( .NOT. ln_slphydiainc ).AND. & 215 & ( .NOT. ln_slphynoninc ) ) THEN 223 & ( .NOT. ln_slphynoninc ).AND.( .NOT. ln_plchltotinc ).AND. & 224 & ( .NOT. ln_pchltotinc ) ) THEN 216 225 CALL ctl_warn( ' Cannot calculate phytoplankton balancing increments', & 217 & ' if not assimilating ocean colour,', &226 & ' if not assimilating phytoplankton,', & 218 227 & ' so ln_phytobal will be set to .false.') 219 228 ln_phytobal = .FALSE. … … 525 534 ALLOCATE( ploss_avg_bkg(jpi,jpj) ) 526 535 ALLOCATE( phyt_avg_bkg(jpi,jpj) ) 536 ALLOCATE( pgrow_avg_3d_bkg(jpi,jpj,jpk) ) 537 ALLOCATE( ploss_avg_3d_bkg(jpi,jpj,jpk) ) 538 ALLOCATE( phyt_avg_3d_bkg(jpi,jpj,jpk) ) 527 539 ALLOCATE( mld_max_bkg(jpi,jpj) ) 528 540 ALLOCATE( tracer_bkg(jpi,jpj,jpk,jptra) ) … … 530 542 ploss_avg_bkg(:,:) = 0.0 531 543 phyt_avg_bkg(:,:) = 0.0 544 pgrow_avg_3d_bkg(:,:,:) = 0.0 545 ploss_avg_3d_bkg(:,:,:) = 0.0 546 phyt_avg_3d_bkg(:,:,:) = 0.0 532 547 mld_max_bkg(:,:) = 0.0 533 548 tracer_bkg(:,:,:,:) = 0.0 … … 565 580 CALL iom_get( inum, jpdom_autoglo, 'ploss_avg', ploss_avg_bkg ) 566 581 CALL iom_get( inum, jpdom_autoglo, 'phyt_avg', phyt_avg_bkg ) 582 CALL iom_get( inum, jpdom_autoglo, 'pgrow_avg_3d', pgrow_avg_3d_bkg ) 583 CALL iom_get( inum, jpdom_autoglo, 'ploss_avg_3d', ploss_avg_3d_bkg ) 584 CALL iom_get( inum, jpdom_autoglo, 'phyt_avg_3d', phyt_avg_3d_bkg ) 567 585 CALL iom_get( inum, jpdom_autoglo, 'mld_max', mld_max_bkg ) 568 586 pgrow_avg_bkg(:,:) = pgrow_avg_bkg(:,:) * tmask(:,:,1) 569 587 ploss_avg_bkg(:,:) = ploss_avg_bkg(:,:) * tmask(:,:,1) 570 588 phyt_avg_bkg(:,:) = phyt_avg_bkg(:,:) * tmask(:,:,1) 589 pgrow_avg_3d_bkg(:,:,:) = pgrow_avg_3d_bkg(:,:,:) * tmask(:,:,:) 590 ploss_avg_3d_bkg(:,:,:) = ploss_avg_3d_bkg(:,:,:) * tmask(:,:,:) 591 phyt_avg_3d_bkg(:,:,:) = phyt_avg_3d_bkg(:,:,:) * tmask(:,:,:) 571 592 mld_max_bkg(:,:) = mld_max_bkg(:,:) * tmask(:,:,1) 572 593 … … 727 748 CALL iom_rstput( kt, kt, inum, 'phy3d_phd', phyto3d_balinc(:,:,:,jpphd) ) 728 749 CALL iom_rstput( kt, kt, inum, 'phy3d_pds', phyto3d_balinc(:,:,:,jppds) ) 750 IF ( ln_phytobal ) THEN 751 CALL iom_rstput( kt, kt, inum, 'phy3d_zmi', phyto3d_balinc(:,:,:,jpzmi) ) 752 CALL iom_rstput( kt, kt, inum, 'phy3d_zme', phyto3d_balinc(:,:,:,jpzme) ) 753 CALL iom_rstput( kt, kt, inum, 'phy3d_din', phyto3d_balinc(:,:,:,jpdin) ) 754 CALL iom_rstput( kt, kt, inum, 'phy3d_sil', phyto3d_balinc(:,:,:,jpsil) ) 755 CALL iom_rstput( kt, kt, inum, 'phy3d_fer', phyto3d_balinc(:,:,:,jpfer) ) 756 CALL iom_rstput( kt, kt, inum, 'phy3d_det', phyto3d_balinc(:,:,:,jpdet) ) 757 CALL iom_rstput( kt, kt, inum, 'phy3d_dtc', phyto3d_balinc(:,:,:,jpdtc) ) 758 CALL iom_rstput( kt, kt, inum, 'phy3d_dic', phyto3d_balinc(:,:,:,jpdic) ) 759 CALL iom_rstput( kt, kt, inum, 'phy3d_alk', phyto3d_balinc(:,:,:,jpalk) ) 760 CALL iom_rstput( kt, kt, inum, 'phy3d_oxy', phyto3d_balinc(:,:,:,jpoxy) ) 761 ENDIF 729 762 #elif defined key_hadocc 730 763 CALL iom_rstput( kt, kt, inum, 'phy3d_phy', phyto3d_balinc(:,:,:,jp_had_phy) ) … … 810 843 CALL iom_rstput( kt, nitbkg_r, knum, 'ploss_avg' , ploss_avg ) 811 844 CALL iom_rstput( kt, nitbkg_r, knum, 'phyt_avg' , phyt_avg ) 845 CALL iom_rstput( kt, nitbkg_r, knum, 'pgrow_avg_3d' , pgrow_avg_3d ) 846 CALL iom_rstput( kt, nitbkg_r, knum, 'ploss_avg_3d' , ploss_avg_3d ) 847 CALL iom_rstput( kt, nitbkg_r, knum, 'phyt_avg_3d' , phyt_avg_3d ) 812 848 CALL iom_rstput( kt, nitbkg_r, knum, 'mld_max' , mld_max ) 813 849 CALL iom_rstput( kt, nitbkg_r, knum, 'medusa_chn' , trn(:,:,:,jpchn) ) … … 1163 1199 INTEGER :: ji, jj, jk ! Loop counters 1164 1200 INTEGER :: it ! Index 1201 REAL(wp) :: zincper ! IAU interval in seconds 1165 1202 REAL(wp) :: zincwgt ! IAU weight for timestep 1166 1203 REAL(wp) :: zfrac_chn ! Fraction of jpchn … … 1215 1252 END DO 1216 1253 ENDIF 1217 1254 1218 1255 #if defined key_medusa && defined key_foam_medusa 1219 ! Loop over each grid point partioning the increments based on existing ratios 1220 DO jk = 1, jpk 1221 DO jj = 1, jpj 1222 DO ji = 1, jpi 1223 IF ( ( tracer_bkg(ji,jj,jk,jpchn) > 0.0 ) .AND. ( tracer_bkg(ji,jj,jk,jpchd) > 0.0 ) ) THEN 1224 zfrac_chn = tracer_bkg(ji,jj,jk,jpchn) / (tracer_bkg(ji,jj,jk,jpchn) + tracer_bkg(ji,jj,jk,jpchd)) 1225 zfrac_chd = 1.0 - zfrac_chn 1226 phyto3d_balinc(ji,jj,jk,jpchn) = chl_inc(ji,jj,jk) * zfrac_chn 1227 phyto3d_balinc(ji,jj,jk,jpchd) = chl_inc(ji,jj,jk) * zfrac_chd 1228 zrat_phn_chn = tracer_bkg(ji,jj,jk,jpphn) / tracer_bkg(ji,jj,jk,jpchn) 1229 zrat_phd_chd = tracer_bkg(ji,jj,jk,jpphd) / tracer_bkg(ji,jj,jk,jpchd) 1230 zrat_pds_chd = tracer_bkg(ji,jj,jk,jppds) / tracer_bkg(ji,jj,jk,jpchd) 1231 phyto3d_balinc(ji,jj,jk,jpphn) = phyto3d_balinc(ji,jj,jk,jpchn) * zrat_phn_chn 1232 phyto3d_balinc(ji,jj,jk,jpphd) = phyto3d_balinc(ji,jj,jk,jpchd) * zrat_phd_chd 1233 phyto3d_balinc(ji,jj,jk,jppds) = phyto3d_balinc(ji,jj,jk,jpchd) * zrat_pds_chd 1234 ENDIF 1256 IF ( ln_phytobal ) THEN 1257 zincper = (nitiaufin_r - nitiaustr_r + 1) * rdt 1258 CALL asm_phyto3d_bal_medusa( chl_inc, & 1259 & zincper, & 1260 & rn_maxchlinc, & 1261 & pgrow_avg_3d_bkg, ploss_avg_3d_bkg, & 1262 & phyt_avg_3d_bkg, & 1263 & tracer_bkg, phyto3d_balinc ) 1264 ELSE 1265 ! Loop over each grid point partioning the increments based on existing ratios 1266 DO jk = 1, jpk 1267 DO jj = 1, jpj 1268 DO ji = 1, jpi 1269 IF ( ( tracer_bkg(ji,jj,jk,jpchn) > 0.0 ) .AND. ( tracer_bkg(ji,jj,jk,jpchd) > 0.0 ) ) THEN 1270 zfrac_chn = tracer_bkg(ji,jj,jk,jpchn) / (tracer_bkg(ji,jj,jk,jpchn) + tracer_bkg(ji,jj,jk,jpchd)) 1271 zfrac_chd = 1.0 - zfrac_chn 1272 phyto3d_balinc(ji,jj,jk,jpchn) = chl_inc(ji,jj,jk) * zfrac_chn 1273 phyto3d_balinc(ji,jj,jk,jpchd) = chl_inc(ji,jj,jk) * zfrac_chd 1274 zrat_phn_chn = tracer_bkg(ji,jj,jk,jpphn) / tracer_bkg(ji,jj,jk,jpchn) 1275 zrat_phd_chd = tracer_bkg(ji,jj,jk,jpphd) / tracer_bkg(ji,jj,jk,jpchd) 1276 zrat_pds_chd = tracer_bkg(ji,jj,jk,jppds) / tracer_bkg(ji,jj,jk,jpchd) 1277 phyto3d_balinc(ji,jj,jk,jpphn) = phyto3d_balinc(ji,jj,jk,jpchn) * zrat_phn_chn 1278 phyto3d_balinc(ji,jj,jk,jpphd) = phyto3d_balinc(ji,jj,jk,jpchd) * zrat_phd_chd 1279 phyto3d_balinc(ji,jj,jk,jppds) = phyto3d_balinc(ji,jj,jk,jpchd) * zrat_pds_chd 1280 ENDIF 1281 END DO 1235 1282 END DO 1236 1283 END DO 1237 END DO1284 ENDIF 1238 1285 #elif defined key_hadocc 1239 1286 phyto3d_balinc(:,:,:,jp_had_phy) = ( cchl_p_bkg(:,:,:) / (mw_carbon * c2n_p) ) * chl_inc(:,:,:) … … 1420 1467 ! Account for phytoplankton balancing if required 1421 1468 IF ( ln_phytobal ) THEN 1422 dic_bkg_temp(:,:) = tracer_bkg(:,:,1,jpdic) + phyto2d_balinc(:,:,1,jpdic) 1423 alk_bkg_temp(:,:) = tracer_bkg(:,:,1,jpalk) + phyto2d_balinc(:,:,1,jpalk) 1469 IF ( ln_slchltotinc ) THEN 1470 dic_bkg_temp(:,:) = tracer_bkg(:,:,1,jpdic) + phyto2d_balinc(:,:,1,jpdic) 1471 alk_bkg_temp(:,:) = tracer_bkg(:,:,1,jpalk) + phyto2d_balinc(:,:,1,jpalk) 1472 ENDIF 1473 IF ( ln_plchltotinc ) THEN 1474 dic_bkg_temp(:,:) = tracer_bkg(:,:,1,jpdic) + phyto3d_balinc(:,:,1,jpdic) 1475 alk_bkg_temp(:,:) = tracer_bkg(:,:,1,jpalk) + phyto3d_balinc(:,:,1,jpalk) 1476 ENDIF 1424 1477 ELSE 1425 1478 dic_bkg_temp(:,:) = tracer_bkg(:,:,1,jpdic) … … 1666 1719 ! Account for phytoplankton balancing if required 1667 1720 IF ( ln_phytobal ) THEN 1668 dic_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpdic) + phyto2d_balinc(:,:,:,jpdic) 1669 alk_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpalk) + phyto2d_balinc(:,:,:,jpalk) 1670 din_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpdin) + phyto2d_balinc(:,:,:,jpdin) 1671 sil_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpsil) + phyto2d_balinc(:,:,:,jpsil) 1721 IF ( ln_slchltotinc ) THEN 1722 dic_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpdic) + phyto2d_balinc(:,:,:,jpdic) 1723 alk_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpalk) + phyto2d_balinc(:,:,:,jpalk) 1724 din_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpdin) + phyto2d_balinc(:,:,:,jpdin) 1725 sil_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpsil) + phyto2d_balinc(:,:,:,jpsil) 1726 ENDIF 1727 IF ( ln_plchltotinc ) THEN 1728 dic_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpdic) + phyto3d_balinc(:,:,:,jpdic) 1729 alk_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpalk) + phyto3d_balinc(:,:,:,jpalk) 1730 din_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpdin) + phyto3d_balinc(:,:,:,jpdin) 1731 sil_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpsil) + phyto3d_balinc(:,:,:,jpsil) 1732 ENDIF 1672 1733 ELSE 1673 1734 dic_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpdic) … … 1861 1922 CALL ctl_stop ( ' bgc3d_asm_inc: no compatible BGC model defined' ) 1862 1923 #endif 1863 IF ( ln_ phytobal) THEN1924 IF ( ln_slchltotinc .OR. ln_schltotinc ) THEN 1864 1925 pno3_bkginc(:,:,:) = pno3_bkginc(:,:,:) - phyto2d_balinc(:,:,:,it) 1865 1926 ENDIF … … 1881 1942 CALL ctl_stop ( ' bgc3d_asm_inc: no compatible BGC model defined' ) 1882 1943 #endif 1883 IF ( ln_ phytobal) THEN1944 IF ( ln_slchltotinc .OR. ln_schltotinc ) THEN 1884 1945 psi4_bkginc(:,:,:) = psi4_bkginc(:,:,:) - phyto2d_balinc(:,:,:,it) 1885 1946 ENDIF … … 1903 1964 CALL ctl_stop ( ' bgc3d_asm_inc: no compatible BGC model defined' ) 1904 1965 #endif 1905 IF ( ln_ phytobal) THEN1966 IF ( ln_slchltotinc .OR. ln_schltotinc ) THEN 1906 1967 pdic_bkginc(:,:,:) = pdic_bkginc(:,:,:) - phyto2d_balinc(:,:,:,it) 1907 1968 ENDIF … … 1925 1986 CALL ctl_stop ( ' bgc3d_asm_inc: no compatible BGC model defined' ) 1926 1987 #endif 1927 IF ( ln_ phytobal) THEN1988 IF ( ln_slchltotinc .OR. ln_schltotinc ) THEN 1928 1989 palk_bkginc(:,:,:) = palk_bkginc(:,:,:) - phyto2d_balinc(:,:,:,it) 1929 1990 ENDIF … … 1945 2006 CALL ctl_stop ( ' bgc3d_asm_inc: no compatible BGC model defined' ) 1946 2007 #endif 1947 IF ( ln_ phytobal) THEN2008 IF ( ln_slchltotinc .OR. ln_schltotinc ) THEN 1948 2009 po2_bkginc(:,:,:) = po2_bkginc(:,:,:) - phyto2d_balinc(:,:,:,it) 1949 2010 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
