Changeset 13097 for branches/UKMO/dev_r5518_GO6_package_FOAMv14_phytobal3d/NEMOGCM/NEMO/OPA_SRC/ASM/asmbgc.F90
- Timestamp:
- 2020-06-11T19:32:37+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_package_FOAMv14_phytobal3d/NEMOGCM/NEMO/OPA_SRC/ASM/asmbgc.F90
r10302 r13097 18 18 !! asm_bgc_bal_wri : write out bgc balancing increments 19 19 !! asm_bgc_bkg_wri : write out bgc background 20 !! phyto2d_asm_inc : apply the ocean colour increments 20 !! asm_bgc_unlog_2d : calculate non-log versions of 2D log increments 21 !! asm_bgc_unlog_3d : calculate non-log versions of 3D log increments 22 !! phyto2d_asm_inc : apply the 2D phytoplankton increments 21 23 !! phyto3d_asm_inc : apply the 3D phytoplankton increments 22 24 !! pco2_asm_inc : apply the pCO2/fCO2 increments … … 56 58 #endif 57 59 #if defined key_medusa 58 USE asmphyto 2dbal_medusa, ONLY: & ! phyto2dbalancing for MEDUSA59 & asm_phyto 2d_bal_medusa60 USE asmphytobal_medusa, ONLY: & ! phytoplankton balancing for MEDUSA 61 & asm_phyto_bal_medusa 60 62 USE asmpco2bal, ONLY: & ! pCO2 balancing for MEDUSA 61 63 & asm_pco2_bal … … 70 72 & ploss_avg, & 71 73 & phyt_avg, & 74 & pgrow_avg_3d, & 75 & ploss_avg_3d, & 76 & phyt_avg_3d, & 72 77 & mld_max 73 78 #elif defined key_hadocc 74 USE asmphyto 2dbal_hadocc, ONLY: & ! phyto2dbalancing for HadOCC75 & asm_phyto 2d_bal_hadocc79 USE asmphytobal_hadocc, ONLY: & ! phytoplankton balancing for HadOCC 80 & asm_phyto_bal_hadocc 76 81 USE asmpco2bal, ONLY: & ! pCO2 balancing for HadOCC 77 82 & asm_pco2_bal … … 82 87 & ploss_avg, & 83 88 & phyt_avg, & 89 & pgrow_avg_3d, & 90 & ploss_avg_3d, & 91 & phyt_avg_3d, & 84 92 & mld_max, & 85 93 & HADOCC_CHL … … 98 106 PUBLIC asm_bgc_bal_wri ! called by nemo_gcm in nemogcm.F90 99 107 PUBLIC asm_bgc_bkg_wri ! called by asm_bkg_wri in asmbkg.F90 108 PRIVATE asm_bgc_unlog_2d ! called by phyto2d_asm_inc 109 PRIVATE asm_bgc_unlog_3d ! called by phyto3d_asm_inc 100 110 PUBLIC phyto2d_asm_inc ! called by bgc_asm_inc in asminc.F90 101 111 PUBLIC phyto3d_asm_inc ! called by bgc_asm_inc in asminc.F90 … … 168 178 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ploss_avg_bkg ! Background phyto loss 169 179 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: phyt_avg_bkg ! Background phyto conc 180 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: pgrow_avg_3d_bkg ! Background phyto growth 181 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ploss_avg_3d_bkg ! Background phyto loss 182 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: phyt_avg_3d_bkg ! Background phyto conc 170 183 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: mld_max_bkg ! Background max MLD 171 184 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tracer_bkg ! Background tracer state … … 212 225 & ( .NOT. ln_slchlnoninc ).AND.( .NOT. ln_schltotinc ).AND. & 213 226 & ( .NOT. ln_slphytotinc ).AND.( .NOT. ln_slphydiainc ).AND. & 214 & ( .NOT. ln_slphynoninc ) ) THEN 227 & ( .NOT. ln_slphynoninc ).AND.( .NOT. ln_plchltotinc ).AND. & 228 & ( .NOT. ln_pchltotinc ) ) THEN 215 229 CALL ctl_warn( ' Cannot calculate phytoplankton balancing increments', & 216 & ' if not assimilating ocean colour,', &230 & ' if not assimilating phytoplankton,', & 217 231 & ' so ln_phytobal will be set to .false.') 218 232 ln_phytobal = .FALSE. … … 524 538 ALLOCATE( ploss_avg_bkg(jpi,jpj) ) 525 539 ALLOCATE( phyt_avg_bkg(jpi,jpj) ) 540 ALLOCATE( pgrow_avg_3d_bkg(jpi,jpj,jpk) ) 541 ALLOCATE( ploss_avg_3d_bkg(jpi,jpj,jpk) ) 542 ALLOCATE( phyt_avg_3d_bkg(jpi,jpj,jpk) ) 526 543 ALLOCATE( mld_max_bkg(jpi,jpj) ) 527 544 ALLOCATE( tracer_bkg(jpi,jpj,jpk,jptra) ) … … 529 546 ploss_avg_bkg(:,:) = 0.0 530 547 phyt_avg_bkg(:,:) = 0.0 548 pgrow_avg_3d_bkg(:,:,:) = 0.0 549 ploss_avg_3d_bkg(:,:,:) = 0.0 550 phyt_avg_3d_bkg(:,:,:) = 0.0 531 551 mld_max_bkg(:,:) = 0.0 532 552 tracer_bkg(:,:,:,:) = 0.0 … … 564 584 CALL iom_get( inum, jpdom_autoglo, 'ploss_avg', ploss_avg_bkg ) 565 585 CALL iom_get( inum, jpdom_autoglo, 'phyt_avg', phyt_avg_bkg ) 586 CALL iom_get( inum, jpdom_autoglo, 'pgrow_avg_3d', pgrow_avg_3d_bkg ) 587 CALL iom_get( inum, jpdom_autoglo, 'ploss_avg_3d', ploss_avg_3d_bkg ) 588 CALL iom_get( inum, jpdom_autoglo, 'phyt_avg_3d', phyt_avg_3d_bkg ) 566 589 CALL iom_get( inum, jpdom_autoglo, 'mld_max', mld_max_bkg ) 567 590 pgrow_avg_bkg(:,:) = pgrow_avg_bkg(:,:) * tmask(:,:,1) 568 591 ploss_avg_bkg(:,:) = ploss_avg_bkg(:,:) * tmask(:,:,1) 569 592 phyt_avg_bkg(:,:) = phyt_avg_bkg(:,:) * tmask(:,:,1) 593 pgrow_avg_3d_bkg(:,:,:) = pgrow_avg_3d_bkg(:,:,:) * tmask(:,:,:) 594 ploss_avg_3d_bkg(:,:,:) = ploss_avg_3d_bkg(:,:,:) * tmask(:,:,:) 595 phyt_avg_3d_bkg(:,:,:) = phyt_avg_3d_bkg(:,:,:) * tmask(:,:,:) 570 596 mld_max_bkg(:,:) = mld_max_bkg(:,:) * tmask(:,:,1) 571 597 … … 726 752 CALL iom_rstput( kt, kt, inum, 'phy3d_phd', phyto3d_balinc(:,:,:,jpphd) ) 727 753 CALL iom_rstput( kt, kt, inum, 'phy3d_pds', phyto3d_balinc(:,:,:,jppds) ) 754 IF ( ln_phytobal ) THEN 755 CALL iom_rstput( kt, kt, inum, 'phy3d_zmi', phyto3d_balinc(:,:,:,jpzmi) ) 756 CALL iom_rstput( kt, kt, inum, 'phy3d_zme', phyto3d_balinc(:,:,:,jpzme) ) 757 CALL iom_rstput( kt, kt, inum, 'phy3d_din', phyto3d_balinc(:,:,:,jpdin) ) 758 CALL iom_rstput( kt, kt, inum, 'phy3d_sil', phyto3d_balinc(:,:,:,jpsil) ) 759 CALL iom_rstput( kt, kt, inum, 'phy3d_fer', phyto3d_balinc(:,:,:,jpfer) ) 760 CALL iom_rstput( kt, kt, inum, 'phy3d_det', phyto3d_balinc(:,:,:,jpdet) ) 761 CALL iom_rstput( kt, kt, inum, 'phy3d_dtc', phyto3d_balinc(:,:,:,jpdtc) ) 762 CALL iom_rstput( kt, kt, inum, 'phy3d_dic', phyto3d_balinc(:,:,:,jpdic) ) 763 CALL iom_rstput( kt, kt, inum, 'phy3d_alk', phyto3d_balinc(:,:,:,jpalk) ) 764 CALL iom_rstput( kt, kt, inum, 'phy3d_oxy', phyto3d_balinc(:,:,:,jpoxy) ) 765 ENDIF 728 766 #elif defined key_hadocc 729 767 CALL iom_rstput( kt, kt, inum, 'phy3d_phy', phyto3d_balinc(:,:,:,jp_had_phy) ) 768 IF ( ln_phytobal ) THEN 769 CALL iom_rstput( kt, kt, inum, 'phy3d_nut', phyto3d_balinc(:,:,:,jp_had_nut) ) 770 CALL iom_rstput( kt, kt, inum, 'phy3d_zoo', phyto3d_balinc(:,:,:,jp_had_zoo) ) 771 CALL iom_rstput( kt, kt, inum, 'phy3d_det', phyto3d_balinc(:,:,:,jp_had_pdn) ) 772 CALL iom_rstput( kt, kt, inum, 'phy3d_dic', phyto3d_balinc(:,:,:,jp_had_dic) ) 773 CALL iom_rstput( kt, kt, inum, 'phy3d_alk', phyto3d_balinc(:,:,:,jp_had_alk) ) 774 ENDIF 730 775 #endif 731 776 ENDIF … … 792 837 !!------------------------------------------------------------------------ 793 838 794 #if defined key_hadocc795 839 CALL iom_rstput( kt, nitbkg_r, knum, 'pgrow_avg' , pgrow_avg ) 796 840 CALL iom_rstput( kt, nitbkg_r, knum, 'ploss_avg' , ploss_avg ) 797 841 CALL iom_rstput( kt, nitbkg_r, knum, 'phyt_avg' , phyt_avg ) 842 CALL iom_rstput( kt, nitbkg_r, knum, 'pgrow_avg_3d', pgrow_avg_3d ) 843 CALL iom_rstput( kt, nitbkg_r, knum, 'ploss_avg_3d', ploss_avg_3d ) 844 CALL iom_rstput( kt, nitbkg_r, knum, 'phyt_avg_3d' , phyt_avg_3d ) 798 845 CALL iom_rstput( kt, nitbkg_r, knum, 'mld_max' , mld_max ) 846 #if defined key_hadocc 799 847 CALL iom_rstput( kt, nitbkg_r, knum, 'hadocc_nut' , trn(:,:,:,jp_had_nut) ) 800 848 CALL iom_rstput( kt, nitbkg_r, knum, 'hadocc_phy' , trn(:,:,:,jp_had_phy) ) … … 806 854 CALL iom_rstput( kt, nitbkg_r, knum, 'hadocc_cchl' , cchl_p(:,:,:) ) 807 855 #elif defined key_medusa 808 CALL iom_rstput( kt, nitbkg_r, knum, 'pgrow_avg' , pgrow_avg )809 CALL iom_rstput( kt, nitbkg_r, knum, 'ploss_avg' , ploss_avg )810 CALL iom_rstput( kt, nitbkg_r, knum, 'phyt_avg' , phyt_avg )811 CALL iom_rstput( kt, nitbkg_r, knum, 'mld_max' , mld_max )812 856 CALL iom_rstput( kt, nitbkg_r, knum, 'medusa_chn' , trn(:,:,:,jpchn) ) 813 857 CALL iom_rstput( kt, nitbkg_r, knum, 'medusa_chd' , trn(:,:,:,jpchd) ) … … 876 920 !!=========================================================================== 877 921 922 SUBROUTINE asm_bgc_unlog_3d( pbkg, pinc_log, pinc_nonlog ) 923 !!------------------------------------------------------------------------ 924 !! *** ROUTINE asm_bgc_init_incs *** 925 !! 926 !! ** Purpose : convert log increments to non-log 927 !! 928 !! ** Method : need to account for model background, 929 !! cannot simply do 10^log_inc. Need to: 930 !! 1) Add log_inc to log10(background) to get log10(analysis) 931 !! 2) Take 10^log10(analysis) to get analysis 932 !! 3) Subtract background from analysis to get non-log incs 933 !! 934 !! ** Action : return non-log increments 935 !! 936 !! References : 937 !!------------------------------------------------------------------------ 938 !! 939 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pbkg ! Background 940 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pinc_log ! Log incs 941 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk) :: pinc_nonlog ! Non-log incs 942 ! 943 INTEGER :: ji, jj, jk ! Loop counters 944 !! 945 !!------------------------------------------------------------------------ 946 947 DO jk = 1, jpk 948 DO jj = 1, jpj 949 DO ji = 1, jpi 950 IF ( pbkg(ji,jj,jk) > 0.0 ) THEN 951 pinc_nonlog(ji,jj,jk) = 10**( LOG10( pbkg(ji,jj,jk) ) + & 952 & pinc_log(ji,jj,jk) ) & 953 & - pbkg(ji,jj,jk) 954 ELSE 955 pinc_nonlog(ji,jj,jk) = 0.0 956 ENDIF 957 END DO 958 END DO 959 END DO 960 961 END SUBROUTINE asm_bgc_unlog_3d 962 963 !!=========================================================================== 964 !!=========================================================================== 965 !!=========================================================================== 966 878 967 SUBROUTINE phyto2d_asm_inc( kt, ll_asmdin, ll_asmiau, kcycper, pwgtiau ) 879 968 !!------------------------------------------------------------------------ … … 894 983 REAL(wp), DIMENSION(kcycper), INTENT(IN) :: pwgtiau ! IAU weights 895 984 ! 896 INTEGER :: jk ! Loop counter 897 INTEGER :: it ! Index 898 REAL(wp) :: zincwgt ! IAU weight for current time step 899 REAL(wp) :: zincper ! IAU interval in seconds 900 REAL(wp), DIMENSION(jpi,jpj) :: zmld ! Mixed layer depth 901 REAL(wp), DIMENSION(jpi,jpj) :: zinc_chltot ! Local chltot incs 902 REAL(wp), DIMENSION(jpi,jpj) :: zbkg_chltot ! Local chltot bkg 903 REAL(wp), DIMENSION(jpi,jpj) :: zinc_phytot ! Local phytot incs 904 REAL(wp), DIMENSION(jpi,jpj) :: zbkg_phytot ! Local phytot bkg 905 #if defined key_medusa 906 REAL(wp), DIMENSION(jpi,jpj) :: zinc_chldia ! Local chldia incs 907 REAL(wp), DIMENSION(jpi,jpj) :: zbkg_chldia ! Local chldia bkg 908 REAL(wp), DIMENSION(jpi,jpj) :: zinc_chlnon ! Local chlnon incs 909 REAL(wp), DIMENSION(jpi,jpj) :: zbkg_chlnon ! Local chlnon bkg 910 REAL(wp), DIMENSION(jpi,jpj) :: zinc_phydia ! Local phydia incs 911 REAL(wp), DIMENSION(jpi,jpj) :: zbkg_phydia ! Local phydia bkg 912 REAL(wp), DIMENSION(jpi,jpj) :: zinc_phynon ! Local phynon incs 913 REAL(wp), DIMENSION(jpi,jpj) :: zbkg_phynon ! Local phynon bkg 914 #endif 985 INTEGER :: jk ! Loop counter 986 INTEGER :: it ! Index 987 REAL(wp) :: zincwgt ! IAU weight for current time step 988 REAL(wp) :: zincper ! IAU interval in seconds 989 REAL(wp), DIMENSION(jpi,jpj) :: zmld ! Mixed layer depth 990 REAL(wp), DIMENSION(jpi,jpj,1) :: zinc_chltot ! Local chltot incs 991 REAL(wp), DIMENSION(jpi,jpj) :: zbkg_chltot ! Local chltot bkg 992 REAL(wp), DIMENSION(jpi,jpj,1) :: zinc_phytot ! Local phytot incs 993 REAL(wp), DIMENSION(jpi,jpj) :: zbkg_phytot ! Local phytot bkg 994 #if defined key_medusa 995 REAL(wp), DIMENSION(jpi,jpj,1) :: zinc_chldia ! Local chldia incs 996 REAL(wp), DIMENSION(jpi,jpj) :: zbkg_chldia ! Local chldia bkg 997 REAL(wp), DIMENSION(jpi,jpj,1) :: zinc_chlnon ! Local chlnon incs 998 REAL(wp), DIMENSION(jpi,jpj) :: zbkg_chlnon ! Local chlnon bkg 999 REAL(wp), DIMENSION(jpi,jpj,1) :: zinc_phydia ! Local phydia incs 1000 REAL(wp), DIMENSION(jpi,jpj) :: zbkg_phydia ! Local phydia bkg 1001 REAL(wp), DIMENSION(jpi,jpj,1) :: zinc_phynon ! Local phynon incs 1002 REAL(wp), DIMENSION(jpi,jpj) :: zbkg_phynon ! Local phynon bkg 1003 #endif 1004 REAL(wp), DIMENSION(jpi,jpj,1) :: zpgrow_avg_bkg ! Local pgrow_avg_bkg 1005 REAL(wp), DIMENSION(jpi,jpj,1) :: zploss_avg_bkg ! Local ploss_avg_bkg 1006 REAL(wp), DIMENSION(jpi,jpj,1) :: zphyt_avg_bkg ! Local phyt_avg_bkg 915 1007 !!------------------------------------------------------------------------ 916 1008 … … 928 1020 zbkg_chltot(:,:) = chl_bkg(:,:,1) 929 1021 #endif 930 CALL asm_bgc_unlog_2d( zbkg_chltot, slchltot_bkginc, zinc_chltot )1022 CALL asm_bgc_unlog_2d( zbkg_chltot, slchltot_bkginc, zinc_chltot(:,:,1) ) 931 1023 ELSE IF ( ln_schltotinc ) THEN 932 zinc_chltot(:,: ) = schltot_bkginc(:,:)1024 zinc_chltot(:,:,1) = schltot_bkginc(:,:) 933 1025 ELSE 934 zinc_chltot(:,: ) = 0.01026 zinc_chltot(:,:,:) = 0.0 935 1027 ENDIF 936 1028 … … 939 1031 IF ( ln_slchldiainc ) THEN 940 1032 zbkg_chldia(:,:) = tracer_bkg(:,:,1,jpchd) 941 CALL asm_bgc_unlog_2d( zbkg_chldia, slchldia_bkginc, zinc_chldia )1033 CALL asm_bgc_unlog_2d( zbkg_chldia, slchldia_bkginc, zinc_chldia(:,:,1) ) 942 1034 ELSE 943 zinc_chldia(:,: ) = 0.01035 zinc_chldia(:,:,:) = 0.0 944 1036 ENDIF 945 1037 #endif … … 949 1041 IF ( ln_slchlnoninc ) THEN 950 1042 zbkg_chlnon(:,:) = tracer_bkg(:,:,1,jpchn) 951 CALL asm_bgc_unlog_2d( zbkg_chlnon, slchlnon_bkginc, zinc_chlnon )1043 CALL asm_bgc_unlog_2d( zbkg_chlnon, slchlnon_bkginc, zinc_chlnon(:,:,1) ) 952 1044 ELSE 953 zinc_chlnon(:,: ) = 0.01045 zinc_chlnon(:,:,:) = 0.0 954 1046 ENDIF 955 1047 #endif … … 962 1054 zbkg_phytot(:,:) = trn(:,:,1,jp_had_phy) * c2n_p 963 1055 #endif 964 CALL asm_bgc_unlog_2d( zbkg_phytot, slphytot_bkginc, zinc_phytot )1056 CALL asm_bgc_unlog_2d( zbkg_phytot, slphytot_bkginc, zinc_phytot(:,:,1) ) 965 1057 ELSE 966 zinc_phytot(:,: ) = 0.01058 zinc_phytot(:,:,:) = 0.0 967 1059 ENDIF 968 1060 … … 971 1063 IF ( ln_slphydiainc ) THEN 972 1064 zbkg_phydia(:,:) = trn(:,:,1,jpphd) * xthetapd 973 CALL asm_bgc_unlog_2d( zbkg_phydia, slphydia_bkginc, zinc_phydia )1065 CALL asm_bgc_unlog_2d( zbkg_phydia, slphydia_bkginc, zinc_phydia(:,:,1) ) 974 1066 ELSE 975 zinc_phydia(:,: ) = 0.01067 zinc_phydia(:,:,:) = 0.0 976 1068 ENDIF 977 1069 #endif … … 981 1073 IF ( ln_slphynoninc ) THEN 982 1074 zbkg_phynon(:,:) = trn(:,:,1,jpphn) * xthetapn 983 CALL asm_bgc_unlog_2d( zbkg_phynon, slphynon_bkginc, zinc_phynon )1075 CALL asm_bgc_unlog_2d( zbkg_phynon, slphynon_bkginc, zinc_phynon(:,:,1) ) 984 1076 ELSE 985 zinc_phynon(:,: ) = 0.01077 zinc_phynon(:,:,:) = 0.0 986 1078 ENDIF 987 1079 #endif … … 1024 1116 1025 1117 zincper = (nitiaufin_r - nitiaustr_r + 1) * rdt 1026 1027 #if defined key_medusa 1028 CALL asm_phyto2d_bal_medusa( (ln_slchltotinc .OR. ln_schltotinc), & 1029 & zinc_chltot, & 1030 & ln_slchldiainc, & 1031 & zinc_chldia, & 1032 & ln_slchlnoninc, & 1033 & zinc_chlnon, & 1034 & ln_slphytotinc, & 1035 & zinc_phytot, & 1036 & ln_slphydiainc, & 1037 & zinc_phydia, & 1038 & ln_slphynoninc, & 1039 & zinc_phynon, & 1040 & zincper, & 1041 & rn_maxchlinc, ln_phytobal, zmld, & 1042 & pgrow_avg_bkg, ploss_avg_bkg, & 1043 & phyt_avg_bkg, mld_max_bkg, & 1044 & tracer_bkg, phyto2d_balinc ) 1118 1119 zpgrow_avg_bkg(:,:,1) = pgrow_avg_bkg(:,:) 1120 zploss_avg_bkg(:,:,1) = ploss_avg_bkg(:,:) 1121 zphyt_avg_bkg(:,:,1) = phyt_avg_bkg(:,:) 1122 1123 #if defined key_medusa 1124 CALL asm_phyto_bal_medusa( 1, & 1125 & (ln_slchltotinc .OR. ln_schltotinc), & 1126 & zinc_chltot, & 1127 & ln_slchldiainc, & 1128 & zinc_chldia, & 1129 & ln_slchlnoninc, & 1130 & zinc_chlnon, & 1131 & ln_slphytotinc, & 1132 & zinc_phytot, & 1133 & ln_slphydiainc, & 1134 & zinc_phydia, & 1135 & ln_slphynoninc, & 1136 & zinc_phynon, & 1137 & zincper, & 1138 & rn_maxchlinc, ln_phytobal, zmld, & 1139 & zpgrow_avg_bkg, zploss_avg_bkg, & 1140 & zphyt_avg_bkg, mld_max_bkg, & 1141 & tracer_bkg, phyto2d_balinc ) 1045 1142 #elif defined key_hadocc 1046 CALL asm_phyto2d_bal_hadocc( (ln_slchltotinc .OR. ln_schltotinc), & 1047 & zinc_chltot, & 1048 & ln_slphytotinc, & 1049 & zinc_phytot, & 1050 & zincper, & 1051 & rn_maxchlinc, ln_phytobal, zmld, & 1052 & pgrow_avg_bkg, ploss_avg_bkg, & 1053 & phyt_avg_bkg, mld_max_bkg, & 1054 & cchl_p_bkg(:,:,1), & 1055 & tracer_bkg, phyto2d_balinc ) 1143 CALL asm_phyto_bal_hadocc( 1, & 1144 & (ln_slchltotinc .OR. ln_schltotinc), & 1145 & zinc_chltot, & 1146 & ln_slphytotinc, & 1147 & zinc_phytot, & 1148 & zincper, & 1149 & rn_maxchlinc, ln_phytobal, zmld, & 1150 & zpgrow_avg_bkg, zploss_avg_bkg, & 1151 & zphyt_avg_bkg, mld_max_bkg, & 1152 & cchl_p_bkg(:,:,1), & 1153 & tracer_bkg, phyto2d_balinc ) 1056 1154 #else 1057 1155 CALL ctl_stop( 'Attempting to assimilate phyto2d data, ', & … … 1166 1264 INTEGER :: ji, jj, jk ! Loop counters 1167 1265 INTEGER :: it ! Index 1266 REAL(wp) :: zincper ! IAU interval in seconds 1168 1267 REAL(wp) :: zincwgt ! IAU weight for timestep 1169 REAL(wp) :: zfrac_chn ! Fraction of jpchn 1170 REAL(wp) :: zfrac_chd ! Fraction of jpchd 1171 REAL(wp) :: zrat_phn_chn ! jpphn:jpchn ratio 1172 REAL(wp) :: zrat_phd_chd ! jpphd:jpchd ratio 1173 REAL(wp) :: zrat_pds_chd ! jppds:jpchd ratio 1174 REAL(wp), DIMENSION(jpi,jpj,jpk) :: chl_inc ! Chlorophyll increments 1175 REAL(wp), DIMENSION(jpi,jpj,jpk) :: bkg_chl ! Chlorophyll background 1268 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zinc_chltot ! Chlorophyll increments 1269 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zbkg_chltot ! Chlorophyll background 1270 REAL(wp), DIMENSION(jpi,jpj) :: zdummy_2d ! Dummy array for call 1271 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdummy_3d ! Dummy array for call 1176 1272 !!------------------------------------------------------------------------ 1177 1273 … … 1179 1275 1180 1276 IF ( ln_plchltotinc ) THEN 1181 ! Convert log10(chlorophyll) increment back to a chlorophyll increment 1182 ! In order to transform logchl incs to chl incs, need to account for model 1183 ! background, cannot simply do 10^logchl_bkginc. Need to: 1184 ! 1) Add logchl inc to log10(background) to get log10(analysis) 1185 ! 2) Take 10^log10(analysis) to get analysis 1186 ! 3) Subtract background from analysis to get chl incs 1187 ! If rn_maxchlinc > 0 then cap total absolute chlorophyll increment at that value 1188 #if defined key_medusa 1189 bkg_chl(:,:,:) = tracer_bkg(:,:,:,jpchn) + tracer_bkg(:,:,:,jpchd) 1277 #if defined key_medusa 1278 zbkg_chltot(:,:,:) = tracer_bkg(:,:,:,jpchn) + tracer_bkg(:,:,:,jpchd) 1190 1279 #elif defined key_hadocc 1191 bkg_chl(:,:,:) = chl_bkg(:,:,:) 1192 #endif 1193 DO jk = 1, jpk 1194 DO jj = 1, jpj 1195 DO ji = 1, jpi 1196 IF ( bkg_chl(ji,jj,jk) > 0.0 ) THEN 1197 chl_inc(ji,jj,jk) = 10**( LOG10( bkg_chl(ji,jj,jk) ) + plchltot_bkginc(ji,jj,jk) ) - bkg_chl(ji,jj,jk) 1198 IF ( rn_maxchlinc > 0.0 ) THEN 1199 chl_inc(ji,jj,jk) = MAX( -1.0 * rn_maxchlinc, MIN( chl_inc(ji,jj,jk), rn_maxchlinc ) ) 1200 ENDIF 1201 ELSE 1202 chl_inc(ji,jj,jk) = 0.0 1203 ENDIF 1204 END DO 1205 END DO 1206 END DO 1280 zbkg_chltot(:,:,:) = chl_bkg(:,:,:) 1281 #endif 1282 CALL asm_bgc_unlog_3d( zbkg_chltot, plchltot_bkginc, zinc_chltot ) 1207 1283 ELSE IF ( ln_pchltotinc ) THEN 1208 DO jk = 1, jpk 1209 DO jj = 1, jpj 1210 DO ji = 1, jpi 1211 IF ( rn_maxchlinc > 0.0 ) THEN 1212 chl_inc(ji,jj,jk) = MAX( -1.0 * rn_maxchlinc, MIN( pchltot_bkginc(ji,jj,jk), rn_maxchlinc ) ) 1213 ELSE 1214 chl_inc(ji,jj,jk) = pchltot_bkginc(ji,jj,jk) 1215 ENDIF 1216 END DO 1217 END DO 1218 END DO 1219 ENDIF 1220 1221 #if defined key_medusa 1222 ! Loop over each grid point partioning the increments based on existing ratios 1223 DO jk = 1, jpk 1224 DO jj = 1, jpj 1225 DO ji = 1, jpi 1226 IF ( ( tracer_bkg(ji,jj,jk,jpchn) > 0.0 ) .AND. ( tracer_bkg(ji,jj,jk,jpchd) > 0.0 ) ) THEN 1227 zfrac_chn = tracer_bkg(ji,jj,jk,jpchn) / (tracer_bkg(ji,jj,jk,jpchn) + tracer_bkg(ji,jj,jk,jpchd)) 1228 zfrac_chd = 1.0 - zfrac_chn 1229 phyto3d_balinc(ji,jj,jk,jpchn) = chl_inc(ji,jj,jk) * zfrac_chn 1230 phyto3d_balinc(ji,jj,jk,jpchd) = chl_inc(ji,jj,jk) * zfrac_chd 1231 zrat_phn_chn = tracer_bkg(ji,jj,jk,jpphn) / tracer_bkg(ji,jj,jk,jpchn) 1232 zrat_phd_chd = tracer_bkg(ji,jj,jk,jpphd) / tracer_bkg(ji,jj,jk,jpchd) 1233 zrat_pds_chd = tracer_bkg(ji,jj,jk,jppds) / tracer_bkg(ji,jj,jk,jpchd) 1234 phyto3d_balinc(ji,jj,jk,jpphn) = phyto3d_balinc(ji,jj,jk,jpchn) * zrat_phn_chn 1235 phyto3d_balinc(ji,jj,jk,jpphd) = phyto3d_balinc(ji,jj,jk,jpchd) * zrat_phd_chd 1236 phyto3d_balinc(ji,jj,jk,jppds) = phyto3d_balinc(ji,jj,jk,jpchd) * zrat_pds_chd 1237 ENDIF 1238 END DO 1239 END DO 1240 END DO 1284 zinc_chltot(:,:,:) = pchltot_bkginc(:,:,:) 1285 ENDIF 1286 1287 zincper = (nitiaufin_r - nitiaustr_r + 1) * rdt 1288 1289 #if defined key_medusa 1290 CALL asm_phyto_bal_medusa( jpk, & 1291 & (ln_plchltotinc .OR. ln_pchltotinc), & 1292 & zinc_chltot, & 1293 & .FALSE., & 1294 & zdummy_3d, & 1295 & .FALSE., & 1296 & zdummy_3d, & 1297 & .FALSE., & 1298 & zdummy_3d, & 1299 & .FALSE., & 1300 & zdummy_3d, & 1301 & .FALSE., & 1302 & zdummy_3d, & 1303 & zincper, & 1304 & rn_maxchlinc, ln_phytobal, zdummy_2d, & 1305 & pgrow_avg_3d_bkg, ploss_avg_3d_bkg, & 1306 & phyt_avg_3d_bkg, mld_max_bkg, & 1307 & tracer_bkg, phyto3d_balinc ) 1241 1308 #elif defined key_hadocc 1242 phyto3d_balinc(:,:,:,jp_had_phy) = ( cchl_p_bkg(:,:,:) / (mw_carbon * c2n_p) ) * chl_inc(:,:,:) 1243 #else 1244 CALL ctl_stop( 'Attempting to assimilate p(l)chltot, ', & 1309 CALL asm_phyto_bal_hadocc( jpk, & 1310 & (ln_plchltotinc .OR. ln_pchltotinc), & 1311 & zinc_chltot, & 1312 & .FALSE., & 1313 & zdummy_3d, & 1314 & zincper, & 1315 & rn_maxchlinc, ln_phytobal, zdummy_2d, & 1316 & pgrow_avg_3d_bkg, ploss_avg_3d_bkg, & 1317 & phyt_avg_3d_bkg, mld_max_bkg, & 1318 & cchl_p_bkg, & 1319 & tracer_bkg, phyto3d_balinc ) 1320 #else 1321 CALL ctl_stop( 'Attempting to assimilate phyto3d data, ', & 1245 1322 & 'but not defined a biogeochemical model' ) 1246 1323 #endif … … 1423 1500 ! Account for phytoplankton balancing if required 1424 1501 IF ( ln_phytobal ) THEN 1425 dic_bkg_temp(:,:) = tracer_bkg(:,:,1,jpdic) + phyto2d_balinc(:,:,1,jpdic) 1426 alk_bkg_temp(:,:) = tracer_bkg(:,:,1,jpalk) + phyto2d_balinc(:,:,1,jpalk) 1502 IF ( ALLOCATED(phyto2d_balinc) ) THEN 1503 dic_bkg_temp(:,:) = tracer_bkg(:,:,1,jpdic) + phyto2d_balinc(:,:,1,jpdic) 1504 alk_bkg_temp(:,:) = tracer_bkg(:,:,1,jpalk) + phyto2d_balinc(:,:,1,jpalk) 1505 ENDIF 1506 IF ( ALLOCATED(phyto3d_balinc) ) THEN 1507 dic_bkg_temp(:,:) = tracer_bkg(:,:,1,jpdic) + phyto3d_balinc(:,:,1,jpdic) 1508 alk_bkg_temp(:,:) = tracer_bkg(:,:,1,jpalk) + phyto3d_balinc(:,:,1,jpalk) 1509 ENDIF 1427 1510 ELSE 1428 1511 dic_bkg_temp(:,:) = tracer_bkg(:,:,1,jpdic) … … 1437 1520 ! Account for phytoplankton balancing if required 1438 1521 IF ( ln_phytobal ) THEN 1439 dic_bkg_temp(:,:) = tracer_bkg(:,:,1,jp_had_dic) + phyto2d_balinc(:,:,1,jp_had_dic) 1440 alk_bkg_temp(:,:) = tracer_bkg(:,:,1,jp_had_alk) + phyto2d_balinc(:,:,1,jp_had_alk) 1522 IF ( ALLOCATED(phyto2d_balinc) ) THEN 1523 dic_bkg_temp(:,:) = tracer_bkg(:,:,1,jp_had_dic) + phyto2d_balinc(:,:,1,jp_had_dic) 1524 alk_bkg_temp(:,:) = tracer_bkg(:,:,1,jp_had_alk) + phyto2d_balinc(:,:,1,jp_had_alk) 1525 ENDIF 1526 IF ( ALLOCATED(phyto3d_balinc) ) THEN 1527 dic_bkg_temp(:,:) = tracer_bkg(:,:,1,jp_had_dic) + phyto3d_balinc(:,:,1,jp_had_dic) 1528 alk_bkg_temp(:,:) = tracer_bkg(:,:,1,jp_had_alk) + phyto3d_balinc(:,:,1,jp_had_alk) 1529 ENDIF 1441 1530 ELSE 1442 1531 dic_bkg_temp(:,:) = tracer_bkg(:,:,1,jp_had_dic) … … 1669 1758 ! Account for phytoplankton balancing if required 1670 1759 IF ( ln_phytobal ) THEN 1671 dic_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpdic) + phyto2d_balinc(:,:,:,jpdic) 1672 alk_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpalk) + phyto2d_balinc(:,:,:,jpalk) 1673 din_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpdin) + phyto2d_balinc(:,:,:,jpdin) 1674 sil_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpsil) + phyto2d_balinc(:,:,:,jpsil) 1760 IF ( ALLOCATED(phyto2d_balinc) ) THEN 1761 dic_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpdic) + phyto2d_balinc(:,:,:,jpdic) 1762 alk_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpalk) + phyto2d_balinc(:,:,:,jpalk) 1763 din_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpdin) + phyto2d_balinc(:,:,:,jpdin) 1764 sil_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpsil) + phyto2d_balinc(:,:,:,jpsil) 1765 ENDIF 1766 IF ( ALLOCATED(phyto3d_balinc) ) THEN 1767 dic_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpdic) + phyto3d_balinc(:,:,:,jpdic) 1768 alk_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpalk) + phyto3d_balinc(:,:,:,jpalk) 1769 din_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpdin) + phyto3d_balinc(:,:,:,jpdin) 1770 sil_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpsil) + phyto3d_balinc(:,:,:,jpsil) 1771 ENDIF 1675 1772 ELSE 1676 1773 dic_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpdic) … … 1863 1960 it = jpdin 1864 1961 #endif 1865 IF ( ln_phytobal) THEN1962 IF ( ALLOCATED(phyto2d_balinc) ) THEN 1866 1963 pno3_bkginc(:,:,:) = pno3_bkginc(:,:,:) - phyto2d_balinc(:,:,:,it) 1867 1964 ENDIF 1868 IF ( ln_plchltotinc .OR. ln_pchltotinc) THEN1965 IF ( ALLOCATED(phyto3d_balinc) ) THEN 1869 1966 pno3_bkginc(:,:,:) = pno3_bkginc(:,:,:) - phyto3d_balinc(:,:,:,it) 1870 1967 ENDIF … … 1883 1980 #if defined key_medusa 1884 1981 it = jpsil 1885 IF ( ln_phytobal) THEN1982 IF ( ALLOCATED(phyto2d_balinc) ) THEN 1886 1983 psi4_bkginc(:,:,:) = psi4_bkginc(:,:,:) - phyto2d_balinc(:,:,:,it) 1887 1984 ENDIF 1888 IF ( ln_plchltotinc .OR. ln_pchltotinc) THEN1985 IF ( ALLOCATED(phyto3d_balinc) ) THEN 1889 1986 psi4_bkginc(:,:,:) = psi4_bkginc(:,:,:) - phyto3d_balinc(:,:,:,it) 1890 1987 ENDIF … … 1907 2004 it = jpdic 1908 2005 #endif 1909 IF ( ln_phytobal) THEN2006 IF ( ALLOCATED(phyto2d_balinc) ) THEN 1910 2007 pdic_bkginc(:,:,:) = pdic_bkginc(:,:,:) - phyto2d_balinc(:,:,:,it) 1911 2008 ENDIF 1912 IF ( ln_plchltotinc .OR. ln_pchltotinc) THEN2009 IF ( ALLOCATED(phyto3d_balinc) ) THEN 1913 2010 pdic_bkginc(:,:,:) = pdic_bkginc(:,:,:) - phyto3d_balinc(:,:,:,it) 1914 2011 ENDIF … … 1931 2028 it = jpalk 1932 2029 #endif 1933 IF ( ln_phytobal) THEN2030 IF ( ALLOCATED(phyto2d_balinc) ) THEN 1934 2031 palk_bkginc(:,:,:) = palk_bkginc(:,:,:) - phyto2d_balinc(:,:,:,it) 1935 2032 ENDIF 1936 IF ( ln_plchltotinc .OR. ln_pchltotinc) THEN2033 IF ( ALLOCATED(phyto3d_balinc) ) THEN 1937 2034 palk_bkginc(:,:,:) = palk_bkginc(:,:,:) - phyto3d_balinc(:,:,:,it) 1938 2035 ENDIF … … 1951 2048 #if defined key_medusa 1952 2049 it = jpoxy 1953 IF ( ln_phytobal) THEN2050 IF ( ALLOCATED(phyto2d_balinc) ) THEN 1954 2051 po2_bkginc(:,:,:) = po2_bkginc(:,:,:) - phyto2d_balinc(:,:,:,it) 1955 2052 ENDIF 1956 IF ( ln_plchltotinc .OR. ln_pchltotinc) THEN2053 IF ( ALLOCATED(phyto3d_balinc) ) THEN 1957 2054 po2_bkginc(:,:,:) = po2_bkginc(:,:,:) - phyto3d_balinc(:,:,:,it) 1958 2055 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.