Changeset 7996


Ignore:
Timestamp:
2017-05-05T12:09:58+02:00 (3 years ago)
Author:
marc
Message:

Pulled the updating of tracers out of trcbio_medusa.F90

Location:
branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA
Files:
1 added
2 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_mod.F90

    r7986 r7996  
    125125   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ftot_zmi,ftot_zme,ftot_det,ftot_dtc 
    126126 
     127   !! use biological fluxes (1) or not (0) 
     128   INTEGER  ::    ibio_switch 
     129   !! 
    127130   !! diagnose fluxes (should only be used in 1D runs) 
    128131   INTEGER                               :: idf, idfval 
     
    174177   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_runoff,f_riv_n,f_riv_si 
    175178   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_riv_c,f_riv_alk 
     179   !! AXY (19/07/12): variables for local riverine fluxes to handle  
     180   !! inputs below surface 
     181   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_riv_loc_n,f_riv_loc_si 
     182   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_riv_loc_c, f_riv_loc_alk 
    176183 
    177184   !! Jpalm -- 11-10-2015 -- adapt diag to iom_use 
     
    371378               f_runoff(jpi,jpj),f_riv_n(jpi,jpj),f_riv_si(jpi,jpj),  & 
    372379               f_riv_c(jpi,jpj),f_riv_alk(jpi,jpj),                   & 
     380               f_riv_loc_n(jpi,jpj),f_riv_loc_si(jpi,jpj),            & 
     381               f_riv_loc_c(jpi,jpj),f_riv_loc_alk(jpi,jpj),           & 
    373382               STAT = bio_medusa_alloc) 
    374383 
  • branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcbio_medusa.F90

    r7986 r7996  
    103103      USE iron_chem_scav_mod,         ONLY: iron_chem_scav 
    104104      USE detritus_mod,               ONLY: detritus 
     105      USE bio_medusa_update_mod,      ONLY: bio_medusa_update 
    105106      USE bio_medusa_diag_slice_mod,  ONLY: bio_medusa_diag_slice 
    106107      USE bio_medusa_fin_mod,         ONLY: bio_medusa_fin 
     
    297298      INTEGER  ::    iball 
    298299      !! use biological fluxes (1) or not (0) 
    299       INTEGER  ::    ibio_switch 
     300!      INTEGER  ::    ibio_switch 
    300301      !! 
    301302      !! diagnose fluxes (should only be used in 1D runs) 
     
    363364!      REAL(wp), DIMENSION(jpi,jpj) :: f_runoff, f_riv_n, f_riv_si, f_riv_c, f_riv_alk 
    364365      !! 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_alk 
     366!      REAL(wp), DIMENSION(jpi,jpj) :: f_riv_loc_n, f_riv_loc_si, f_riv_loc_c, f_riv_loc_alk 
    366367      !!--------------------------------------------------------------------- 
    367368 
     
    952953         CALL detritus( jk, iball ) 
    953954 
    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 
    1409961 
    1410962         DO jj = 2,jpjm1 
Note: See TracChangeset for help on using the changeset viewer.