Changeset 7996 for branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcbio_medusa.F90
- Timestamp:
- 2017-05-05T12:09:58+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcbio_medusa.F90
r7986 r7996 103 103 USE iron_chem_scav_mod, ONLY: iron_chem_scav 104 104 USE detritus_mod, ONLY: detritus 105 USE bio_medusa_update_mod, ONLY: bio_medusa_update 105 106 USE bio_medusa_diag_slice_mod, ONLY: bio_medusa_diag_slice 106 107 USE bio_medusa_fin_mod, ONLY: bio_medusa_fin … … 297 298 INTEGER :: iball 298 299 !! use biological fluxes (1) or not (0) 299 INTEGER :: ibio_switch300 ! INTEGER :: ibio_switch 300 301 !! 301 302 !! diagnose fluxes (should only be used in 1D runs) … … 363 364 ! REAL(wp), DIMENSION(jpi,jpj) :: f_runoff, f_riv_n, f_riv_si, f_riv_c, f_riv_alk 364 365 !! AXY (19/07/12): variables for local riverine fluxes to handle inputs below surface 365 REAL(wp), DIMENSION(jpi,jpj) :: f_riv_loc_n, f_riv_loc_si, f_riv_loc_c, f_riv_loc_alk366 ! REAL(wp), DIMENSION(jpi,jpj) :: f_riv_loc_n, f_riv_loc_si, f_riv_loc_c, f_riv_loc_alk 366 367 !!--------------------------------------------------------------------- 367 368 … … 952 953 CALL detritus( jk, iball ) 953 954 954 ! Updating coming next - marc 28/4/17 955 956 DO jj = 2,jpjm1 957 DO ji = 2,jpim1 958 !! OPEN wet point IF..THEN loop 959 if (tmask(ji,jj,jk) == 1) then 960 961 !!====================================================================== 962 !! LOCAL GRID CELL TRENDS 963 !!====================================================================== 964 !! 965 !!---------------------------------------------------------------------- 966 !! Determination of trends 967 !!---------------------------------------------------------------------- 968 !! 969 !!---------------------------------------------------------------------- 970 !! chlorophyll 971 btra(ji,jj,jpchn) = b0 * ( & 972 + ((frn(ji,jj) * fprn(ji,jj) * zphn(ji,jj)) - fgmipn(ji,jj) - fgmepn(ji,jj) - fdpn(ji,jj) - fdpn2(ji,jj)) * (fthetan(ji,jj) / xxi) ) 973 btra(ji,jj,jpchd) = b0 * ( & 974 + ((frd(ji,jj) * fprd(ji,jj) * zphd(ji,jj)) - fgmepd(ji,jj) - fdpd(ji,jj) - fdpd2(ji,jj)) * (fthetad(ji,jj) / xxi) ) 975 !! 976 !!---------------------------------------------------------------------- 977 !! phytoplankton 978 btra(ji,jj,jpphn) = b0 * ( & 979 + (fprn(ji,jj) * zphn(ji,jj)) - fgmipn(ji,jj) - fgmepn(ji,jj) - fdpn(ji,jj) - fdpn2(ji,jj) ) 980 btra(ji,jj,jpphd) = b0 * ( & 981 + (fprd(ji,jj) * zphd(ji,jj)) - fgmepd(ji,jj) - fdpd(ji,jj) - fdpd2(ji,jj) ) 982 btra(ji,jj,jppds) = b0 * ( & 983 + (fprds(ji,jj) * zpds(ji,jj)) - fgmepds(ji,jj) - fdpds(ji,jj) - fsdiss(ji,jj) - fdpds2(ji,jj) ) 984 !! 985 !!---------------------------------------------------------------------- 986 !! zooplankton 987 btra(ji,jj,jpzmi) = b0 * ( & 988 + fmigrow(ji,jj) - fgmezmi(ji,jj) - fdzmi(ji,jj) - fdzmi2(ji,jj) ) 989 btra(ji,jj,jpzme) = b0 * ( & 990 + fmegrow(ji,jj) - fdzme(ji,jj) - fdzme2(ji,jj) ) 991 !! 992 !!---------------------------------------------------------------------- 993 !! detritus 994 btra(ji,jj,jpdet) = b0 * ( & 995 + fdpn(ji,jj) + ((1.0 - xfdfrac1) * fdpd(ji,jj)) & ! mort. losses 996 + fdzmi(ji,jj) + ((1.0 - xfdfrac2) * fdzme(ji,jj)) & ! mort. losses 997 + ((1.0 - xbetan) * (finmi(ji,jj) + finme(ji,jj))) & ! assim. inefficiency 998 - fgmid(ji,jj) - fgmed(ji,jj) - fdd(ji,jj) & ! grazing and remin. 999 + ffast2slown(ji,jj) ) ! seafloor fast->slow 1000 !! 1001 !!---------------------------------------------------------------------- 1002 !! dissolved inorganic nitrogen nutrient 1003 fn_cons = 0.0 & 1004 - (fprn(ji,jj) * zphn(ji,jj)) - (fprd(ji,jj) * zphd(ji,jj)) ! primary production 1005 fn_prod = 0.0 & 1006 + (xphi * (fgmipn(ji,jj) + fgmid(ji,jj))) & ! messy feeding remin. 1007 + (xphi * (fgmepn(ji,jj) + fgmepd(ji,jj) + fgmezmi(ji,jj) + fgmed(ji,jj))) & ! messy feeding remin. 1008 + fmiexcr(ji,jj) + fmeexcr(ji,jj) + fdd(ji,jj) + freminn(ji,jj) & ! excretion and remin. 1009 + fdpn2(ji,jj) + fdpd2(ji,jj) + fdzmi2(ji,jj) + fdzme2(ji,jj) ! metab. losses 1010 !! 1011 !! riverine flux 1012 if ( jriver_n .gt. 0 ) then 1013 f_riv_loc_n(ji,jj) = f_riv_n(ji,jj) * friver_dep(jk,mbathy(ji,jj)) / fse3t(ji,jj,jk) 1014 fn_prod = fn_prod + f_riv_loc_n(ji,jj) 1015 endif 1016 !! 1017 !! benthic remineralisation 1018 if (jk.eq.mbathy(ji,jj) .and. jorgben.eq.1 .and. ibenthic.eq.1) then 1019 fn_prod = fn_prod + (f_benout_n(ji,jj) / fse3t(ji,jj,jk)) 1020 endif 1021 !! 1022 btra(ji,jj,jpdin) = b0 * ( & 1023 fn_prod + fn_cons ) 1024 !! 1025 fnit_cons(ji,jj) = fnit_cons(ji,jj) + ( fse3t(ji,jj,jk) * ( & ! consumption of dissolved nitrogen 1026 fn_cons ) ) 1027 fnit_prod(ji,jj) = fnit_prod(ji,jj) + ( fse3t(ji,jj,jk) * ( & ! production of dissolved nitrogen 1028 fn_prod ) ) 1029 !! 1030 !!---------------------------------------------------------------------- 1031 !! dissolved silicic acid nutrient 1032 fs_cons = 0.0 & 1033 - (fprds(ji,jj) * zpds(ji,jj)) ! opal production 1034 fs_prod = 0.0 & 1035 + fsdiss(ji,jj) & ! opal dissolution 1036 + ((1.0 - xfdfrac1) * fdpds(ji,jj)) & ! mort. loss 1037 + ((1.0 - xfdfrac3) * fgmepds(ji,jj)) & ! egestion of grazed Si 1038 + freminsi(ji,jj) + fdpds2(ji,jj) ! fast diss. and metab. losses 1039 !! 1040 !! riverine flux 1041 if ( jriver_si .gt. 0 ) then 1042 f_riv_loc_si(ji,jj) = f_riv_si(ji,jj) * friver_dep(jk,mbathy(ji,jj)) / fse3t(ji,jj,jk) 1043 fs_prod = fs_prod + f_riv_loc_si(ji,jj) 1044 endif 1045 !! 1046 !! benthic remineralisation 1047 if (jk.eq.mbathy(ji,jj) .and. jinorgben.eq.1 .and. ibenthic.eq.1) then 1048 fs_prod = fs_prod + (f_benout_si(ji,jj) / fse3t(ji,jj,jk)) 1049 endif 1050 !! 1051 btra(ji,jj,jpsil) = b0 * ( & 1052 fs_prod + fs_cons ) 1053 !! 1054 fsil_cons(ji,jj) = fsil_cons(ji,jj) + ( fse3t(ji,jj,jk) * ( & ! consumption of dissolved silicon 1055 fs_cons ) ) 1056 fsil_prod(ji,jj) = fsil_prod(ji,jj) + ( fse3t(ji,jj,jk) * ( & ! production of dissolved silicon 1057 fs_prod ) ) 1058 !! 1059 !!---------------------------------------------------------------------- 1060 !! dissolved "iron" nutrient 1061 btra(ji,jj,jpfer) = b0 * ( & 1062 + (xrfn * btra(ji,jj,jpdin)) + ffetop(ji,jj) + ffebot(ji,jj) - ffescav(ji,jj) ) 1063 1064 # if defined key_roam 1065 !! 1066 !!---------------------------------------------------------------------- 1067 !! AXY (26/11/08): implicit detrital carbon change 1068 btra(ji,jj,jpdtc) = b0 * ( & 1069 + (xthetapn * fdpn(ji,jj)) + ((1.0 - xfdfrac1) * (xthetapd * fdpd(ji,jj))) & ! mort. losses 1070 + (xthetazmi * fdzmi(ji,jj)) + ((1.0 - xfdfrac2) * (xthetazme * fdzme(ji,jj))) & ! mort. losses 1071 + ((1.0 - xbetac) * (ficmi(ji,jj) + ficme(ji,jj))) & ! assim. inefficiency 1072 - fgmidc(ji,jj) - fgmedc(ji,jj) - fddc(ji,jj) & ! grazing and remin. 1073 + ffast2slowc(ji,jj) ) ! seafloor fast->slow 1074 !! 1075 !!---------------------------------------------------------------------- 1076 !! dissolved inorganic carbon 1077 fc_cons = 0.0 & 1078 - (xthetapn * fprn(ji,jj) * zphn(ji,jj)) - (xthetapd * fprd(ji,jj) * zphd(ji,jj)) ! primary production 1079 fc_prod = 0.0 & 1080 + (xthetapn * xphi * fgmipn(ji,jj)) + (xphi * fgmidc(ji,jj)) & ! messy feeding remin 1081 + (xthetapn * xphi * fgmepn(ji,jj)) + (xthetapd * xphi * fgmepd(ji,jj)) & ! messy feeding remin 1082 + (xthetazmi * xphi * fgmezmi(ji,jj)) + (xphi * fgmedc(ji,jj)) & ! messy feeding remin 1083 + fmiresp(ji,jj) + fmeresp(ji,jj) + fddc(ji,jj) + freminc(ji,jj) + (xthetapn * fdpn2(ji,jj)) & ! resp., remin., losses 1084 + (xthetapd * fdpd2(ji,jj)) + (xthetazmi * fdzmi2(ji,jj)) & ! losses 1085 + (xthetazme * fdzme2(ji,jj)) ! losses 1086 !! 1087 !! riverine flux 1088 if ( jriver_c .gt. 0 ) then 1089 f_riv_loc_c(ji,jj) = f_riv_c(ji,jj) * friver_dep(jk,mbathy(ji,jj)) / fse3t(ji,jj,jk) 1090 fc_prod = fc_prod + f_riv_loc_c(ji,jj) 1091 endif 1092 !! 1093 !! benthic remineralisation 1094 if (jk.eq.mbathy(ji,jj) .and. jorgben.eq.1 .and. ibenthic.eq.1) then 1095 fc_prod = fc_prod + (f_benout_c(ji,jj) / fse3t(ji,jj,jk)) 1096 endif 1097 if (jk.eq.mbathy(ji,jj) .and. jinorgben.eq.1 .and. ibenthic.eq.1) then 1098 fc_prod = fc_prod + (f_benout_ca(ji,jj) / fse3t(ji,jj,jk)) 1099 endif 1100 !! 1101 !! community respiration (does not include CaCO3 terms - obviously!) 1102 fcomm_resp(ji,jj) = fcomm_resp(ji,jj) + fc_prod 1103 !! 1104 !! CaCO3 1105 fc_prod = fc_prod - ftempca(ji,jj) + freminca(ji,jj) 1106 !! 1107 !! riverine flux 1108 if ( jk .eq. 1 .and. jriver_c .gt. 0 ) then 1109 fc_prod = fc_prod + f_riv_c(ji,jj) 1110 endif 1111 !! 1112 btra(ji,jj,jpdic) = b0 * ( & 1113 fc_prod + fc_cons ) 1114 !! 1115 fcar_cons(ji,jj) = fcar_cons(ji,jj) + ( fse3t(ji,jj,jk) * ( & ! consumption of dissolved carbon 1116 fc_cons ) ) 1117 fcar_prod(ji,jj) = fcar_prod(ji,jj) + ( fse3t(ji,jj,jk) * ( & ! production of dissolved carbon 1118 fc_prod ) ) 1119 !! 1120 !!---------------------------------------------------------------------- 1121 !! alkalinity 1122 fa_prod = 0.0 & 1123 + (2.0 * freminca(ji,jj)) ! CaCO3 dissolution 1124 fa_cons = 0.0 & 1125 - (2.0 * ftempca(ji,jj)) ! CaCO3 production 1126 !! 1127 !! riverine flux 1128 if ( jriver_alk .gt. 0 ) then 1129 f_riv_loc_alk(ji,jj) = f_riv_alk(ji,jj) * friver_dep(jk,mbathy(ji,jj)) / fse3t(ji,jj,jk) 1130 fa_prod = fa_prod + f_riv_loc_alk(ji,jj) 1131 endif 1132 !! 1133 !! benthic remineralisation 1134 if (jk.eq.mbathy(ji,jj) .and. jinorgben.eq.1 .and. ibenthic.eq.1) then 1135 fa_prod = fa_prod + (2.0 * f_benout_ca(ji,jj) / fse3t(ji,jj,jk)) 1136 endif 1137 !! 1138 btra(ji,jj,jpalk) = b0 * ( & 1139 fa_prod + fa_cons ) 1140 !! 1141 !!---------------------------------------------------------------------- 1142 !! oxygen (has protection at low O2 concentrations; OCMIP-2 style) 1143 fo2_prod(ji,jj) = 0.0 & 1144 + (xthetanit * fprn(ji,jj) * zphn(ji,jj)) & ! Pn primary production, N 1145 + (xthetanit * fprd(ji,jj) * zphd(ji,jj)) & ! Pd primary production, N 1146 + (xthetarem * xthetapn * fprn(ji,jj) * zphn(ji,jj)) & ! Pn primary production, C 1147 + (xthetarem * xthetapd * fprd(ji,jj) * zphd(ji,jj)) ! Pd primary production, C 1148 fo2_ncons(ji,jj) = 0.0 & 1149 - (xthetanit * xphi * fgmipn(ji,jj)) & ! Pn messy feeding remin., N 1150 - (xthetanit * xphi * fgmid(ji,jj)) & ! D messy feeding remin., N 1151 - (xthetanit * xphi * fgmepn(ji,jj)) & ! Pn messy feeding remin., N 1152 - (xthetanit * xphi * fgmepd(ji,jj)) & ! Pd messy feeding remin., N 1153 - (xthetanit * xphi * fgmezmi(ji,jj)) & ! Zi messy feeding remin., N 1154 - (xthetanit * xphi * fgmed(ji,jj)) & ! D messy feeding remin., N 1155 - (xthetanit * fmiexcr(ji,jj)) & ! microzoo excretion, N 1156 - (xthetanit * fmeexcr(ji,jj)) & ! mesozoo excretion, N 1157 - (xthetanit * fdd(ji,jj)) & ! slow detritus remin., N 1158 - (xthetanit * freminn(ji,jj)) & ! fast detritus remin., N 1159 - (xthetanit * fdpn2(ji,jj)) & ! Pn losses, N 1160 - (xthetanit * fdpd2(ji,jj)) & ! Pd losses, N 1161 - (xthetanit * fdzmi2(ji,jj)) & ! Zmi losses, N 1162 - (xthetanit * fdzme2(ji,jj)) ! Zme losses, N 1163 !! 1164 !! benthic remineralisation 1165 if (jk.eq.mbathy(ji,jj) .and. jorgben.eq.1 .and. ibenthic.eq.1) then 1166 fo2_ncons(ji,jj) = fo2_ncons(ji,jj) - (xthetanit * f_benout_n(ji,jj) / fse3t(ji,jj,jk)) 1167 endif 1168 fo2_ccons(ji,jj) = 0.0 & 1169 - (xthetarem * xthetapn * xphi * fgmipn(ji,jj)) & ! Pn messy feeding remin., C 1170 - (xthetarem * xphi * fgmidc(ji,jj)) & ! D messy feeding remin., C 1171 - (xthetarem * xthetapn * xphi * fgmepn(ji,jj)) & ! Pn messy feeding remin., C 1172 - (xthetarem * xthetapd * xphi * fgmepd(ji,jj)) & ! Pd messy feeding remin., C 1173 - (xthetarem * xthetazmi * xphi * fgmezmi(ji,jj)) & ! Zi messy feeding remin., C 1174 - (xthetarem * xphi * fgmedc(ji,jj)) & ! D messy feeding remin., C 1175 - (xthetarem * fmiresp(ji,jj)) & ! microzoo respiration, C 1176 - (xthetarem * fmeresp(ji,jj)) & ! mesozoo respiration, C 1177 - (xthetarem * fddc(ji,jj)) & ! slow detritus remin., C 1178 - (xthetarem * freminc(ji,jj)) & ! fast detritus remin., C 1179 - (xthetarem * xthetapn * fdpn2(ji,jj)) & ! Pn losses, C 1180 - (xthetarem * xthetapd * fdpd2(ji,jj)) & ! Pd losses, C 1181 - (xthetarem * xthetazmi * fdzmi2(ji,jj)) & ! Zmi losses, C 1182 - (xthetarem * xthetazme * fdzme2(ji,jj)) ! Zme losses, C 1183 !! 1184 !! benthic remineralisation 1185 if (jk.eq.mbathy(ji,jj) .and. jorgben.eq.1 .and. ibenthic.eq.1) then 1186 fo2_ccons(ji,jj) = fo2_ccons(ji,jj) - (xthetarem * f_benout_c(ji,jj) / fse3t(ji,jj,jk)) 1187 endif 1188 fo2_cons(ji,jj) = fo2_ncons(ji,jj) + fo2_ccons(ji,jj) 1189 !! 1190 !! is this a suboxic zone? 1191 if (zoxy(ji,jj).lt.xo2min) then ! deficient O2; production fluxes only 1192 btra(ji,jj,jpoxy) = b0 * ( & 1193 fo2_prod(ji,jj) ) 1194 foxy_prod(ji,jj) = foxy_prod(ji,jj) + ( fse3t(ji,jj,jk) * fo2_prod(ji,jj) ) 1195 foxy_anox(ji,jj) = foxy_anox(ji,jj) + ( fse3t(ji,jj,jk) * fo2_cons(ji,jj) ) 1196 else ! sufficient O2; production + consumption fluxes 1197 btra(ji,jj,jpoxy) = b0 * ( & 1198 fo2_prod(ji,jj) + fo2_cons(ji,jj) ) 1199 foxy_prod(ji,jj) = foxy_prod(ji,jj) + ( fse3t(ji,jj,jk) * fo2_prod(ji,jj) ) 1200 foxy_cons(ji,jj) = foxy_cons(ji,jj) + ( fse3t(ji,jj,jk) * fo2_cons(ji,jj) ) 1201 endif 1202 !! 1203 !! air-sea fluxes (if this is the surface box) 1204 if (jk.eq.1) then 1205 !! 1206 !! CO2 flux 1207 btra(ji,jj,jpdic) = btra(ji,jj,jpdic) + (b0 * f_co2flux(ji,jj)) 1208 !! 1209 !! O2 flux (mol/m3/s -> mmol/m3/d) 1210 btra(ji,jj,jpoxy) = btra(ji,jj,jpoxy) + (b0 * f_o2flux(ji,jj)) 1211 endif 1212 # endif 1213 1214 # if defined key_debug_medusa 1215 !! report state variable fluxes (not including fast-sinking detritus) 1216 if (idf.eq.1.AND.idfval.eq.1) then 1217 IF (lwp) write (numout,*) '------------------------------' 1218 IF (lwp) write (numout,*) 'btra(ji,jj,jpchn)(',jk,') = ', btra(ji,jj,jpchn) 1219 IF (lwp) write (numout,*) 'btra(ji,jj,jpchd)(',jk,') = ', btra(ji,jj,jpchd) 1220 IF (lwp) write (numout,*) 'btra(ji,jj,jpphn)(',jk,') = ', btra(ji,jj,jpphn) 1221 IF (lwp) write (numout,*) 'btra(ji,jj,jpphd)(',jk,') = ', btra(ji,jj,jpphd) 1222 IF (lwp) write (numout,*) 'btra(ji,jj,jppds)(',jk,') = ', btra(ji,jj,jppds) 1223 IF (lwp) write (numout,*) 'btra(ji,jj,jpzmi)(',jk,') = ', btra(ji,jj,jpzmi) 1224 IF (lwp) write (numout,*) 'btra(ji,jj,jpzme)(',jk,') = ', btra(ji,jj,jpzme) 1225 IF (lwp) write (numout,*) 'btra(ji,jj,jpdet)(',jk,') = ', btra(ji,jj,jpdet) 1226 IF (lwp) write (numout,*) 'btra(ji,jj,jpdin)(',jk,') = ', btra(ji,jj,jpdin) 1227 IF (lwp) write (numout,*) 'btra(ji,jj,jpsil)(',jk,') = ', btra(ji,jj,jpsil) 1228 IF (lwp) write (numout,*) 'btra(ji,jj,jpfer)(',jk,') = ', btra(ji,jj,jpfer) 1229 # if defined key_roam 1230 IF (lwp) write (numout,*) 'btra(ji,jj,jpdtc)(',jk,') = ', btra(ji,jj,jpdtc) 1231 IF (lwp) write (numout,*) 'btra(ji,jj,jpdic)(',jk,') = ', btra(ji,jj,jpdic) 1232 IF (lwp) write (numout,*) 'btra(ji,jj,jpalk)(',jk,') = ', btra(ji,jj,jpalk) 1233 IF (lwp) write (numout,*) 'btra(ji,jj,jpoxy)(',jk,') = ', btra(ji,jj,jpoxy) 1234 # endif 1235 endif 1236 # endif 1237 1238 !!---------------------------------------------------------------------- 1239 !! Integrate calculated fluxes for mass balance 1240 !!---------------------------------------------------------------------- 1241 !! 1242 !! === nitrogen === 1243 fflx_n(ji,jj) = fflx_n(ji,jj) + & 1244 fse3t(ji,jj,jk) * ( btra(ji,jj,jpphn) + btra(ji,jj,jpphd) + btra(ji,jj,jpzmi) + btra(ji,jj,jpzme) + btra(ji,jj,jpdet) + btra(ji,jj,jpdin) ) 1245 !! === silicon === 1246 fflx_si(ji,jj) = fflx_si(ji,jj) + & 1247 fse3t(ji,jj,jk) * ( btra(ji,jj,jppds) + btra(ji,jj,jpsil) ) 1248 !! === iron === 1249 fflx_fe(ji,jj) = fflx_fe(ji,jj) + & 1250 fse3t(ji,jj,jk) * ( ( xrfn * ( btra(ji,jj,jpphn) + btra(ji,jj,jpphd) + btra(ji,jj,jpzmi) + btra(ji,jj,jpzme) + btra(ji,jj,jpdet)) ) + btra(ji,jj,jpfer) ) 1251 # if defined key_roam 1252 !! === carbon === 1253 fflx_c(ji,jj) = fflx_c(ji,jj) + & 1254 fse3t(ji,jj,jk) * ( (xthetapn * btra(ji,jj,jpphn)) + (xthetapd * btra(ji,jj,jpphd)) + & 1255 (xthetazmi * btra(ji,jj,jpzmi)) + (xthetazme * btra(ji,jj,jpzme)) + btra(ji,jj,jpdtc) + btra(ji,jj,jpdic) ) 1256 !! === alkalinity === 1257 fflx_a(ji,jj) = fflx_a(ji,jj) + & 1258 fse3t(ji,jj,jk) * ( btra(ji,jj,jpalk) ) 1259 !! === oxygen === 1260 fflx_o2(ji,jj) = fflx_o2(ji,jj) + & 1261 fse3t(ji,jj,jk) * ( btra(ji,jj,jpoxy) ) 1262 # endif 1263 1264 !!---------------------------------------------------------------------- 1265 !! Apply calculated tracer fluxes 1266 !!---------------------------------------------------------------------- 1267 !! 1268 !! units: [unit of tracer] per second (fluxes are calculated above per day) 1269 !! 1270 ibio_switch = 1 1271 # if defined key_gulf_finland 1272 !! AXY (17/05/13): fudge in a Gulf of Finland correction; uses longitude- 1273 !! latitude range to establish if this is a Gulf of Finland 1274 !! grid cell; if so, then BGC fluxes are ignored (though 1275 !! still calculated); for reference, this is meant to be a 1276 !! temporary fix to see if all of my problems can be done 1277 !! away with if I switch off BGC fluxes in the Gulf of 1278 !! Finland, which currently appears the source of trouble 1279 if ( glamt(ji,jj).gt.24.7 .and. glamt(ji,jj).lt.27.8 .and. & 1280 & gphit(ji,jj).gt.59.2 .and. gphit(ji,jj).lt.60.2 ) then 1281 ibio_switch = 0 1282 endif 1283 # endif 1284 if (ibio_switch.eq.1) then 1285 tra(ji,jj,jk,jpchn) = tra(ji,jj,jk,jpchn) + (btra(ji,jj,jpchn) / 86400.) 1286 tra(ji,jj,jk,jpchd) = tra(ji,jj,jk,jpchd) + (btra(ji,jj,jpchd) / 86400.) 1287 tra(ji,jj,jk,jpphn) = tra(ji,jj,jk,jpphn) + (btra(ji,jj,jpphn) / 86400.) 1288 tra(ji,jj,jk,jpphd) = tra(ji,jj,jk,jpphd) + (btra(ji,jj,jpphd) / 86400.) 1289 tra(ji,jj,jk,jppds) = tra(ji,jj,jk,jppds) + (btra(ji,jj,jppds) / 86400.) 1290 tra(ji,jj,jk,jpzmi) = tra(ji,jj,jk,jpzmi) + (btra(ji,jj,jpzmi) / 86400.) 1291 tra(ji,jj,jk,jpzme) = tra(ji,jj,jk,jpzme) + (btra(ji,jj,jpzme) / 86400.) 1292 tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + (btra(ji,jj,jpdet) / 86400.) 1293 tra(ji,jj,jk,jpdin) = tra(ji,jj,jk,jpdin) + (btra(ji,jj,jpdin) / 86400.) 1294 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + (btra(ji,jj,jpsil) / 86400.) 1295 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + (btra(ji,jj,jpfer) / 86400.) 1296 # if defined key_roam 1297 tra(ji,jj,jk,jpdtc) = tra(ji,jj,jk,jpdtc) + (btra(ji,jj,jpdtc) / 86400.) 1298 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + (btra(ji,jj,jpdic) / 86400.) 1299 tra(ji,jj,jk,jpalk) = tra(ji,jj,jk,jpalk) + (btra(ji,jj,jpalk) / 86400.) 1300 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + (btra(ji,jj,jpoxy) / 86400.) 1301 # endif 1302 endif 1303 1304 !! AXY (18/11/16): CMIP6 diagnostics 1305 IF( med_diag%FBDDTALK%dgsave ) THEN 1306 fbddtalk(ji,jj) = fbddtalk(ji,jj) + (btra(ji,jj,jpalk) * fse3t(ji,jj,jk)) 1307 ENDIF 1308 IF( med_diag%FBDDTDIC%dgsave ) THEN 1309 fbddtdic(ji,jj) = fbddtdic(ji,jj) + (btra(ji,jj,jpdic) * fse3t(ji,jj,jk)) 1310 ENDIF 1311 IF( med_diag%FBDDTDIFE%dgsave ) THEN 1312 fbddtdife(ji,jj) = fbddtdife(ji,jj) + (btra(ji,jj,jpfer) * fse3t(ji,jj,jk)) 1313 ENDIF 1314 IF( med_diag%FBDDTDIN%dgsave ) THEN 1315 fbddtdin(ji,jj) = fbddtdin(ji,jj) + (btra(ji,jj,jpdin) * fse3t(ji,jj,jk)) 1316 ENDIF 1317 IF( med_diag%FBDDTDISI%dgsave ) THEN 1318 fbddtdisi(ji,jj) = fbddtdisi(ji,jj) + (btra(ji,jj,jpsil) * fse3t(ji,jj,jk)) 1319 ENDIF 1320 !! 1321 IF( med_diag%BDDTALK3%dgsave ) THEN 1322 bddtalk3(ji,jj,jk) = btra(ji,jj,jpalk) 1323 ENDIF 1324 IF( med_diag%BDDTDIC3%dgsave ) THEN 1325 bddtdic3(ji,jj,jk) = btra(ji,jj,jpdic) 1326 ENDIF 1327 IF( med_diag%BDDTDIFE3%dgsave ) THEN 1328 bddtdife3(ji,jj,jk) = btra(ji,jj,jpfer) 1329 ENDIF 1330 IF( med_diag%BDDTDIN3%dgsave ) THEN 1331 bddtdin3(ji,jj,jk) = btra(ji,jj,jpdin) 1332 ENDIF 1333 IF( med_diag%BDDTDISI3%dgsave ) THEN 1334 bddtdisi3(ji,jj,jk) = btra(ji,jj,jpsil) 1335 ENDIF 1336 1337 # if defined key_debug_medusa 1338 IF (lwp) write (numout,*) '------' 1339 IF (lwp) write (numout,*) 'trc_bio_medusa: end all calculations' 1340 IF (lwp) write (numout,*) 'trc_bio_medusa: now outputs' 1341 CALL flush(numout) 1342 # endif 1343 1344 # if defined key_axy_nancheck 1345 !!---------------------------------------------------------------------- 1346 !! Check calculated tracer fluxes 1347 !!---------------------------------------------------------------------- 1348 !! 1349 DO jn = 1,jptra 1350 fq0 = btra(ji,jj,jn) 1351 !! AXY (30/01/14): "isnan" problem on HECTOR 1352 !! if (fq0 /= fq0 ) then 1353 if ( ieee_is_nan( fq0 ) ) then 1354 !! there's a NaN here 1355 if (lwp) write(numout,*) 'NAN detected in btra(ji,jj,', ji, ',', & 1356 & jj, ',', jk, ',', jn, ') at time', kt 1357 CALL ctl_stop( 'trcbio_medusa, NAN in btra field' ) 1358 endif 1359 ENDDO 1360 DO jn = 1,jptra 1361 fq0 = tra(ji,jj,jk,jn) 1362 !! AXY (30/01/14): "isnan" problem on HECTOR 1363 !! if (fq0 /= fq0 ) then 1364 if ( ieee_is_nan( fq0 ) ) then 1365 !! there's a NaN here 1366 if (lwp) write(numout,*) 'NAN detected in tra(', ji, ',', & 1367 & jj, ',', jk, ',', jn, ') at time', kt 1368 CALL ctl_stop( 'trcbio_medusa, NAN in tra field' ) 1369 endif 1370 ENDDO 1371 CALL flush(numout) 1372 # endif 1373 1374 !!---------------------------------------------------------------------- 1375 !! Check model conservation 1376 !! these terms merely sum up the tendency terms of the relevant 1377 !! state variables, which should sum to zero; the iron cycle is 1378 !! complicated by fluxes that add (aeolian deposition and seafloor 1379 !! remineralisation) and remove (scavenging) dissolved iron from 1380 !! the model (i.e. the sum of iron fluxes is unlikely to be zero) 1381 !!---------------------------------------------------------------------- 1382 !! 1383 !! fnit0 = btra(ji,jj,jpphn) + btra(ji,jj,jpphd) + btra(ji,jj,jpzmi) + btra(ji,jj,jpzme) + btra(ji,jj,jpdet) + btra(ji,jj,jpdin) ! + ftempn(ji,jj) 1384 !! fsil0 = btra(ji,jj,jppds) + btra(ji,jj,jpsil) ! + ftempsi(ji,jj) 1385 !! ffer0 = (xrfn * fnit0) + btra(ji,jj,jpfer) 1386 # if defined key_roam 1387 !! fcar0 = 0. 1388 !! falk0 = 0. 1389 !! foxy0 = 0. 1390 # endif 1391 !! 1392 !! if (kt/240*240.eq.kt) then 1393 !! if (ji.eq.2.and.jj.eq.2.and.jk.eq.1) then 1394 !! IF (lwp) write (*,*) '*******!MEDUSA Conservation!*******',kt 1395 # if defined key_roam 1396 !! IF (lwp) write (*,*) fnit0,fsil0,ffer0,fcar0,falk0,foxy0 1397 # else 1398 !! IF (lwp) write (*,*) fnit0,fsil0,ffer0 1399 # endif 1400 !! endif 1401 !! endif 1402 1403 ! MAYBE BUT A BREAK IN HERE - marc 20/4/17 1404 ! (this would make the previous section about 470 lines and the one below 1405 ! about 700 lines) 1406 ENDIF 1407 ENDDO 1408 ENDDO 955 !!------------------------------------------------------------------ 956 !! Updating tracers 957 !!------------------------------------------------------------------ 958 CALL bio_medusa_update( kt, jk ) 959 960 ! Diagnostic update - marc 1409 961 1410 962 DO jj = 2,jpjm1
Note: See TracChangeset
for help on using the changeset viewer.
