Changeset 13097
- Timestamp:
- 2020-06-11T19:32:37+02:00 (5 years ago)
- Location:
- branches/UKMO/dev_r5518_GO6_package_FOAMv14_phytobal3d/NEMOGCM/NEMO
- Files:
-
- 5 edited
- 2 moved
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 -
branches/UKMO/dev_r5518_GO6_package_FOAMv14_phytobal3d/NEMOGCM/NEMO/OPA_SRC/ASM/asmphytobal_hadocc.F90
r13096 r13097 1 MODULE asmphyto 2dbal_hadocc1 MODULE asmphytobal_hadocc 2 2 !!====================================================================== 3 !! *** MODULE asmphyto 2dbal_hadocc ***4 !! Calculate increments to HadOCC based on surface phyto 2dincrements3 !! *** MODULE asmphytobal_hadocc *** 4 !! Calculate increments to HadOCC based on surface phyto increments 5 5 !! 6 6 !! IMPORTANT NOTE: This calls the bioanalysis routine of Hemmings et al. … … 17 17 !! 'key_hadocc' : HadOCC model 18 18 !!---------------------------------------------------------------------- 19 !! asm_phyto 2d_bal_hadocc : routine to calculate increments to HadOCC19 !! asm_phyto_bal_hadocc : routine to calculate increments to HadOCC 20 20 !!---------------------------------------------------------------------- 21 21 USE par_kind, ONLY: wp ! kind parameters … … 32 32 PRIVATE 33 33 34 PUBLIC asm_phyto 2d_bal_hadocc34 PUBLIC asm_phyto_bal_hadocc 35 35 36 36 ! Default values for biological assimilation parameters … … 67 67 CONTAINS 68 68 69 SUBROUTINE asm_phyto2d_bal_hadocc( ld_chltot, & 70 & pinc_chltot, & 71 & ld_phytot, & 72 & pinc_phytot, & 73 & pincper, & 74 & p_maxchlinc, ld_phytobal, pmld, & 75 & pgrow_avg_bkg, ploss_avg_bkg, & 76 & phyt_avg_bkg, mld_max_bkg, & 77 & cchl_p_bkg, & 78 & tracer_bkg, phyto2d_balinc ) 69 SUBROUTINE asm_phyto_bal_hadocc( kdeps, & 70 & ld_chltot, & 71 & pinc_chltot_3d, & 72 & ld_phytot, & 73 & pinc_phytot_3d, & 74 & pincper, & 75 & p_maxchlinc, ld_phytobal, pmld, & 76 & pgrow_avg_bkg_3d, ploss_avg_bkg_3d, & 77 & phyt_avg_bkg_3d, mld_max_bkg, & 78 & cchl_p_bkg_3d, & 79 & tracer_bkg, phyto_balinc ) 79 80 !!--------------------------------------------------------------------------- 80 !! *** ROUTINE asm_phyto 2d_bal_hadocc ***81 !! *** ROUTINE asm_phyto_bal_hadocc *** 81 82 !! 82 83 !! ** Purpose : calculate increments to HadOCC from 2d phytoplankton increments … … 84 85 !! ** Method : call nitrogen balancing scheme 85 86 !! 86 !! ** Action : populate phyto 2d_balinc87 !! ** Action : populate phyto_balinc 87 88 !! 88 89 !! References : Hemmings et al., 2008, J. Mar. Res. … … 90 91 !!--------------------------------------------------------------------------- 91 92 !! 92 LOGICAL, INTENT(in ) :: ld_chltot ! Assim chltot y/n 93 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: pinc_chltot ! chltot increments 94 LOGICAL, INTENT(in ) :: ld_phytot ! Assim phytot y/n 95 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: pinc_phytot ! phytot increments 96 REAL(wp), INTENT(in ) :: pincper ! Assimilation period 97 REAL(wp), INTENT(in ) :: p_maxchlinc ! Max chl increment 98 LOGICAL, INTENT(in ) :: ld_phytobal ! Balancing y/n 99 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: pmld ! Mixed layer depth 100 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: pgrow_avg_bkg ! Avg phyto growth 101 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: ploss_avg_bkg ! Avg phyto loss 102 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: phyt_avg_bkg ! Avg phyto 103 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: mld_max_bkg ! Max MLD 104 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: cchl_p_bkg ! Surface C:Chl 105 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj,jpk,jptra) :: tracer_bkg ! State variables 106 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk,jptra) :: phyto2d_balinc ! Balancing increments 107 !! 108 INTEGER :: ji, jj, jk, jn ! Loop counters 109 INTEGER :: jkmax ! Loop index 110 INTEGER, DIMENSION(6) :: i_tracer ! Tracer indices 111 REAL(wp), DIMENSION(16) :: modparm ! Model parameters 112 REAL(wp), DIMENSION(20) :: assimparm ! Assimilation parameters 113 REAL(wp), DIMENSION(jpi,jpj,jpk,6) :: bstate ! Background state 114 REAL(wp), DIMENSION(jpi,jpj,jpk,6) :: outincs ! Balancing increments 115 REAL(wp), DIMENSION(jpi,jpj,22) :: diag ! Depth-indep diagnostics 116 REAL(wp), DIMENSION(jpi,jpj,jpk,22) :: diag_fulldepth ! Full-depth diagnostics 93 INTEGER, INTENT(in ) :: kdeps ! No. inc deps 1 or jpk 94 LOGICAL, INTENT(in ) :: ld_chltot ! Assim chltot y/n 95 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,kdeps) :: pinc_chltot_3d ! chltot increments 96 LOGICAL, INTENT(in ) :: ld_phytot ! Assim phytot y/n 97 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,kdeps) :: pinc_phytot_3d ! phytot increments 98 REAL(wp), INTENT(in ) :: pincper ! Assimilation period 99 REAL(wp), INTENT(in ) :: p_maxchlinc ! Max chl increment 100 LOGICAL, INTENT(in ) :: ld_phytobal ! Balancing y/n 101 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: pmld ! Mixed layer depth 102 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj,kdeps) :: pgrow_avg_bkg_3d ! Avg phyto growth 103 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj,kdeps) :: ploss_avg_bkg_3d ! Avg phyto loss 104 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj,kdeps) :: phyt_avg_bkg_3d ! Avg phyto 105 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: mld_max_bkg ! Max MLD 106 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj,kdeps) :: cchl_p_bkg_3d ! C:Chl 107 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj,jpk,jptra) :: tracer_bkg ! State variables 108 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk,jptra) :: phyto_balinc ! Balancing increments 109 !! 110 INTEGER :: ji, jj, jk, jn ! Loop counters 111 INTEGER :: jkmax ! Loop index 112 INTEGER, DIMENSION(6) :: i_tracer ! Tracer indices 113 REAL(wp), DIMENSION(16) :: modparm ! Model parameters 114 REAL(wp), DIMENSION(20) :: assimparm ! Assimilation parameters 115 REAL(wp), DIMENSION(jpi,jpj,1,6) :: bstate_2d ! Background state (2D) 116 REAL(wp), DIMENSION(jpi,jpj,jpk,6) :: bstate_3d ! Background state (3D) 117 REAL(wp), DIMENSION(jpi,jpj,1,6) :: outincs_2d ! Balancing increments (2D) 118 REAL(wp), DIMENSION(jpi,jpj,jpk,6) :: outincs_3d ! Balancing increments (3D) 119 REAL(wp), DIMENSION(jpi,jpj,22) :: diag ! Depth-indep diagnostics 120 REAL(wp), DIMENSION(jpi,jpj,1,22) :: diag_fulldepth_2d ! Full-depth diagnostics (2D) 121 REAL(wp), DIMENSION(jpi,jpj,jpk,22) :: diag_fulldepth_3d ! Full-depth diagnostics (3D) 122 REAL(wp), DIMENSION(jpi,jpj) :: cchl_p_bkg_2d ! C:Chl for total phy (2D) 123 REAL(wp), DIMENSION(jpi,jpj,1) :: tmask_2d ! Single-level tmask 124 REAL(wp), DIMENSION(jpi,jpj) :: pinc_chltot_2d ! chltot increments (2D) 125 REAL(wp), DIMENSION(jpi,jpj) :: pinc_phytot_2d ! phytot increments (2D) 126 REAL(wp), DIMENSION(jpi,jpj) :: pgrow_avg_bkg_2d ! Avg phyto growth (2D) 127 REAL(wp), DIMENSION(jpi,jpj) :: ploss_avg_bkg_2d ! Avg phyto loss (2D) 128 REAL(wp), DIMENSION(jpi,jpj) :: phyt_avg_bkg_2d ! Avg phyto (2D) 117 129 !!--------------------------------------------------------------------------- 118 130 119 131 IF ( ( .NOT. ld_chltot ) .AND. ( .NOT. ld_phytot ) ) THEN 120 CALL ctl_stop( ' Trying to do phyto 2dbalancing but nothing to assimilate' )132 CALL ctl_stop( ' Trying to do phyto balancing but nothing to assimilate' ) 121 133 ENDIF 122 134 … … 124 136 IF ( p_maxchlinc > 0.0 ) THEN 125 137 IF ( ld_chltot ) THEN 126 DO jj = 1, jpj 127 DO ji = 1, jpi 128 pinc_chltot(ji,jj) = MAX( -1.0 * p_maxchlinc, MIN( pinc_chltot(ji,jj), p_maxchlinc ) ) 138 DO jk = 1, kdeps 139 DO jj = 1, jpj 140 DO ji = 1, jpi 141 pinc_chltot_3d(ji,jj,jk) = MAX( -1.0 * p_maxchlinc, MIN( pinc_chltot_3d(ji,jj,jk), p_maxchlinc ) ) 142 END DO 129 143 END DO 130 144 END DO … … 187 201 188 202 ! Set background state 189 bstate (:,:,:,i_tracer(1)) = tracer_bkg(:,:,:,jp_had_nut)190 bstate (:,:,:,i_tracer(2)) = tracer_bkg(:,:,:,jp_had_phy)191 bstate (:,:,:,i_tracer(3)) = tracer_bkg(:,:,:,jp_had_zoo)192 bstate (:,:,:,i_tracer(4)) = tracer_bkg(:,:,:,jp_had_pdn)193 bstate (:,:,:,i_tracer(5)) = tracer_bkg(:,:,:,jp_had_dic)194 bstate (:,:,:,i_tracer(6)) = tracer_bkg(:,:,:,jp_had_alk)203 bstate_3d(:,:,:,i_tracer(1)) = tracer_bkg(:,:,:,jp_had_nut) 204 bstate_3d(:,:,:,i_tracer(2)) = tracer_bkg(:,:,:,jp_had_phy) 205 bstate_3d(:,:,:,i_tracer(3)) = tracer_bkg(:,:,:,jp_had_zoo) 206 bstate_3d(:,:,:,i_tracer(4)) = tracer_bkg(:,:,:,jp_had_pdn) 207 bstate_3d(:,:,:,i_tracer(5)) = tracer_bkg(:,:,:,jp_had_dic) 208 bstate_3d(:,:,:,i_tracer(6)) = tracer_bkg(:,:,:,jp_had_alk) 195 209 196 210 ! Call nitrogen balancing routine 197 CALL bio_analysis( jpi, jpj, jpk, ZDZ(:,:,:), i_tracer, modparm, & 198 & n2be_p, n2be_z, n2be_d, assimparm, & 199 & INT(pincper), 1, kmt(:,:), tmask(:,:,:), & 200 & pmld(:,:), mld_max_bkg(:,:), pinc_chltot(:,:), cchl_p_bkg(:,:), & 201 & nbal_active, phyt_avg_bkg(:,:), & 202 & gl_active, pgrow_avg_bkg(:,:), ploss_avg_bkg(:,:), & 203 & subsurf_active, deepneg_active, & 204 & deeppos_active, nutprof_active, & 205 & bstate, outincs, & 206 & diag_active, diag, & 207 & diag_fulldepth_active, diag_fulldepth ) 211 IF (kdeps == 1) THEN 212 pinc_chltot_2d(:,:) = pinc_chltot_3d(:,:,1) 213 cchl_p_bkg_2d(:,:) = cchl_p_bkg_3d(:,:,1) 214 phyt_avg_bkg_2d(:,:) = phyt_avg_bkg_3d(:,:,1) 215 pgrow_avg_bkg_2d(:,:) = pgrow_avg_bkg_3d(:,:,1) 216 ploss_avg_bkg_2d(:,:) = ploss_avg_bkg_3d(:,:,1) 217 218 CALL bio_analysis( jpi, jpj, jpk, ZDZ(:,:,:), i_tracer, modparm, & 219 & n2be_p, n2be_z, n2be_d, assimparm, & 220 & INT(pincper), 1, kmt(:,:), tmask(:,:,:), & 221 & pmld(:,:), mld_max_bkg(:,:), pinc_chltot_2d(:,:), cchl_p_bkg_2d(:,:), & 222 & nbal_active, phyt_avg_bkg_2d(:,:), & 223 & gl_active, pgrow_avg_bkg_2d(:,:), ploss_avg_bkg_2d(:,:), & 224 & subsurf_active, deepneg_active, & 225 & deeppos_active, nutprof_active, & 226 & bstate_3d, outincs_3d, & 227 & diag_active, diag, & 228 & diag_fulldepth_active, diag_fulldepth_3d ) 229 ELSE 230 pmld(:,:) = 0.5 231 232 DO jk = 1, kdeps 233 pinc_chltot_2d(:,:) = pinc_chltot_3d(:,:,jk) 234 cchl_p_bkg_2d(:,:) = cchl_p_bkg_3d(:,:,jk) 235 phyt_avg_bkg_2d(:,:) = phyt_avg_bkg_3d(:,:,jk) 236 pgrow_avg_bkg_2d(:,:) = pgrow_avg_bkg_3d(:,:,jk) 237 ploss_avg_bkg_2d(:,:) = ploss_avg_bkg_3d(:,:,jk) 238 tmask_2d(:,:,1) = tmask(:,:,jk) 239 bstate_2d(:,:,1,:) = bstate_3d(:,:,jk,:) 240 outincs_2d(:,:,:,:) = 0.0 241 242 CALL bio_analysis( jpi, jpj, 1, gdepw_n(:,:,2), i_tracer, modparm, & 243 & n2be_p, n2be_z, n2be_d, assimparm, & 244 & INT(pincper), 1, INT(SUM(tmask_2d,3)), tmask_2d(:,:,:), & 245 & pmld(:,:), pmld(:,:), pinc_chltot_2d(:,:), cchl_p_bkg_2d(:,:), & 246 & nbal_active, phyt_avg_bkg_2d(:,:), & 247 & gl_active, pgrow_avg_bkg_2d(:,:), ploss_avg_bkg_2d(:,:), & 248 & subsurf_active, deepneg_active, & 249 & deeppos_active, nutprof_active, & 250 & bstate_2d, outincs_2d, & 251 & diag_active, diag, & 252 & diag_fulldepth_active, diag_fulldepth_2d ) 253 254 outincs_3d(:,:,jk,:) = outincs_2d(:,:,1,:) 255 END DO 256 ENDIF 208 257 209 258 ! Save balancing increments 210 phyto 2d_balinc(:,:,:,jp_had_nut) = outincs(:,:,:,i_tracer(1))211 phyto 2d_balinc(:,:,:,jp_had_phy) = outincs(:,:,:,i_tracer(2))212 phyto 2d_balinc(:,:,:,jp_had_zoo) = outincs(:,:,:,i_tracer(3))213 phyto 2d_balinc(:,:,:,jp_had_pdn) = outincs(:,:,:,i_tracer(4))214 phyto 2d_balinc(:,:,:,jp_had_dic) = outincs(:,:,:,i_tracer(5))215 phyto 2d_balinc(:,:,:,jp_had_alk) = outincs(:,:,:,i_tracer(6))259 phyto_balinc(:,:,:,jp_had_nut) = outincs_3d(:,:,:,i_tracer(1)) 260 phyto_balinc(:,:,:,jp_had_phy) = outincs_3d(:,:,:,i_tracer(2)) 261 phyto_balinc(:,:,:,jp_had_zoo) = outincs_3d(:,:,:,i_tracer(3)) 262 phyto_balinc(:,:,:,jp_had_pdn) = outincs_3d(:,:,:,i_tracer(4)) 263 phyto_balinc(:,:,:,jp_had_dic) = outincs_3d(:,:,:,i_tracer(5)) 264 phyto_balinc(:,:,:,jp_had_alk) = outincs_3d(:,:,:,i_tracer(6)) 216 265 217 266 ELSE ! No nitrogen balancing 218 267 219 268 ! Initialise phytoplankton increment to zero 220 phyto 2d_balinc(:,:,:,jp_had_phy) = 0.0269 phyto_balinc(:,:,:,jp_had_phy) = 0.0 221 270 222 271 ! Convert surface chlorophyll increment to phytoplankton nitrogen 223 phyto2d_balinc(:,:,1,jp_had_phy) = ( cchl_p_bkg(:,:) / (mw_carbon * c2n_p) ) * pinc_chltot(:,:) 272 DO jk = 1, kdeps 273 phyto_balinc(:,:,jk,jp_had_phy) = ( cchl_p_bkg_3d(:,:,jk) / (mw_carbon * c2n_p) ) * pinc_chltot_3d(:,:,jk) 274 END DO 224 275 225 ! Propagate through mixed layer 226 DO jj = 1, jpj 227 DO ji = 1, jpi 228 ! 229 jkmax = jpk-1 230 DO jk = jpk-1, 1, -1 231 IF ( ( pmld(ji,jj) > gdepw_n(ji,jj,jk) ) .AND. & 232 & ( pmld(ji,jj) <= gdepw_n(ji,jj,jk+1) ) ) THEN 233 pmld(ji,jj) = gdepw_n(ji,jj,jk+1) 234 jkmax = jk 235 ENDIF 276 IF (kdeps == 1) THEN 277 ! Propagate through mixed layer 278 DO jj = 1, jpj 279 DO ji = 1, jpi 280 ! 281 jkmax = jpk-1 282 DO jk = jpk-1, 1, -1 283 IF ( ( pmld(ji,jj) > gdepw_n(ji,jj,jk) ) .AND. & 284 & ( pmld(ji,jj) <= gdepw_n(ji,jj,jk+1) ) ) THEN 285 pmld(ji,jj) = gdepw_n(ji,jj,jk+1) 286 jkmax = jk 287 ENDIF 288 END DO 289 ! 290 DO jk = 2, jkmax 291 phyto_balinc(ji,jj,jk,jp_had_phy) = phyto_balinc(ji,jj,1,jp_had_phy) 292 END DO 293 ! 236 294 END DO 237 !238 DO jk = 2, jkmax239 phyto2d_balinc(ji,jj,jk,jp_had_phy) = phyto2d_balinc(ji,jj,1,jp_had_phy)240 END DO241 !242 295 END DO 243 END DO296 ENDIF 244 297 245 298 ! Set other balancing increments to zero 246 phyto 2d_balinc(:,:,:,jp_had_nut) = 0.0247 phyto 2d_balinc(:,:,:,jp_had_zoo) = 0.0248 phyto 2d_balinc(:,:,:,jp_had_pdn) = 0.0249 phyto 2d_balinc(:,:,:,jp_had_dic) = 0.0250 phyto 2d_balinc(:,:,:,jp_had_alk) = 0.0299 phyto_balinc(:,:,:,jp_had_nut) = 0.0 300 phyto_balinc(:,:,:,jp_had_zoo) = 0.0 301 phyto_balinc(:,:,:,jp_had_pdn) = 0.0 302 phyto_balinc(:,:,:,jp_had_dic) = 0.0 303 phyto_balinc(:,:,:,jp_had_alk) = 0.0 251 304 252 305 ENDIF 253 306 254 END SUBROUTINE asm_phyto 2d_bal_hadocc307 END SUBROUTINE asm_phyto_bal_hadocc 255 308 256 309 #else … … 259 312 !!---------------------------------------------------------------------- 260 313 CONTAINS 261 SUBROUTINE asm_phyto2d_bal_hadocc( ld_chltot, & 262 & pinc_chltot, & 263 & ld_phytot, & 264 & pinc_phytot, & 265 & pincper, & 266 & p_maxchlinc, ld_phytobal, pmld, & 267 & pgrow_avg_bkg, ploss_avg_bkg, & 268 & phyt_avg_bkg, mld_max_bkg, & 269 & cchl_p_bkg, & 270 & tracer_bkg, phyto2d_balinc ) 314 SUBROUTINE asm_phyto_bal_hadocc( kdeps, & 315 & ld_chltot, & 316 & pinc_chltot_3d, & 317 & ld_phytot, & 318 & pinc_phytot, & 319 & pincper, & 320 & p_maxchlinc, ld_phytobal, pmld, & 321 & pgrow_avg_bkg_3d, ploss_avg_bkg_3d, & 322 & phyt_avg_bkg_3d, mld_max_bkg, & 323 & cchl_p_bkg_3d, & 324 & tracer_bkg, phyto_balinc ) 325 INTEGER :: kdeps 271 326 LOGICAL :: ld_chltot 272 REAL :: pinc_chltot (:,:)327 REAL :: pinc_chltot_3d(:,:,:) 273 328 LOGICAL :: ld_phytot 274 REAL :: pinc_phytot (:,:)329 REAL :: pinc_phytot_3d(:,:,:) 275 330 REAL :: pincper 276 331 REAL :: p_maxchlinc 277 332 LOGICAL :: ld_phytobal 278 333 REAL :: pmld(:,:) 279 REAL :: pgrow_avg_bkg (:,:)280 REAL :: ploss_avg_bkg (:,:)281 REAL :: phyt_avg_bkg (:,:)334 REAL :: pgrow_avg_bkg_3d(:,:,:) 335 REAL :: ploss_avg_bkg_3d(:,:,:) 336 REAL :: phyt_avg_bkg_3d(:,:,:) 282 337 REAL :: mld_max_bkg(:,:) 283 REAL :: cchl_p_bkg (:,:)338 REAL :: cchl_p_bkg_3d(:,:,:) 284 339 REAL :: tracer_bkg(:,:,:,:) 285 REAL :: phyto 2d_balinc(:,:,:,:)286 WRITE(*,*) 'asm_phyto 2d_bal_hadocc: You should not have seen this print! error?'287 END SUBROUTINE asm_phyto 2d_bal_hadocc340 REAL :: phyto_balinc(:,:,:,:) 341 WRITE(*,*) 'asm_phyto_bal_hadocc: You should not have seen this print! error?' 342 END SUBROUTINE asm_phyto_bal_hadocc 288 343 #endif 289 344 290 345 !!====================================================================== 291 END MODULE asmphyto 2dbal_hadocc346 END MODULE asmphytobal_hadocc -
branches/UKMO/dev_r5518_GO6_package_FOAMv14_phytobal3d/NEMOGCM/NEMO/OPA_SRC/ASM/asmphytobal_medusa.F90
r13096 r13097 1 MODULE asmphyto 2dbal_medusa1 MODULE asmphytobal_medusa 2 2 !!====================================================================== 3 3 !! *** MODULE asmphyto2dbal_medusa *** … … 33 33 PRIVATE 34 34 35 PUBLIC asm_phyto 2d_bal_medusa35 PUBLIC asm_phyto_bal_medusa 36 36 37 37 ! Default values for biological assimilation parameters … … 68 68 CONTAINS 69 69 70 SUBROUTINE asm_phyto2d_bal_medusa( ld_chltot, & 71 & pinc_chltot, & 72 & ld_chldia, & 73 & pinc_chldia, & 74 & ld_chlnon, & 75 & pinc_chlnon, & 76 & ld_phytot, & 77 & pinc_phytot, & 78 & ld_phydia, & 79 & pinc_phydia, & 80 & ld_phynon, & 81 & pinc_phynon, & 82 & pincper, & 83 & p_maxchlinc, ld_phytobal, pmld, & 84 & pgrow_avg_bkg, ploss_avg_bkg, & 85 & phyt_avg_bkg, mld_max_bkg, & 86 & tracer_bkg, phyto2d_balinc ) 70 SUBROUTINE asm_phyto_bal_medusa( kdeps, & 71 & ld_chltot, & 72 & pinc_chltot_3d, & 73 & ld_chldia, & 74 & pinc_chldia_3d, & 75 & ld_chlnon, & 76 & pinc_chlnon_3d, & 77 & ld_phytot, & 78 & pinc_phytot_3d, & 79 & ld_phydia, & 80 & pinc_phydia_3d, & 81 & ld_phynon, & 82 & pinc_phynon_3d, & 83 & pincper, & 84 & p_maxchlinc, ld_phytobal, pmld, & 85 & pgrow_avg_bkg_3d, ploss_avg_bkg_3d, & 86 & phyt_avg_bkg_3d, mld_max_bkg, & 87 & tracer_bkg, phyto_balinc ) 87 88 !!--------------------------------------------------------------------------- 88 !! *** ROUTINE asm_phyto 2d_bal_medusa ***89 !! *** ROUTINE asm_phyto_bal_medusa *** 89 90 !! 90 !! ** Purpose : calculate increments to MEDUSA from 2dphytoplankton increments91 !! ** Purpose : calculate increments to MEDUSA from phytoplankton increments 91 92 !! 92 93 !! ** Method : average up MEDUSA to look like HadOCC … … 94 95 !! separate back out to MEDUSA 95 96 !! 96 !! ** Action : populate phyto 2d_balinc97 !! ** Action : populate phyto_balinc 97 98 !! 98 99 !! References : Hemmings et al., 2008, J. Mar. Res. … … 100 101 !!--------------------------------------------------------------------------- 101 102 !! 102 LOGICAL, INTENT(in ) :: ld_chltot ! Assim chltot y/n 103 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: pinc_chltot ! chltot increments 104 LOGICAL, INTENT(in ) :: ld_chldia ! Assim chldia y/n 105 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: pinc_chldia ! chldia increments 106 LOGICAL, INTENT(in ) :: ld_chlnon ! Assim chlnon y/n 107 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: pinc_chlnon ! chlnon increments 108 LOGICAL, INTENT(in ) :: ld_phytot ! Assim phytot y/n 109 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: pinc_phytot ! phytot increments 110 LOGICAL, INTENT(in ) :: ld_phydia ! Assim phydia y/n 111 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: pinc_phydia ! phydia increments 112 LOGICAL, INTENT(in ) :: ld_phynon ! Assim phynon y/n 113 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: pinc_phynon ! phynon increments 114 REAL(wp), INTENT(in ) :: pincper ! Assimilation period 115 REAL(wp), INTENT(in ) :: p_maxchlinc ! Max chl increment 116 LOGICAL, INTENT(in ) :: ld_phytobal ! Balancing y/n 117 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: pmld ! Mixed layer depth 118 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: pgrow_avg_bkg ! Avg phyto growth 119 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: ploss_avg_bkg ! Avg phyto loss 120 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: phyt_avg_bkg ! Avg phyto 121 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: mld_max_bkg ! Max MLD 122 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj,jpk,jptra) :: tracer_bkg ! State variables 123 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk,jptra) :: phyto2d_balinc ! Balancing increments 103 INTEGER, INTENT(in ) :: kdeps ! No. inc deps 1 or jpk 104 LOGICAL, INTENT(in ) :: ld_chltot ! Assim chltot y/n 105 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,kdeps) :: pinc_chltot_3d ! chltot increments (3D) 106 LOGICAL, INTENT(in ) :: ld_chldia ! Assim chldia y/n 107 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,kdeps) :: pinc_chldia_3d ! chldia increments (3D) 108 LOGICAL, INTENT(in ) :: ld_chlnon ! Assim chlnon y/n 109 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,kdeps) :: pinc_chlnon_3d ! chlnon increments (3D) 110 LOGICAL, INTENT(in ) :: ld_phytot ! Assim phytot y/n 111 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,kdeps) :: pinc_phytot_3d ! phytot increments (3D) 112 LOGICAL, INTENT(in ) :: ld_phydia ! Assim phydia y/n 113 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,kdeps) :: pinc_phydia_3d ! phydia increments (3D) 114 LOGICAL, INTENT(in ) :: ld_phynon ! Assim phynon y/n 115 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,kdeps) :: pinc_phynon_3d ! phynon increments (3D) 116 REAL(wp), INTENT(in ) :: pincper ! Assimilation period 117 REAL(wp), INTENT(in ) :: p_maxchlinc ! Max chl increment 118 LOGICAL, INTENT(in ) :: ld_phytobal ! Balancing y/n 119 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: pmld ! Mixed layer depth 120 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj,kdeps) :: pgrow_avg_bkg_3d ! Avg phyto growth (3D) 121 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj,kdeps) :: ploss_avg_bkg_3d ! Avg phyto loss (3D) 122 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj,kdeps) :: phyt_avg_bkg_3d ! Avg phyto (3D) 123 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: mld_max_bkg ! Max MLD 124 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj,jpk,jptra) :: tracer_bkg ! State variables 125 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk,jptra) :: phyto_balinc ! Balancing increments 124 126 !! 125 127 INTEGER :: ji, jj, jk, jn ! Loop counters 126 128 INTEGER :: jkmax ! Loop index 129 INTEGER :: jkinc ! Loop index 127 130 INTEGER, DIMENSION(6) :: i_tracer ! Tracer indices 128 131 REAL(wp) :: n2be_p ! N:biomass for total phy … … 143 146 REAL(wp) :: zrat_pds_chd ! Ratio of jppds:jpchd 144 147 REAL(wp) :: zrat_dtc_det ! Ratio of jpdtc:jpdet 145 REAL(wp), DIMENSION(jpi,jpj) :: cchl_p ! C:Chl for total phy 148 REAL(wp), DIMENSION(jpi,jpj) :: cchl_p_2d ! C:Chl for total phy (2D) 149 REAL(wp), DIMENSION(jpi,jpj,jpk) :: cchl_p_3d ! C:Chl for total phy (3D) 146 150 REAL(wp), DIMENSION(16) :: modparm ! Model parameters 147 151 REAL(wp), DIMENSION(20) :: assimparm ! Assimilation parameters 148 REAL(wp), DIMENSION(jpi,jpj,jpk,6) :: bstate ! Background state 149 REAL(wp), DIMENSION(jpi,jpj,jpk,6) :: outincs ! Balancing increments 150 REAL(wp), DIMENSION(jpi,jpj,22) :: diag ! Depth-indep diagnostics 151 REAL(wp), DIMENSION(jpi,jpj,jpk,22) :: diag_fulldepth ! Full-depth diagnostics 152 REAL(wp), DIMENSION(jpi,jpj,1,6) :: bstate_2d ! Background state (2D) 153 REAL(wp), DIMENSION(jpi,jpj,jpk,6) :: bstate_3d ! Background state (3D) 154 REAL(wp), DIMENSION(jpi,jpj,1,6) :: outincs_2d ! Balancing increments (2D) 155 REAL(wp), DIMENSION(jpi,jpj,jpk,6) :: outincs_3d ! Balancing increments (3D) 156 REAL(wp), DIMENSION(jpi,jpj,22) :: diag ! Depth-indep diagnostics 157 REAL(wp), DIMENSION(jpi,jpj,1,22) :: diag_fulldepth_2d ! Full-depth diagnostics (2D) 158 REAL(wp), DIMENSION(jpi,jpj,jpk,22) :: diag_fulldepth_3d ! Full-depth diagnostics (3D) 159 REAL(wp), DIMENSION(jpi,jpj,1) :: tmask_2d ! Single-level tmask 160 REAL(wp), DIMENSION(jpi,jpj) :: pinc_chltot_2d ! chltot increments (2D) 161 REAL(wp), DIMENSION(jpi,jpj) :: pinc_chldia_2d ! chldia increments (2D) 162 REAL(wp), DIMENSION(jpi,jpj) :: pinc_chlnon_2d ! chlnon increments (2D) 163 REAL(wp), DIMENSION(jpi,jpj) :: pinc_phytot_2d ! phytot increments (2D) 164 REAL(wp), DIMENSION(jpi,jpj) :: pinc_phydia_2d ! phydia increments (2D) 165 REAL(wp), DIMENSION(jpi,jpj) :: pinc_phynon_2d ! phynon increments (2D) 166 REAL(wp), DIMENSION(jpi,jpj) :: pgrow_avg_bkg_2d ! Avg phyto growth (2D) 167 REAL(wp), DIMENSION(jpi,jpj) :: ploss_avg_bkg_2d ! Avg phyto loss (2D) 168 REAL(wp), DIMENSION(jpi,jpj) :: phyt_avg_bkg_2d ! Avg phyto (2D) 152 169 !!--------------------------------------------------------------------------- 153 170 154 171 ! If p_maxchlinc > 0 then cap total absolute chlorophyll increment at that value 155 172 IF ( p_maxchlinc > 0.0 ) THEN 156 IF ( ld_chltot ) THEN173 DO jk = 1, kdeps 157 174 DO jj = 1, jpj 158 175 DO ji = 1, jpi 159 pinc_chltot(ji,jj) = MAX( -1.0 * p_maxchlinc, MIN( pinc_chltot(ji,jj), p_maxchlinc ) ) 176 IF ( ld_chltot ) THEN 177 pinc_chltot_3d(ji,jj,jk) = MAX( -1.0 * p_maxchlinc, MIN( pinc_chltot_3d(ji,jj,jk), p_maxchlinc ) ) 178 ELSE IF ( ld_chldia .AND. ld_chlnon ) THEN 179 pinc_chltot_3d(ji,jj,jk) = pinc_chldia_3d(ji,jj,jk) + pinc_chlnon_3d(ji,jj,jk) 180 pinc_chltot_3d(ji,jj,jk) = MAX( -1.0 * p_maxchlinc, MIN( pinc_chltot_3d(ji,jj,jk), p_maxchlinc ) ) 181 IF ( pinc_chltot_3d(ji,jj,jk) .NE. ( pinc_chldia_3d(ji,jj,jk) + pinc_chlnon_3d(ji,jj,jk) ) ) THEN 182 zfrac = pinc_chltot_3d(ji,jj,jk) / ( pinc_chldia_3d(ji,jj,jk) + pinc_chlnon_3d(ji,jj,jk) ) 183 pinc_chldia_3d(ji,jj,jk) = pinc_chldia_3d(ji,jj,jk) * zfrac 184 pinc_chlnon_3d(ji,jj,jk) = pinc_chlnon_3d(ji,jj,jk) * zfrac 185 ENDIF 186 ELSE IF ( ld_chldia ) THEN 187 pinc_chldia_3d(ji,jj,jk) = MAX( -1.0 * p_maxchlinc, MIN( pinc_chldia_3d(ji,jj,jk), p_maxchlinc ) ) 188 pinc_chltot_3d(ji,jj,jk) = pinc_chldia_3d(ji,jj,jk) 189 ELSE IF ( ld_chlnon ) THEN 190 pinc_chlnon_3d(ji,jj,jk) = MAX( -1.0 * p_maxchlinc, MIN( pinc_chlnon_3d(ji,jj,jk), p_maxchlinc ) ) 191 pinc_chltot_3d(ji,jj,jk) = pinc_chlnon_3d(ji,jj,jk) 192 ENDIF 160 193 END DO 161 194 END DO 162 ELSE IF ( ld_chldia .AND. ld_chlnon ) THEN 163 DO jj = 1, jpj 164 DO ji = 1, jpi 165 pinc_chltot(ji,jj) = pinc_chldia(ji,jj) + pinc_chlnon(ji,jj) 166 pinc_chltot(ji,jj) = MAX( -1.0 * p_maxchlinc, MIN( pinc_chltot(ji,jj), p_maxchlinc ) ) 167 IF ( pinc_chltot(ji,jj) .NE. ( pinc_chldia(ji,jj) + pinc_chlnon(ji,jj) ) ) THEN 168 zfrac = pinc_chltot(ji,jj) / ( pinc_chldia(ji,jj) + pinc_chlnon(ji,jj) ) 169 pinc_chldia(ji,jj) = pinc_chldia(ji,jj) * zfrac 170 pinc_chlnon(ji,jj) = pinc_chlnon(ji,jj) * zfrac 171 ENDIF 172 END DO 173 END DO 174 ELSE IF ( ld_chldia ) THEN 175 DO jj = 1, jpj 176 DO ji = 1, jpi 177 pinc_chldia(ji,jj) = MAX( -1.0 * p_maxchlinc, MIN( pinc_chldia(ji,jj), p_maxchlinc ) ) 178 pinc_chltot(ji,jj) = pinc_chldia(ji,jj) 179 END DO 180 END DO 181 ELSE IF ( ld_chlnon ) THEN 182 DO jj = 1, jpj 183 DO ji = 1, jpi 184 pinc_chlnon(ji,jj) = MAX( -1.0 * p_maxchlinc, MIN( pinc_chlnon(ji,jj), p_maxchlinc ) ) 185 pinc_chltot(ji,jj) = pinc_chlnon(ji,jj) 186 END DO 187 END DO 188 ENDIF 195 END DO 189 196 ENDIF 190 197 … … 250 257 251 258 ! Set background state 252 bstate (:,:,:,i_tracer(1)) = tracer_bkg(:,:,:,jpdin)253 bstate (:,:,:,i_tracer(2)) = tracer_bkg(:,:,:,jpphn) + tracer_bkg(:,:,:,jpphd)254 bstate (:,:,:,i_tracer(3)) = tracer_bkg(:,:,:,jpzmi) + tracer_bkg(:,:,:,jpzme)255 bstate (:,:,:,i_tracer(4)) = tracer_bkg(:,:,:,jpdet)256 bstate (:,:,:,i_tracer(5)) = tracer_bkg(:,:,:,jpdic)257 bstate (:,:,:,i_tracer(6)) = tracer_bkg(:,:,:,jpalk)259 bstate_3d(:,:,:,i_tracer(1)) = tracer_bkg(:,:,:,jpdin) 260 bstate_3d(:,:,:,i_tracer(2)) = tracer_bkg(:,:,:,jpphn) + tracer_bkg(:,:,:,jpphd) 261 bstate_3d(:,:,:,i_tracer(3)) = tracer_bkg(:,:,:,jpzmi) + tracer_bkg(:,:,:,jpzme) 262 bstate_3d(:,:,:,i_tracer(4)) = tracer_bkg(:,:,:,jpdet) 263 bstate_3d(:,:,:,i_tracer(5)) = tracer_bkg(:,:,:,jpdic) 264 bstate_3d(:,:,:,i_tracer(6)) = tracer_bkg(:,:,:,jpalk) 258 265 259 266 ! Calculate carbon to chlorophyll ratio for combined phytoplankton 260 267 ! and nitrogen to biomass equivalent for PZD 261 268 ! Hardwire nitrogen mass to 14.01 for now as it doesn't seem to be set in MEDUSA 262 cchl_p(:,:) = 0.0 263 DO jj = 1, jpj 264 DO ji = 1, jpi 265 IF ( ( tracer_bkg(ji,jj,1,jpchn) + tracer_bkg(ji,jj,1,jpchd ) ) .GT. 0.0 ) THEN 266 cchl_p(ji,jj) = xmassc * ( ( tracer_bkg(ji,jj,1,jpphn) * xthetapn ) + & 267 & ( tracer_bkg(ji,jj,1,jpphd) * xthetapd ) ) / & 268 & ( tracer_bkg(ji,jj,1,jpchn) + tracer_bkg(ji,jj,1,jpchd ) ) 269 ENDIF 269 cchl_p_3d(:,:,:) = 0.0 270 DO jk = 1, jpk 271 DO jj = 1, jpj 272 DO ji = 1, jpi 273 IF ( ( tracer_bkg(ji,jj,jk,jpchn) + tracer_bkg(ji,jj,jk,jpchd ) ) .GT. 0.0 ) THEN 274 cchl_p_3d(ji,jj,jk) = xmassc * ( ( tracer_bkg(ji,jj,jk,jpphn) * xthetapn ) + & 275 & ( tracer_bkg(ji,jj,jk,jpphd) * xthetapd ) ) / & 276 & ( tracer_bkg(ji,jj,jk,jpchn) + tracer_bkg(ji,jj,jk,jpchd ) ) 277 ENDIF 278 END DO 270 279 END DO 271 280 END DO … … 275 284 276 285 ! Call nitrogen balancing routine 277 CALL bio_analysis( jpi, jpj, jpk, gdepw_n(:,:,2:jpk), i_tracer, modparm, & 278 & n2be_p, n2be_z, n2be_d, assimparm, & 279 & INT(pincper), 1, INT(SUM(tmask,3)), tmask(:,:,:), & 280 & pmld(:,:), mld_max_bkg(:,:), pinc_chltot(:,:), cchl_p(:,:), & 281 & nbal_active, phyt_avg_bkg(:,:), & 282 & gl_active, pgrow_avg_bkg(:,:), ploss_avg_bkg(:,:), & 283 & subsurf_active, deepneg_active, & 284 & deeppos_active, nutprof_active, & 285 & bstate, outincs, & 286 & diag_active, diag, & 287 & diag_fulldepth_active, diag_fulldepth ) 286 IF (kdeps == 1) THEN 287 pinc_chltot_2d(:,:) = pinc_chltot_3d(:,:,1) 288 cchl_p_2d(:,:) = cchl_p_3d(:,:,1) 289 phyt_avg_bkg_2d(:,:) = phyt_avg_bkg_3d(:,:,1) 290 pgrow_avg_bkg_2d(:,:) = pgrow_avg_bkg_3d(:,:,1) 291 ploss_avg_bkg_2d(:,:) = ploss_avg_bkg_3d(:,:,1) 292 293 CALL bio_analysis( jpi, jpj, jpk, gdepw_n(:,:,2:jpk), i_tracer, modparm, & 294 & n2be_p, n2be_z, n2be_d, assimparm, & 295 & INT(pincper), 1, INT(SUM(tmask,3)), tmask(:,:,:), & 296 & pmld(:,:), mld_max_bkg(:,:), pinc_chltot_2d(:,:), cchl_p_2d(:,:), & 297 & nbal_active, phyt_avg_bkg_2d(:,:), & 298 & gl_active, pgrow_avg_bkg_2d(:,:), ploss_avg_bkg_2d(:,:), & 299 & subsurf_active, deepneg_active, & 300 & deeppos_active, nutprof_active, & 301 & bstate_3d, outincs_3d, & 302 & diag_active, diag, & 303 & diag_fulldepth_active, diag_fulldepth_3d ) 304 ELSE 305 pmld(:,:) = 0.5 306 307 DO jk = 1, kdeps 308 pinc_chltot_2d(:,:) = pinc_chltot_3d(:,:,jk) 309 cchl_p_2d(:,:) = cchl_p_3d(:,:,jk) 310 phyt_avg_bkg_2d(:,:) = phyt_avg_bkg_3d(:,:,jk) 311 pgrow_avg_bkg_2d(:,:) = pgrow_avg_bkg_3d(:,:,jk) 312 ploss_avg_bkg_2d(:,:) = ploss_avg_bkg_3d(:,:,jk) 313 tmask_2d(:,:,1) = tmask(:,:,jk) 314 bstate_2d(:,:,1,:) = bstate_3d(:,:,jk,:) 315 outincs_2d(:,:,:,:) = 0.0 316 317 CALL bio_analysis( jpi, jpj, 1, gdepw_n(:,:,2), i_tracer, modparm, & 318 & n2be_p, n2be_z, n2be_d, assimparm, & 319 & INT(pincper), 1, INT(SUM(tmask_2d,3)), tmask_2d(:,:,:), & 320 & pmld(:,:), pmld(:,:), pinc_chltot_2d(:,:), cchl_p_2d(:,:), & 321 & nbal_active, phyt_avg_bkg_2d(:,:), & 322 & gl_active, pgrow_avg_bkg_2d(:,:), ploss_avg_bkg_2d(:,:), & 323 & subsurf_active, deepneg_active, & 324 & deeppos_active, nutprof_active, & 325 & bstate_2d, outincs_2d, & 326 & diag_active, diag, & 327 & diag_fulldepth_active, diag_fulldepth_2d ) 328 329 outincs_3d(:,:,jk,:) = outincs_2d(:,:,1,:) 330 END DO 331 ENDIF 288 332 289 333 ! Loop over each grid point partioning the increments 290 phyto 2d_balinc(:,:,:,:) = 0.0334 phyto_balinc(:,:,:,:) = 0.0 291 335 DO jk = 1, jpk 336 IF (kdeps == 1) THEN 337 jkinc = 1 338 ELSE 339 IF (jk > kdeps) THEN 340 EXIT 341 ENDIF 342 jkinc = jk 343 ENDIF 292 344 DO jj = 1, jpj 293 345 DO ji = 1, jpi … … 296 348 IF ( ( tracer_bkg(ji,jj,jk,jpphn) > 0.0 ) .AND. & 297 349 & ( tracer_bkg(ji,jj,jk,jpphd) > 0.0 ) .AND. & 298 & ( pinc_chltot (ji,jj) /= 0.0 ) ) THEN350 & ( pinc_chltot_3d(ji,jj,jkinc) /= 0.0 ) ) THEN 299 351 IF ( ld_chltot ) THEN 300 352 ! Phytoplankton nitrogen split up based on existing ratios … … 305 357 ELSE IF ( ld_chldia .AND. ld_chlnon ) THEN 306 358 ! Phytoplankton nitrogen split up based on assimilation increments 307 zfrac_phn = pinc_chlnon (ji,jj) / pinc_chltot(ji,jj)308 zfrac_phd = pinc_chldia (ji,jj) / pinc_chltot(ji,jj)359 zfrac_phn = pinc_chlnon_3d(ji,jj,jkinc) / pinc_chltot_3d(ji,jj,jkinc) 360 zfrac_phd = pinc_chldia_3d(ji,jj,jkinc) / pinc_chltot_3d(ji,jj,jkinc) 309 361 ENDIF 310 362 … … 318 370 zrat_chd_phd = tracer_bkg(ji,jj,jk,jpchd) / tracer_bkg(ji,jj,jk,jpphd) 319 371 320 phyto 2d_balinc(ji,jj,jk,jpphn) = outincs(ji,jj,jk,i_tracer(2)) * zfrac_phn321 phyto 2d_balinc(ji,jj,jk,jpphd) = outincs(ji,jj,jk,i_tracer(2)) * zfrac_phd322 phyto 2d_balinc(ji,jj,jk,jppds) = phyto2d_balinc(ji,jj,jk,jpphd) * zrat_pds_phd323 phyto 2d_balinc(ji,jj,jk,jpchn) = phyto2d_balinc(ji,jj,jk,jpphn) * zrat_chn_phn324 phyto 2d_balinc(ji,jj,jk,jpchd) = phyto2d_balinc(ji,jj,jk,jpphd) * zrat_chd_phd372 phyto_balinc(ji,jj,jk,jpphn) = outincs_3d(ji,jj,jk,i_tracer(2)) * zfrac_phn 373 phyto_balinc(ji,jj,jk,jpphd) = outincs_3d(ji,jj,jk,i_tracer(2)) * zfrac_phd 374 phyto_balinc(ji,jj,jk,jppds) = phyto_balinc(ji,jj,jk,jpphd) * zrat_pds_phd 375 phyto_balinc(ji,jj,jk,jpchn) = phyto_balinc(ji,jj,jk,jpphn) * zrat_chn_phn 376 phyto_balinc(ji,jj,jk,jpchd) = phyto_balinc(ji,jj,jk,jpphd) * zrat_chd_phd 325 377 ENDIF 326 378 … … 331 383 zfrac_zme = tracer_bkg(ji,jj,jk,jpzme) / & 332 384 & (tracer_bkg(ji,jj,jk,jpzmi) + tracer_bkg(ji,jj,jk,jpzme)) 333 phyto 2d_balinc(ji,jj,jk,jpzmi) = outincs(ji,jj,jk,i_tracer(3)) * zfrac_zmi334 phyto 2d_balinc(ji,jj,jk,jpzme) = outincs(ji,jj,jk,i_tracer(3)) * zfrac_zme385 phyto_balinc(ji,jj,jk,jpzmi) = outincs_3d(ji,jj,jk,i_tracer(3)) * zfrac_zmi 386 phyto_balinc(ji,jj,jk,jpzme) = outincs_3d(ji,jj,jk,i_tracer(3)) * zfrac_zme 335 387 ENDIF 336 388 337 389 ! Nitrogen nutrient straight from balancing scheme 338 phyto 2d_balinc(ji,jj,jk,jpdin) = outincs(ji,jj,jk,i_tracer(1))390 phyto_balinc(ji,jj,jk,jpdin) = outincs_3d(ji,jj,jk,i_tracer(1)) 339 391 340 392 ! Nitrogen detritus straight from balancing scheme 341 phyto 2d_balinc(ji,jj,jk,jpdet) = outincs(ji,jj,jk,i_tracer(4))393 phyto_balinc(ji,jj,jk,jpdet) = outincs_3d(ji,jj,jk,i_tracer(4)) 342 394 343 395 ! DIC straight from balancing scheme 344 phyto 2d_balinc(ji,jj,jk,jpdic) = outincs(ji,jj,jk,i_tracer(5))396 phyto_balinc(ji,jj,jk,jpdic) = outincs_3d(ji,jj,jk,i_tracer(5)) 345 397 346 398 ! Alkalinity straight from balancing scheme 347 phyto 2d_balinc(ji,jj,jk,jpalk) = outincs(ji,jj,jk,i_tracer(6))399 phyto_balinc(ji,jj,jk,jpalk) = outincs_3d(ji,jj,jk,i_tracer(6)) 348 400 349 401 ! Remove diatom silicate increment from nutrient silicate to conserve mass 350 IF ( ( tracer_bkg(ji,jj,jk,jpsil) - phyto 2d_balinc(ji,jj,jk,jppds) ) > 0.0 ) THEN351 phyto 2d_balinc(ji,jj,jk,jpsil) = phyto2d_balinc(ji,jj,jk,jppds) * (-1.0)402 IF ( ( tracer_bkg(ji,jj,jk,jpsil) - phyto_balinc(ji,jj,jk,jppds) ) > 0.0 ) THEN 403 phyto_balinc(ji,jj,jk,jpsil) = phyto_balinc(ji,jj,jk,jppds) * (-1.0) 352 404 ENDIF 353 405 … … 355 407 IF ( ( tracer_bkg(ji,jj,jk,jpdet) > 0.0 ) .AND. ( tracer_bkg(ji,jj,jk,jpdtc) > 0.0 ) ) THEN 356 408 zrat_dtc_det = tracer_bkg(ji,jj,jk,jpdtc) / tracer_bkg(ji,jj,jk,jpdet) 357 phyto 2d_balinc(ji,jj,jk,jpdtc) = phyto2d_balinc(ji,jj,jk,jpdet) * zrat_dtc_det409 phyto_balinc(ji,jj,jk,jpdtc) = phyto_balinc(ji,jj,jk,jpdet) * zrat_dtc_det 358 410 ENDIF 359 411 360 412 ! Do nothing with iron or oxygen for the time being 361 phyto 2d_balinc(ji,jj,jk,jpfer) = 0.0362 phyto 2d_balinc(ji,jj,jk,jpoxy) = 0.0413 phyto_balinc(ji,jj,jk,jpfer) = 0.0 414 phyto_balinc(ji,jj,jk,jpoxy) = 0.0 363 415 364 416 END DO … … 369 421 370 422 ! Initialise individual chlorophyll increments to zero 371 phyto 2d_balinc(:,:,:,jpchn) = 0.0372 phyto 2d_balinc(:,:,:,jpchd) = 0.0423 phyto_balinc(:,:,:,jpchn) = 0.0 424 phyto_balinc(:,:,:,jpchd) = 0.0 373 425 374 426 ! Split up total surface chlorophyll increments 375 DO jj = 1, jpj 376 DO ji = 1, jpi 377 IF ( ( tracer_bkg(ji,jj,1,jpchn) > 0.0 ) .AND. & 378 & ( tracer_bkg(ji,jj,1,jpchd) > 0.0 ) ) THEN 379 IF ( ld_chltot ) THEN 380 ! Chlorophyll split up based on existing ratios 381 zfrac_chn = tracer_bkg(ji,jj,1,jpchn) / & 382 & ( tracer_bkg(ji,jj,1,jpchn) + tracer_bkg(ji,jj,1,jpchd) ) 383 zfrac_chd = tracer_bkg(ji,jj,1,jpchd) / & 384 & ( tracer_bkg(ji,jj,1,jpchn) + tracer_bkg(ji,jj,1,jpchd) ) 385 phyto2d_balinc(ji,jj,1,jpchn) = pinc_chltot(ji,jj) * zfrac_chn 386 phyto2d_balinc(ji,jj,1,jpchd) = pinc_chltot(ji,jj) * zfrac_chd 387 ENDIF 388 IF( ld_chldia ) THEN 389 phyto2d_balinc(ji,jj,1,jpchd) = pinc_chldia(ji,jj) 390 ENDIF 391 IF( ld_chlnon ) THEN 392 phyto2d_balinc(ji,jj,1,jpchn) = pinc_chlnon(ji,jj) 393 ENDIF 394 395 ! Maintain stoichiometric ratios of nitrogen and silicate 396 IF ( ld_chltot .OR. ld_chlnon ) THEN 397 zrat_phn_chn = tracer_bkg(ji,jj,1,jpphn) / tracer_bkg(ji,jj,1,jpchn) 398 phyto2d_balinc(ji,jj,1,jpphn) = phyto2d_balinc(ji,jj,1,jpchn) * zrat_phn_chn 399 ENDIF 400 IF ( ld_chltot .OR. ld_chldia ) THEN 401 zrat_phd_chd = tracer_bkg(ji,jj,1,jpphd) / tracer_bkg(ji,jj,1,jpchd) 402 phyto2d_balinc(ji,jj,1,jpphd) = phyto2d_balinc(ji,jj,1,jpchd) * zrat_phd_chd 403 zrat_pds_chd = tracer_bkg(ji,jj,1,jppds) / tracer_bkg(ji,jj,1,jpchd) 404 phyto2d_balinc(ji,jj,1,jppds) = phyto2d_balinc(ji,jj,1,jpchd) * zrat_pds_chd 405 ENDIF 406 ENDIF 427 DO jk = 1, kdeps 428 DO jj = 1, jpj 429 DO ji = 1, jpi 430 IF ( ( tracer_bkg(ji,jj,jk,jpchn) > 0.0 ) .AND. & 431 & ( tracer_bkg(ji,jj,jk,jpchd) > 0.0 ) ) THEN 432 IF ( ld_chltot ) THEN 433 ! Chlorophyll split up based on existing ratios 434 zfrac_chn = tracer_bkg(ji,jj,jk,jpchn) / & 435 & ( tracer_bkg(ji,jj,jk,jpchn) + tracer_bkg(ji,jj,jk,jpchd) ) 436 zfrac_chd = tracer_bkg(ji,jj,jk,jpchd) / & 437 & ( tracer_bkg(ji,jj,jk,jpchn) + tracer_bkg(ji,jj,jk,jpchd) ) 438 phyto_balinc(ji,jj,jk,jpchn) = pinc_chltot_3d(ji,jj,jk) * zfrac_chn 439 phyto_balinc(ji,jj,jk,jpchd) = pinc_chltot_3d(ji,jj,jk) * zfrac_chd 440 ENDIF 441 IF( ld_chldia ) THEN 442 phyto_balinc(ji,jj,jk,jpchd) = pinc_chldia_3d(ji,jj,jk) 443 ENDIF 444 IF( ld_chlnon ) THEN 445 phyto_balinc(ji,jj,jk,jpchn) = pinc_chlnon_3d(ji,jj,jk) 446 ENDIF 447 448 ! Maintain stoichiometric ratios of nitrogen and silicate 449 IF ( ld_chltot .OR. ld_chlnon ) THEN 450 zrat_phn_chn = tracer_bkg(ji,jj,jk,jpphn) / tracer_bkg(ji,jj,jk,jpchn) 451 phyto_balinc(ji,jj,jk,jpphn) = phyto_balinc(ji,jj,jk,jpchn) * zrat_phn_chn 452 ENDIF 453 IF ( ld_chltot .OR. ld_chldia ) THEN 454 zrat_phd_chd = tracer_bkg(ji,jj,jk,jpphd) / tracer_bkg(ji,jj,jk,jpchd) 455 phyto_balinc(ji,jj,jk,jpphd) = phyto_balinc(ji,jj,jk,jpchd) * zrat_phd_chd 456 zrat_pds_chd = tracer_bkg(ji,jj,jk,jppds) / tracer_bkg(ji,jj,jk,jpchd) 457 phyto_balinc(ji,jj,jk,jppds) = phyto_balinc(ji,jj,jk,jpchd) * zrat_pds_chd 458 ENDIF 459 ENDIF 460 END DO 407 461 END DO 408 462 END DO 409 463 410 ! Propagate through mixed layer 411 DO jj = 1, jpj 412 DO ji = 1, jpi 413 ! 414 jkmax = jpk-1 415 DO jk = jpk-1, 1, -1 416 IF ( ( pmld(ji,jj) > gdepw_n(ji,jj,jk) ) .AND. & 417 & ( pmld(ji,jj) <= gdepw_n(ji,jj,jk+1) ) ) THEN 418 pmld(ji,jj) = gdepw_n(ji,jj,jk+1) 419 jkmax = jk 420 ENDIF 464 IF (kdeps == 1) THEN 465 ! Propagate through mixed layer 466 DO jj = 1, jpj 467 DO ji = 1, jpi 468 ! 469 jkmax = jpk-1 470 DO jk = jpk-1, 1, -1 471 IF ( ( pmld(ji,jj) > gdepw_n(ji,jj,jk) ) .AND. & 472 & ( pmld(ji,jj) <= gdepw_n(ji,jj,jk+1) ) ) THEN 473 pmld(ji,jj) = gdepw_n(ji,jj,jk+1) 474 jkmax = jk 475 ENDIF 476 END DO 477 ! 478 DO jk = 2, jkmax 479 phyto_balinc(ji,jj,jk,jpchn) = phyto_balinc(ji,jj,1,jpchn) 480 phyto_balinc(ji,jj,jk,jpchd) = phyto_balinc(ji,jj,1,jpchd) 481 phyto_balinc(ji,jj,jk,jpphn) = phyto_balinc(ji,jj,1,jpphn) 482 phyto_balinc(ji,jj,jk,jpphd) = phyto_balinc(ji,jj,1,jpphd) 483 phyto_balinc(ji,jj,jk,jppds) = phyto_balinc(ji,jj,1,jppds) 484 END DO 485 ! 421 486 END DO 422 ! 423 DO jk = 2, jkmax 424 phyto2d_balinc(ji,jj,jk,jpchn) = phyto2d_balinc(ji,jj,1,jpchn) 425 phyto2d_balinc(ji,jj,jk,jpchd) = phyto2d_balinc(ji,jj,1,jpchd) 426 phyto2d_balinc(ji,jj,jk,jpphn) = phyto2d_balinc(ji,jj,1,jpphn) 427 phyto2d_balinc(ji,jj,jk,jpphd) = phyto2d_balinc(ji,jj,1,jpphd) 428 phyto2d_balinc(ji,jj,jk,jppds) = phyto2d_balinc(ji,jj,1,jppds) 429 END DO 430 ! 431 END DO 432 END DO 487 END DO 488 ENDIF 433 489 434 490 ! Set other balancing increments to zero 435 phyto 2d_balinc(:,:,:,jpzmi) = 0.0436 phyto 2d_balinc(:,:,:,jpzme) = 0.0437 phyto 2d_balinc(:,:,:,jpdin) = 0.0438 phyto 2d_balinc(:,:,:,jpsil) = 0.0439 phyto 2d_balinc(:,:,:,jpfer) = 0.0440 phyto 2d_balinc(:,:,:,jpdet) = 0.0441 phyto 2d_balinc(:,:,:,jpdtc) = 0.0442 phyto 2d_balinc(:,:,:,jpdic) = 0.0443 phyto 2d_balinc(:,:,:,jpalk) = 0.0444 phyto 2d_balinc(:,:,:,jpoxy) = 0.0491 phyto_balinc(:,:,:,jpzmi) = 0.0 492 phyto_balinc(:,:,:,jpzme) = 0.0 493 phyto_balinc(:,:,:,jpdin) = 0.0 494 phyto_balinc(:,:,:,jpsil) = 0.0 495 phyto_balinc(:,:,:,jpfer) = 0.0 496 phyto_balinc(:,:,:,jpdet) = 0.0 497 phyto_balinc(:,:,:,jpdtc) = 0.0 498 phyto_balinc(:,:,:,jpdic) = 0.0 499 phyto_balinc(:,:,:,jpalk) = 0.0 500 phyto_balinc(:,:,:,jpoxy) = 0.0 445 501 446 502 ENDIF … … 452 508 DO jn = 1, jptra 453 509 DO jk = 1, jpk 454 phyto 2d_balinc(:,:,jk,jn) = phyto2d_balinc(:,:,jk,jn) * ( 1.0 - mask_itf(:,:) )510 phyto_balinc(:,:,jk,jn) = phyto_balinc(:,:,jk,jn) * ( 1.0 - mask_itf(:,:) ) 455 511 END DO 456 512 END DO 457 513 ENDIF 458 514 459 END SUBROUTINE asm_phyto 2d_bal_medusa515 END SUBROUTINE asm_phyto_bal_medusa 460 516 461 517 #else … … 464 520 !!---------------------------------------------------------------------- 465 521 CONTAINS 466 SUBROUTINE asm_phyto2d_bal_medusa( ld_chltot, & 467 & pinc_chltot, & 468 & ld_chldia, & 469 & pinc_chldia, & 470 & ld_chlnon, & 471 & pinc_chlnon, & 472 & ld_phytot, & 473 & pinc_phytot, & 474 & ld_phydia, & 475 & pinc_phydia, & 476 & ld_phynon, & 477 & pinc_phynon, & 478 & pincper, & 479 & p_maxchlinc, ld_phytobal, pmld, & 480 & pgrow_avg_bkg, ploss_avg_bkg, & 481 & phyt_avg_bkg, mld_max_bkg, & 482 & tracer_bkg, phyto2d_balinc ) 522 SUBROUTINE asm_phyto_bal_medusa( kdeps, & 523 & ld_chltot, & 524 & pinc_chltot_3d, & 525 & ld_chldia, & 526 & pinc_chldia_3d, & 527 & ld_chlnon, & 528 & pinc_chlnon_3d, & 529 & ld_phytot, & 530 & pinc_phytot_3d, & 531 & ld_phydia, & 532 & pinc_phydia_3d, & 533 & ld_phynon, & 534 & pinc_phynon_3d, & 535 & pincper, & 536 & p_maxchlinc, ld_phytobal, pmld, & 537 & pgrow_avg_bkg_3d, ploss_avg_bkg_3d, & 538 & phyt_avg_bkg_3d, mld_max_bkg, & 539 & tracer_bkg, phyto_balinc ) 540 INTEGER :: kdeps 483 541 LOGICAL :: ld_chltot 484 REAL :: pinc_chltot (:,:)542 REAL :: pinc_chltot_3d(:,:,:) 485 543 LOGICAL :: ld_chldia 486 REAL :: pinc_chldia (:,:)544 REAL :: pinc_chldia_3d(:,:,:) 487 545 LOGICAL :: ld_chlnon 488 REAL :: pinc_chlnon (:,:)546 REAL :: pinc_chlnon_3d(:,:,:) 489 547 LOGICAL :: ld_phytot 490 REAL :: pinc_phytot (:,:)548 REAL :: pinc_phytot_3d(:,:,:) 491 549 LOGICAL :: ld_phydia 492 REAL :: pinc_phydia (:,:)550 REAL :: pinc_phydia_3d(:,:,:) 493 551 LOGICAL :: ld_phynon 494 REAL :: pinc_phynon (:,:)552 REAL :: pinc_phynon_3d(:,:,:) 495 553 REAL :: pincper 496 554 REAL :: p_maxchlinc 497 555 LOGICAL :: ld_phytobal 498 556 REAL :: pmld(:,:) 499 REAL :: pgrow_avg_bkg (:,:)500 REAL :: ploss_avg_bkg (:,:)501 REAL :: phyt_avg_bkg (:,:)557 REAL :: pgrow_avg_bkg_3d(:,:,:) 558 REAL :: ploss_avg_bkg_3d(:,:,:) 559 REAL :: phyt_avg_bkg_3d(:,:,:) 502 560 REAL :: mld_max_bkg(:,:) 503 561 REAL :: tracer_bkg(:,:,:,:) 504 REAL :: phyto 2d_balinc(:,:,:,:)505 WRITE(*,*) 'asm_phyto 2d_bal_medusa: You should not have seen this print! error?'506 END SUBROUTINE asm_phyto 2d_bal_medusa562 REAL :: phyto_balinc(:,:,:,:) 563 WRITE(*,*) 'asm_phyto_bal_medusa: You should not have seen this print! error?' 564 END SUBROUTINE asm_phyto_bal_medusa 507 565 #endif 508 566 509 567 !!====================================================================== 510 END MODULE asmphyto 2dbal_medusa568 END MODULE asmphytobal_medusa -
branches/UKMO/dev_r5518_GO6_package_FOAMv14_phytobal3d/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_init.F90
r10302 r13097 35 35 USE bio_medusa_mod 36 36 USE par_oce, ONLY: jpi, jpj, jpk 37 USE sms_medusa, ONLY: jdms, pgrow_avg, ploss_avg, phyt_avg, mld_max 37 USE sms_medusa, ONLY: jdms, pgrow_avg, ploss_avg, phyt_avg, mld_max, & 38 & pgrow_avg_3d, ploss_avg_3d, phyt_avg_3d 38 39 USE trc, ONLY: ln_diatrc, med_diag, nittrc000 39 40 USE in_out_manager, ONLY: lwp, numout … … 199 200 ploss_avg(:,:) = 0.0 200 201 phyt_avg(:,:) = 0.0 202 pgrow_avg_3d(:,:,:) = 0.0 203 ploss_avg_3d(:,:,:) = 0.0 204 phyt_avg_3d(:,:,:) = 0.0 201 205 IF( kt == nittrc000 ) THEN 202 206 mld_max(:,:) = 0.0 -
branches/UKMO/dev_r5518_GO6_package_FOAMv14_phytobal3d/NEMOGCM/NEMO/TOP_SRC/MEDUSA/plankton.F90
r10302 r13097 46 46 ln_foam_medusa, & 47 47 pgrow_avg, ploss_avg, phyt_avg, & 48 pgrow_avg_3d, ploss_avg_3d, phyt_avg_3d, & 48 49 xkphd, xkphn, xkzme, xkzmi, & 49 50 xmetapd, xmetapn, xmetazme, xmetazmi, & … … 229 230 ((zphn(ji,jj) + zphd(ji,jj)) * & 230 231 fse3t(ji,jj,jk) * fq0) 232 !! 233 pgrow_avg_3d(ji,jj,jk) = (fprn(ji,jj) * zphn(ji,jj)) + & 234 (fprd(ji,jj) * zphd(ji,jj)) 235 ploss_avg_3d(ji,jj,jk) = fgmepd(ji,jj) + fdpd(ji,jj) + & 236 fdpd2(ji,jj) + & 237 fgmepn(ji,jj) + fdpn(ji,jj) + & 238 fdpn2(ji,jj) + fgmipn(ji,jj) 239 phyt_avg_3d(ji,jj,jk) = zphn(ji,jj) + zphd(ji,jj) 231 240 ENDIF 232 241 ENDDO -
branches/UKMO/dev_r5518_GO6_package_FOAMv14_phytobal3d/NEMOGCM/NEMO/TOP_SRC/MEDUSA/sms_medusa.F90
r10302 r13097 362 362 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ploss_avg !: Mixed layer average phytoplankton loss 363 363 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: phyt_avg !: Mixed layer average phytoplankton 364 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: pgrow_avg_3d !: Mixed layer average phytoplankton growth 365 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ploss_avg_3d !: Mixed layer average phytoplankton loss 366 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: phyt_avg_3d !: Mixed layer average phytoplankton 364 367 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: mld_max !: Maximum mixed layer depth 365 368 !! … … 438 441 !* Fields for ocean colour data assimilation 439 442 ALLOCATE( pgrow_avg(jpi,jpj) , ploss_avg(jpi,jpj) , & 443 & pgrow_avg_3d(jpi,jpj,jpk) , ploss_avg_3d(jpi,jpj,jpk) , & 444 & phyt_avg_3d(jpi,jpj,jpk) , & 440 445 & phyt_avg(jpi,jpj) , mld_max(jpi,jpj) , STAT=ierr(9) ) 441 446 #endif -
branches/UKMO/dev_r5518_GO6_package_FOAMv14_phytobal3d/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r10302 r13097 368 368 mld_max(:,:) = 0.0 369 369 ENDIF 370 IF( iom_varid( numrtr, 'pgrow_avg_3d', ldstop = .FALSE. ) > 0 ) THEN 371 IF(lwp) WRITE(numout,*) ' MEDUSA pgrow_avg present - reading in ...' 372 CALL iom_get( numrtr, jpdom_autoglo, 'pgrow_avg_3d', pgrow_avg_3d(:,:,:) ) 373 CALL iom_get( numrtr, jpdom_autoglo, 'ploss_avg_3d', ploss_avg_3d(:,:,:) ) 374 CALL iom_get( numrtr, jpdom_autoglo, 'phyt_avg_3d', phyt_avg_3d(:,:,:) ) 375 ELSE 376 IF(lwp) WRITE(numout,*) ' MEDUSA pgrow_avg_3d absent - setting to zero ...' 377 pgrow_avg_3d(:,:,:) = 0.0 378 ploss_avg_3d(:,:,:) = 0.0 379 phyt_avg_3d(:,:,:) = 0.0 380 ENDIF 370 381 ENDIF 371 382 … … 553 564 CALL iom_rstput( kt, nitrst, numrtw, 'phyt_avg', phyt_avg(:,:) ) 554 565 CALL iom_rstput( kt, nitrst, numrtw, 'mld_max', mld_max(:,:) ) 566 CALL iom_rstput( kt, nitrst, numrtw, 'pgrow_avg_3d', pgrow_avg_3d(:,:,:) ) 567 CALL iom_rstput( kt, nitrst, numrtw, 'ploss_avg_3d', ploss_avg_3d(:,:,:) ) 568 CALL iom_rstput( kt, nitrst, numrtw, 'phyt_avg_3d', phyt_avg_3d(:,:,:) ) 555 569 ENDIF 556 570 !!
Note: See TracChangeset
for help on using the changeset viewer.