- Timestamp:
- 2020-07-30T12:08:31+02:00 (4 years ago)
- Location:
- branches/UKMO/dev_1d_bugfixes_tocommit/NEMOGCM/NEMO
- Files:
-
- 2 deleted
- 5 edited
- 2 copied
-
OPA_SRC/ASM/asmbgc.F90 (modified) (33 diffs)
-
OPA_SRC/ASM/asmphyto2dbal_hadocc.F90 (deleted)
-
OPA_SRC/ASM/asmphyto2dbal_medusa.F90 (deleted)
-
OPA_SRC/ASM/asmphytobal_hadocc.F90 (copied) (copied from branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/ASM/asmphytobal_hadocc.F90)
-
OPA_SRC/ASM/asmphytobal_medusa.F90 (copied) (copied from branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/ASM/asmphytobal_medusa.F90)
-
TOP_SRC/MEDUSA/bio_medusa_init.F90 (modified) (2 diffs)
-
TOP_SRC/MEDUSA/plankton.F90 (modified) (2 diffs)
-
TOP_SRC/MEDUSA/sms_medusa.F90 (modified) (2 diffs)
-
TOP_SRC/trcrst.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_1d_bugfixes_tocommit/NEMOGCM/NEMO/OPA_SRC/ASM/asmbgc.F90
r13191 r13354 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_hadocc 839 #if defined key_hadocc || defined key_medusa 795 840 CALL iom_rstput( kt, nitbkg_r, knum, 'pgrow_avg' , pgrow_avg ) 796 841 CALL iom_rstput( kt, nitbkg_r, knum, 'ploss_avg' , ploss_avg ) 797 842 CALL iom_rstput( kt, nitbkg_r, knum, 'phyt_avg' , phyt_avg ) 843 CALL iom_rstput( kt, nitbkg_r, knum, 'pgrow_avg_3d', pgrow_avg_3d ) 844 CALL iom_rstput( kt, nitbkg_r, knum, 'ploss_avg_3d', ploss_avg_3d ) 845 CALL iom_rstput( kt, nitbkg_r, knum, 'phyt_avg_3d' , phyt_avg_3d ) 798 846 CALL iom_rstput( kt, nitbkg_r, knum, 'mld_max' , mld_max ) 847 #if defined key_hadocc 799 848 CALL iom_rstput( kt, nitbkg_r, knum, 'hadocc_nut' , trn(:,:,:,jp_had_nut) ) 800 849 CALL iom_rstput( kt, nitbkg_r, knum, 'hadocc_phy' , trn(:,:,:,jp_had_phy) ) … … 806 855 CALL iom_rstput( kt, nitbkg_r, knum, 'hadocc_cchl' , cchl_p(:,:,:) ) 807 856 #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 857 CALL iom_rstput( kt, nitbkg_r, knum, 'medusa_chn' , trn(:,:,:,jpchn) ) 813 858 CALL iom_rstput( kt, nitbkg_r, knum, 'medusa_chd' , trn(:,:,:,jpchd) ) … … 826 871 CALL iom_rstput( kt, nitbkg_r, knum, 'medusa_oxy' , trn(:,:,:,jpoxy) ) 827 872 #endif 873 #endif 828 874 829 875 END SUBROUTINE asm_bgc_bkg_wri … … 876 922 !!=========================================================================== 877 923 924 SUBROUTINE asm_bgc_unlog_3d( pbkg, pinc_log, pinc_nonlog ) 925 !!------------------------------------------------------------------------ 926 !! *** ROUTINE asm_bgc_init_incs *** 927 !! 928 !! ** Purpose : convert log increments to non-log 929 !! 930 !! ** Method : need to account for model background, 931 !! cannot simply do 10^log_inc. Need to: 932 !! 1) Add log_inc to log10(background) to get log10(analysis) 933 !! 2) Take 10^log10(analysis) to get analysis 934 !! 3) Subtract background from analysis to get non-log incs 935 !! 936 !! ** Action : return non-log increments 937 !! 938 !! References : 939 !!------------------------------------------------------------------------ 940 !! 941 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pbkg ! Background 942 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pinc_log ! Log incs 943 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk) :: pinc_nonlog ! Non-log incs 944 ! 945 INTEGER :: ji, jj, jk ! Loop counters 946 !! 947 !!------------------------------------------------------------------------ 948 949 DO jk = 1, jpk 950 DO jj = 1, jpj 951 DO ji = 1, jpi 952 IF ( pbkg(ji,jj,jk) > 0.0 ) THEN 953 pinc_nonlog(ji,jj,jk) = 10**( LOG10( pbkg(ji,jj,jk) ) + & 954 & pinc_log(ji,jj,jk) ) & 955 & - pbkg(ji,jj,jk) 956 ELSE 957 pinc_nonlog(ji,jj,jk) = 0.0 958 ENDIF 959 END DO 960 END DO 961 END DO 962 963 END SUBROUTINE asm_bgc_unlog_3d 964 965 !!=========================================================================== 966 !!=========================================================================== 967 !!=========================================================================== 968 878 969 SUBROUTINE phyto2d_asm_inc( kt, ll_asmdin, ll_asmiau, kcycper, pwgtiau ) 879 970 !!------------------------------------------------------------------------ … … 894 985 REAL(wp), DIMENSION(kcycper), INTENT(IN) :: pwgtiau ! IAU weights 895 986 ! 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 987 INTEGER :: jk ! Loop counter 988 INTEGER :: it ! Index 989 REAL(wp) :: zincwgt ! IAU weight for current time step 990 REAL(wp) :: zincper ! IAU interval in seconds 991 REAL(wp), DIMENSION(jpi,jpj) :: zmld ! Mixed layer depth 992 REAL(wp), DIMENSION(jpi,jpj,1) :: zinc_chltot ! Local chltot incs 993 REAL(wp), DIMENSION(jpi,jpj) :: zbkg_chltot ! Local chltot bkg 994 REAL(wp), DIMENSION(jpi,jpj,1) :: zinc_phytot ! Local phytot incs 995 REAL(wp), DIMENSION(jpi,jpj) :: zbkg_phytot ! Local phytot bkg 996 #if defined key_medusa 997 REAL(wp), DIMENSION(jpi,jpj,1) :: zinc_chldia ! Local chldia incs 998 REAL(wp), DIMENSION(jpi,jpj) :: zbkg_chldia ! Local chldia bkg 999 REAL(wp), DIMENSION(jpi,jpj,1) :: zinc_chlnon ! Local chlnon incs 1000 REAL(wp), DIMENSION(jpi,jpj) :: zbkg_chlnon ! Local chlnon bkg 1001 REAL(wp), DIMENSION(jpi,jpj,1) :: zinc_phydia ! Local phydia incs 1002 REAL(wp), DIMENSION(jpi,jpj) :: zbkg_phydia ! Local phydia bkg 1003 REAL(wp), DIMENSION(jpi,jpj,1) :: zinc_phynon ! Local phynon incs 1004 REAL(wp), DIMENSION(jpi,jpj) :: zbkg_phynon ! Local phynon bkg 1005 #endif 1006 REAL(wp), DIMENSION(jpi,jpj,1) :: zpgrow_avg_bkg ! Local pgrow_avg_bkg 1007 REAL(wp), DIMENSION(jpi,jpj,1) :: zploss_avg_bkg ! Local ploss_avg_bkg 1008 REAL(wp), DIMENSION(jpi,jpj,1) :: zphyt_avg_bkg ! Local phyt_avg_bkg 915 1009 !!------------------------------------------------------------------------ 916 1010 … … 928 1022 zbkg_chltot(:,:) = chl_bkg(:,:,1) 929 1023 #endif 930 CALL asm_bgc_unlog_2d( zbkg_chltot, slchltot_bkginc, zinc_chltot )1024 CALL asm_bgc_unlog_2d( zbkg_chltot, slchltot_bkginc, zinc_chltot(:,:,1) ) 931 1025 ELSE IF ( ln_schltotinc ) THEN 932 zinc_chltot(:,: ) = schltot_bkginc(:,:)1026 zinc_chltot(:,:,1) = schltot_bkginc(:,:) 933 1027 ELSE 934 zinc_chltot(:,: ) = 0.01028 zinc_chltot(:,:,:) = 0.0 935 1029 ENDIF 936 1030 … … 939 1033 IF ( ln_slchldiainc ) THEN 940 1034 zbkg_chldia(:,:) = tracer_bkg(:,:,1,jpchd) 941 CALL asm_bgc_unlog_2d( zbkg_chldia, slchldia_bkginc, zinc_chldia )1035 CALL asm_bgc_unlog_2d( zbkg_chldia, slchldia_bkginc, zinc_chldia(:,:,1) ) 942 1036 ELSE 943 zinc_chldia(:,: ) = 0.01037 zinc_chldia(:,:,:) = 0.0 944 1038 ENDIF 945 1039 #endif … … 949 1043 IF ( ln_slchlnoninc ) THEN 950 1044 zbkg_chlnon(:,:) = tracer_bkg(:,:,1,jpchn) 951 CALL asm_bgc_unlog_2d( zbkg_chlnon, slchlnon_bkginc, zinc_chlnon )1045 CALL asm_bgc_unlog_2d( zbkg_chlnon, slchlnon_bkginc, zinc_chlnon(:,:,1) ) 952 1046 ELSE 953 zinc_chlnon(:,: ) = 0.01047 zinc_chlnon(:,:,:) = 0.0 954 1048 ENDIF 955 1049 #endif … … 962 1056 zbkg_phytot(:,:) = trn(:,:,1,jp_had_phy) * c2n_p 963 1057 #endif 964 CALL asm_bgc_unlog_2d( zbkg_phytot, slphytot_bkginc, zinc_phytot )1058 CALL asm_bgc_unlog_2d( zbkg_phytot, slphytot_bkginc, zinc_phytot(:,:,1) ) 965 1059 ELSE 966 zinc_phytot(:,: ) = 0.01060 zinc_phytot(:,:,:) = 0.0 967 1061 ENDIF 968 1062 … … 971 1065 IF ( ln_slphydiainc ) THEN 972 1066 zbkg_phydia(:,:) = trn(:,:,1,jpphd) * xthetapd 973 CALL asm_bgc_unlog_2d( zbkg_phydia, slphydia_bkginc, zinc_phydia )1067 CALL asm_bgc_unlog_2d( zbkg_phydia, slphydia_bkginc, zinc_phydia(:,:,1) ) 974 1068 ELSE 975 zinc_phydia(:,: ) = 0.01069 zinc_phydia(:,:,:) = 0.0 976 1070 ENDIF 977 1071 #endif … … 981 1075 IF ( ln_slphynoninc ) THEN 982 1076 zbkg_phynon(:,:) = trn(:,:,1,jpphn) * xthetapn 983 CALL asm_bgc_unlog_2d( zbkg_phynon, slphynon_bkginc, zinc_phynon )1077 CALL asm_bgc_unlog_2d( zbkg_phynon, slphynon_bkginc, zinc_phynon(:,:,1) ) 984 1078 ELSE 985 zinc_phynon(:,: ) = 0.01079 zinc_phynon(:,:,:) = 0.0 986 1080 ENDIF 987 1081 #endif … … 1024 1118 1025 1119 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 ) 1120 1121 zpgrow_avg_bkg(:,:,1) = pgrow_avg_bkg(:,:) 1122 zploss_avg_bkg(:,:,1) = ploss_avg_bkg(:,:) 1123 zphyt_avg_bkg(:,:,1) = phyt_avg_bkg(:,:) 1124 1125 #if defined key_medusa 1126 CALL asm_phyto_bal_medusa( 1, & 1127 & (ln_slchltotinc .OR. ln_schltotinc), & 1128 & zinc_chltot, & 1129 & ln_slchldiainc, & 1130 & zinc_chldia, & 1131 & ln_slchlnoninc, & 1132 & zinc_chlnon, & 1133 & ln_slphytotinc, & 1134 & zinc_phytot, & 1135 & ln_slphydiainc, & 1136 & zinc_phydia, & 1137 & ln_slphynoninc, & 1138 & zinc_phynon, & 1139 & zincper, & 1140 & rn_maxchlinc, ln_phytobal, zmld, & 1141 & zpgrow_avg_bkg, zploss_avg_bkg, & 1142 & zphyt_avg_bkg, mld_max_bkg, & 1143 & tracer_bkg, phyto2d_balinc ) 1045 1144 #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 ) 1145 CALL asm_phyto_bal_hadocc( 1, & 1146 & (ln_slchltotinc .OR. ln_schltotinc), & 1147 & zinc_chltot, & 1148 & ln_slphytotinc, & 1149 & zinc_phytot, & 1150 & zincper, & 1151 & rn_maxchlinc, ln_phytobal, zmld, & 1152 & zpgrow_avg_bkg, zploss_avg_bkg, & 1153 & zphyt_avg_bkg, mld_max_bkg, & 1154 & cchl_p_bkg(:,:,1), & 1155 & tracer_bkg, phyto2d_balinc ) 1056 1156 #else 1057 1157 CALL ctl_stop( 'Attempting to assimilate phyto2d data, ', & … … 1166 1266 INTEGER :: ji, jj, jk ! Loop counters 1167 1267 INTEGER :: it ! Index 1268 REAL(wp) :: zincper ! IAU interval in seconds 1168 1269 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 1270 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zinc_chltot ! Chlorophyll increments 1271 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zbkg_chltot ! Chlorophyll background 1272 REAL(wp), DIMENSION(jpi,jpj) :: zdummy_2d ! Dummy array for call 1273 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdummy_3d ! Dummy array for call 1176 1274 !!------------------------------------------------------------------------ 1177 1275 … … 1179 1277 1180 1278 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) 1279 #if defined key_medusa 1280 zbkg_chltot(:,:,:) = tracer_bkg(:,:,:,jpchn) + tracer_bkg(:,:,:,jpchd) 1190 1281 #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 1282 zbkg_chltot(:,:,:) = chl_bkg(:,:,:) 1283 #endif 1284 CALL asm_bgc_unlog_3d( zbkg_chltot, plchltot_bkginc, zinc_chltot ) 1207 1285 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 1286 zinc_chltot(:,:,:) = pchltot_bkginc(:,:,:) 1287 ENDIF 1288 1289 zincper = (nitiaufin_r - nitiaustr_r + 1) * rdt 1290 1291 #if defined key_medusa 1292 CALL asm_phyto_bal_medusa( jpk, & 1293 & (ln_plchltotinc .OR. ln_pchltotinc), & 1294 & zinc_chltot, & 1295 & .FALSE., & 1296 & zdummy_3d, & 1297 & .FALSE., & 1298 & zdummy_3d, & 1299 & .FALSE., & 1300 & zdummy_3d, & 1301 & .FALSE., & 1302 & zdummy_3d, & 1303 & .FALSE., & 1304 & zdummy_3d, & 1305 & zincper, & 1306 & rn_maxchlinc, ln_phytobal, zdummy_2d, & 1307 & pgrow_avg_3d_bkg, ploss_avg_3d_bkg, & 1308 & phyt_avg_3d_bkg, mld_max_bkg, & 1309 & tracer_bkg, phyto3d_balinc ) 1241 1310 #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, ', & 1311 CALL asm_phyto_bal_hadocc( jpk, & 1312 & (ln_plchltotinc .OR. ln_pchltotinc), & 1313 & zinc_chltot, & 1314 & .FALSE., & 1315 & zdummy_3d, & 1316 & zincper, & 1317 & rn_maxchlinc, ln_phytobal, zdummy_2d, & 1318 & pgrow_avg_3d_bkg, ploss_avg_3d_bkg, & 1319 & phyt_avg_3d_bkg, mld_max_bkg, & 1320 & cchl_p_bkg, & 1321 & tracer_bkg, phyto3d_balinc ) 1322 #else 1323 CALL ctl_stop( 'Attempting to assimilate phyto3d data, ', & 1245 1324 & 'but not defined a biogeochemical model' ) 1246 1325 #endif … … 1423 1502 ! Account for phytoplankton balancing if required 1424 1503 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) 1504 IF ( ALLOCATED(phyto2d_balinc) ) THEN 1505 dic_bkg_temp(:,:) = tracer_bkg(:,:,1,jpdic) + phyto2d_balinc(:,:,1,jpdic) 1506 alk_bkg_temp(:,:) = tracer_bkg(:,:,1,jpalk) + phyto2d_balinc(:,:,1,jpalk) 1507 ENDIF 1508 IF ( ALLOCATED(phyto3d_balinc) ) THEN 1509 dic_bkg_temp(:,:) = tracer_bkg(:,:,1,jpdic) + phyto3d_balinc(:,:,1,jpdic) 1510 alk_bkg_temp(:,:) = tracer_bkg(:,:,1,jpalk) + phyto3d_balinc(:,:,1,jpalk) 1511 ENDIF 1427 1512 ELSE 1428 1513 dic_bkg_temp(:,:) = tracer_bkg(:,:,1,jpdic) … … 1437 1522 ! Account for phytoplankton balancing if required 1438 1523 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) 1524 IF ( ALLOCATED(phyto2d_balinc) ) THEN 1525 dic_bkg_temp(:,:) = tracer_bkg(:,:,1,jp_had_dic) + phyto2d_balinc(:,:,1,jp_had_dic) 1526 alk_bkg_temp(:,:) = tracer_bkg(:,:,1,jp_had_alk) + phyto2d_balinc(:,:,1,jp_had_alk) 1527 ENDIF 1528 IF ( ALLOCATED(phyto3d_balinc) ) THEN 1529 dic_bkg_temp(:,:) = tracer_bkg(:,:,1,jp_had_dic) + phyto3d_balinc(:,:,1,jp_had_dic) 1530 alk_bkg_temp(:,:) = tracer_bkg(:,:,1,jp_had_alk) + phyto3d_balinc(:,:,1,jp_had_alk) 1531 ENDIF 1441 1532 ELSE 1442 1533 dic_bkg_temp(:,:) = tracer_bkg(:,:,1,jp_had_dic) … … 1677 1768 ! Account for phytoplankton balancing if required 1678 1769 IF ( ln_phytobal ) THEN 1679 dic_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpdic) + phyto2d_balinc(:,:,:,jpdic) 1680 alk_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpalk) + phyto2d_balinc(:,:,:,jpalk) 1681 din_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpdin) + phyto2d_balinc(:,:,:,jpdin) 1682 sil_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpsil) + phyto2d_balinc(:,:,:,jpsil) 1770 IF ( ALLOCATED(phyto2d_balinc) ) THEN 1771 dic_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpdic) + phyto2d_balinc(:,:,:,jpdic) 1772 alk_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpalk) + phyto2d_balinc(:,:,:,jpalk) 1773 din_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpdin) + phyto2d_balinc(:,:,:,jpdin) 1774 sil_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpsil) + phyto2d_balinc(:,:,:,jpsil) 1775 ENDIF 1776 IF ( ALLOCATED(phyto3d_balinc) ) THEN 1777 dic_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpdic) + phyto3d_balinc(:,:,:,jpdic) 1778 alk_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpalk) + phyto3d_balinc(:,:,:,jpalk) 1779 din_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpdin) + phyto3d_balinc(:,:,:,jpdin) 1780 sil_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpsil) + phyto3d_balinc(:,:,:,jpsil) 1781 ENDIF 1683 1782 ELSE 1684 1783 dic_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpdic) … … 1871 1970 it = jpdin 1872 1971 #endif 1873 IF ( ln_phytobal) THEN1972 IF ( ALLOCATED(phyto2d_balinc) ) THEN 1874 1973 pno3_bkginc(:,:,:) = pno3_bkginc(:,:,:) - phyto2d_balinc(:,:,:,it) 1875 1974 ENDIF 1876 IF ( ln_plchltotinc .OR. ln_pchltotinc) THEN1975 IF ( ALLOCATED(phyto3d_balinc) ) THEN 1877 1976 pno3_bkginc(:,:,:) = pno3_bkginc(:,:,:) - phyto3d_balinc(:,:,:,it) 1878 1977 ENDIF … … 1891 1990 #if defined key_medusa 1892 1991 it = jpsil 1893 IF ( ln_phytobal) THEN1992 IF ( ALLOCATED(phyto2d_balinc) ) THEN 1894 1993 psi4_bkginc(:,:,:) = psi4_bkginc(:,:,:) - phyto2d_balinc(:,:,:,it) 1895 1994 ENDIF 1896 IF ( ln_plchltotinc .OR. ln_pchltotinc) THEN1995 IF ( ALLOCATED(phyto3d_balinc) ) THEN 1897 1996 psi4_bkginc(:,:,:) = psi4_bkginc(:,:,:) - phyto3d_balinc(:,:,:,it) 1898 1997 ENDIF … … 1915 2014 it = jpdic 1916 2015 #endif 1917 IF ( ln_phytobal) THEN2016 IF ( ALLOCATED(phyto2d_balinc) ) THEN 1918 2017 pdic_bkginc(:,:,:) = pdic_bkginc(:,:,:) - phyto2d_balinc(:,:,:,it) 1919 2018 ENDIF 1920 IF ( ln_plchltotinc .OR. ln_pchltotinc) THEN2019 IF ( ALLOCATED(phyto3d_balinc) ) THEN 1921 2020 pdic_bkginc(:,:,:) = pdic_bkginc(:,:,:) - phyto3d_balinc(:,:,:,it) 1922 2021 ENDIF … … 1939 2038 it = jpalk 1940 2039 #endif 1941 IF ( ln_phytobal) THEN2040 IF ( ALLOCATED(phyto2d_balinc) ) THEN 1942 2041 palk_bkginc(:,:,:) = palk_bkginc(:,:,:) - phyto2d_balinc(:,:,:,it) 1943 2042 ENDIF 1944 IF ( ln_plchltotinc .OR. ln_pchltotinc) THEN2043 IF ( ALLOCATED(phyto3d_balinc) ) THEN 1945 2044 palk_bkginc(:,:,:) = palk_bkginc(:,:,:) - phyto3d_balinc(:,:,:,it) 1946 2045 ENDIF … … 1959 2058 #if defined key_medusa 1960 2059 it = jpoxy 1961 IF ( ln_phytobal) THEN2060 IF ( ALLOCATED(phyto2d_balinc) ) THEN 1962 2061 po2_bkginc(:,:,:) = po2_bkginc(:,:,:) - phyto2d_balinc(:,:,:,it) 1963 2062 ENDIF 1964 IF ( ln_plchltotinc .OR. ln_pchltotinc) THEN2063 IF ( ALLOCATED(phyto3d_balinc) ) THEN 1965 2064 po2_bkginc(:,:,:) = po2_bkginc(:,:,:) - phyto3d_balinc(:,:,:,it) 1966 2065 ENDIF -
branches/UKMO/dev_1d_bugfixes_tocommit/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_init.F90
r10302 r13354 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_1d_bugfixes_tocommit/NEMOGCM/NEMO/TOP_SRC/MEDUSA/plankton.F90
r10302 r13354 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_1d_bugfixes_tocommit/NEMOGCM/NEMO/TOP_SRC/MEDUSA/sms_medusa.F90
r10302 r13354 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_1d_bugfixes_tocommit/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r10302 r13354 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.
