New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 8039 – NEMO

Changeset 8039


Ignore:
Timestamp:
2017-05-18T11:14:31+02:00 (7 years ago)
Author:
marc
Message:

Removed about 40 2d arrays from bio_medusa_mod.F90

Location:
branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA
Files:
6 edited

Legend:

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

    r8023 r8039  
    3939                                   dms_aran2d, dms_hall, dms_hall2d,      & 
    4040                                   dms_simo, dms_simo2d, dms_surf,        & 
    41                                    dms_surf2d, f_BetaD,                   & 
    42                                    f_co2flux, f_co2flux2d, f_co2starair,  & 
     41                                   dms_surf2d,                            & 
     42                                   f_co2flux, f_co2flux2d,                & 
    4343                                   f_co2starair_2d, f_co3,                & 
    44                                    f_dcf, f_dpco2, f_fco2a_2d, f_fco2atm, & 
    45                                    f_fco2w, f_fco2w_2d, f_h2co3,          & 
    46                                    f_hco3, f_henry, f_insitut, f_K0,      & 
    47                                    f_kw660, f_kw6602d, f_kwco2, f_kwo2,   & 
    48                                    f_o2flux, f_o2flux2d,                  & 
    49                                    f_o2sat, f_o2sat2d, f_ocndpco2_2d,     & 
     44                                   f_dcf, f_fco2a_2d, f_fco2w_2d,         & 
     45                                   f_h2co3, f_hco3, f_henry,              & 
     46                                   f_kw660, f_kw6602d,                    & 
     47                                   f_o2flux, f_o2flux2d, f_o2sat,         & 
     48                                   f_o2sat2d, f_ocndpco2_2d,              & 
    5049                                   f_ocnk0_2d, f_ocnkwco2_2d,             & 
    5150                                   f_ocnrhosw_2d, f_ocnschco2_2d,         & 
    52                                    f_omarg, f_omcal, f_opres,             & 
    53                                    f_pco2a2d, f_pco2atm,                  & 
    54                                    f_pco2w, f_pco2w2d, f_ph, f_pp0,       & 
    55                                    f_pp02d, f_rhosw,                      & 
    56                                    f_schmidtco2, f_TALK, f_TALK2d,        & 
    57                                    f_TDIC, f_TDIC2d, f_xco2a, f_xco2a_2d, & 
    58                                    iters,                                 & 
     51                                   f_omarg, f_omcal,                      & 
     52                                   f_pco2a2d, f_pco2atm, f_pco2w,         & 
     53                                   f_pco2w2d, f_ph, f_pp0, f_pp02d,       & 
     54                                   f_TALK, f_TALK2d, f_TDIC, f_TDIC2d,    & 
     55                                   f_xco2a, f_xco2a_2d,                   & 
    5956                                   zalk, zdic, zoxy, zsal, ztmp,          & 
    6057# endif 
     
    6966      USE in_out_manager,    ONLY: lwp, numout 
    7067      USE oce,               ONLY: PCO2a_in_cpl 
    71       USE par_oce,           ONLY: jpim1, jpjm1 
     68      USE par_kind,          ONLY: wp 
     69      USE par_oce,           ONLY: jpi, jpim1, jpj, jpjm1 
    7270      USE sbc_oce,           ONLY: fr_i, lk_oasis, qsr, wndm 
    7371      USE sms_medusa,        ONLY: jdms, jdms_input, jdms_model,          & 
     
    9795      INTEGER, INTENT( in ) :: kt 
    9896 
     97      !! Loop variables 
     98      INTEGER :: ji, jj 
     99 
    99100# if defined key_roam 
    100101      !! jpalm 14-07-2016: convert CO2flux diag from mmol/m2/d to kg/m2/s 
     
    102103      REAL, PARAMETER :: secs_in_day    = 86400.0  !! s / d 
    103104      REAL, PARAMETER :: CO2flux_conv   = (1.e-6 * weight_CO2_mol) / secs_in_day 
     105 
     106      INTEGER :: iters 
     107 
     108      !! AXY (23/06/15): additional diagnostics for MOCSY and oxygen 
     109      REAL(wp), DIMENSION(jpi,jpj) :: f_fco2w, f_rhosw 
     110      REAL(wp), DIMENSION(jpi,jpj) :: f_fco2atm 
     111      REAL(wp), DIMENSION(jpi,jpj) :: f_schmidtco2, f_kwco2, f_K0 
     112      REAL(wp), DIMENSION(jpi,jpj) :: f_co2starair, f_dpco2 
     113      !! Output arguments from mocsy_interface, which aren't used 
     114      REAL(wp) :: f_BetaD_dum, f_opres_dum 
     115      REAL(wp) :: f_insitut_dum 
     116      REAL(wp) :: f_kwo2_dum 
    104117# endif 
    105118 
    106       INTEGER :: ji, jj 
    107119 
    108120# if defined key_roam 
     
    171183                                    f_h2co3(ji,jj),f_hco3(ji,jj),            & 
    172184                                    f_co3(ji,jj),f_omarg(ji,jj),             & 
    173                                     f_omcal(ji,jj),f_BetaD(ji,jj),           & 
    174                                     f_rhosw(ji,jj),f_opres(ji,jj),           & 
    175                                     f_insitut(ji,jj),f_pco2atm(ji,jj),       & 
     185                                    f_omcal(ji,jj),f_BetaD_dum,              & 
     186                                    f_rhosw(ji,jj),f_opres_dum,              & 
     187                                    f_insitut_dum,f_pco2atm(ji,jj),          & 
    176188                                    f_fco2atm(ji,jj),f_schmidtco2(ji,jj),    & 
    177189                                    f_kwco2(ji,jj),f_K0(ji,jj),              & 
     
    192204         DO ji = 2,jpim1 
    193205            if (tmask(ji,jj,1) == 1) then      
    194                iters(ji,jj) = 0 
     206               iters = 0 
    195207               !! 
    196208               !! carbon dioxide (CO2); Jerry Blackford code (ostensibly  
     
    205217                                   f_co2flux(ji,jj),f_TDIC(ji,jj),           & 
    206218                                   f_TALK(ji,jj),f_dcf(ji,jj),               & 
    207                                    f_henry(ji,jj),iters(ji,jj)) 
     219                                   f_henry(ji,jj),iters) 
    208220               !! 
    209221               !! AXY (09/01/14): removed iteration and NaN checks; these have 
     
    213225               !!                 output warnings are retained here so that 
    214226               !!                 failure position can be determined 
    215                if (iters(ji,jj) .eq. 25) then 
     227               if (iters .eq. 25) then 
    216228                  IF(lwp) WRITE(numout,*) ' trc_bio_medusa: ITERS WARNING, ', & 
    217                      iters(ji,jj), ' AT (', ji, ', ', jj, ', 1) AT ', kt 
     229                     iters, ' AT (', ji, ', ', jj, ', 1) AT ', kt 
    218230               endif 
    219231            ENDIF 
     
    244256               !! AXY (23/06/15): add in some extra MOCSY diagnostics 
    245257               f_fco2w(ji,jj)        = f_xco2a(ji,jj) 
    246                f_BetaD(ji,jj)        = 1. 
     258! This doesn't seem to be used - marc 16/5/17 
     259!               f_BetaD(ji,jj)        = 1. 
    247260               f_rhosw(ji,jj)        = 1.026 
    248                f_opres(ji,jj)        = 0. 
    249                f_insitut(ji,jj)      = ztmp(ji,jj) 
     261! This doesn't seem to be used - marc 16/5/17 
     262!               f_opres(ji,jj)        = 0. 
     263!               f_insitut(ji,jj)      = ztmp(ji,jj) 
    250264               f_pco2atm(ji,jj)      = f_xco2a(ji,jj) 
    251265               f_fco2atm(ji,jj)      = f_xco2a(ji,jj) 
     
    271285               !! AXY (23/06/15): amend input list for oxygen to account  
    272286               !!                 for common gas transfer velocity 
    273                !! Note that f_kwo2 is an about from the subroutine below, 
    274                !! which doesn't seem to be used - marc 10/4/17  
    275287               CALL trc_oxy_medusa(ztmp(ji,jj),zsal(ji,jj),f_kw660(ji,jj),   & 
    276288                                   f_pp0(ji,jj),zoxy(ji,jj),                 & 
    277                                    f_kwo2(ji,jj),f_o2flux(ji,jj),            & 
     289                                   f_kwo2_dum,f_o2flux(ji,jj),               & 
    278290                                   f_o2sat(ji,jj)) 
    279291               !! 
  • branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_mod.F90

    r8023 r8039  
    4141   REAL(wp) ::    b0 
    4242 
    43    REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fthetan,faln,fchn1,fchn 
    44    REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fjln,fprn,frn 
    45    REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fthetad,fald,fchd1,fchd 
    46    REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fjld,fprd,frd 
    47  
    48    REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fjlim_pn, fjlim_pd 
    49    !! AXY (03/02/11): add in Liebig terms 
    50    REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fpnlim, fpdlim 
     43   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fthetan,fprn,frn 
     44   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fthetad,fprd,frd 
     45 
     46   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fjlim_pn,fjlim_pd 
    5147   !! AXY (16/07/09): add in Eppley curve functionality 
    5248   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fun_T,xvpnT,xvpdT 
     
    6763   !! 
    6864   !! silicon cycle 
    69    REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fsin,fnsi,fprds,fsdiss 
     65   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fsin,fprds,fsdiss 
    7066 
    7167   !! iron cycle; includes parameters for Parekh et al. (2005) iron scheme 
     
    7571 
    7672   !! Microzooplankton grazing 
    77    REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fmi1,fmi,fgmipn,fgmid,fgmidc 
    78    REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: finmi,ficmi,fstarmi,fmith 
     73   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fgmipn,fgmid,fgmidc 
     74   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: finmi,ficmi 
    7975   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fmigrow,fmiexcr,fmiresp 
    8076   !! 
    8177   !! Mesozooplankton grazing 
    82    REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fme1,fme,fgmepn,fgmepd 
     78   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fgmepn,fgmepd 
    8379   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fgmepds,fgmezmi,fgmed,fgmedc 
    84    REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: finme,ficme,fstarme,fmeth 
     80   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: finme,ficme 
    8581   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fmegrow,fmeexcr,fmeresp 
    8682   !! 
     
    10096 
    10197   !! Particle flux 
    102    REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fdep1,fcaco3 
     98   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fdep1 
    10399   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ftempn,ftempsi,ftempfe 
    104100   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ftempc,ftempca 
     
    107103   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ffastn,ffastsi,ffastfe 
    108104   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ffastc,ffastca 
    109    REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fprotf 
    110105   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fsedn,fsedsi,fsedfe,fsedc,fsedca 
    111106   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fccd 
    112    REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fccd_dep 
    113107 
    114108   !! AXY (08/07/11): fate of fast detritus reaching the seafloor 
     
    157151 
    158152   !! AXY (23/06/15): additional diagnostics for MOCSY and oxygen 
    159    REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_fco2w,f_BetaD,f_rhosw,f_opres 
    160    REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_insitut,f_pco2atm,f_fco2atm 
    161    REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_schmidtco2,f_kwco2,f_K0 
    162    REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_co2starair,f_dpco2,f_kwo2 
    163  
    164    INTEGER, ALLOCATABLE, DIMENSION(:,:)  :: iters  
     153   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_pco2atm 
    165154 
    166155   !! Carbon, alkalinity production and consumption 
     
    292281               zpho(jpi,jpj),                                         & 
    293282# endif 
    294                fthetan(jpi,jpj),faln(jpi,jpj),fchn1(jpi,jpj),         & 
    295                fchn(jpi,jpj),fjln(jpi,jpj),fprn(jpi,jpj),             & 
    296                frn(jpi,jpj),                                          & 
    297                fthetad(jpi,jpj),fald(jpi,jpj),fchd1(jpi,jpj),         & 
    298                fchd(jpi,jpj),fjld(jpi,jpj),fprd(jpi,jpj),             & 
    299                frd(jpi,jpj),                                          & 
    300                fjlim_pn(jpi,jpj), fjlim_pd(jpi,jpj),                  & 
    301                fpnlim(jpi,jpj), fpdlim(jpi,jpj),                      & 
    302                fun_T(jpi,jpj),xvpnT(jpi,jpj),xvpdT(jpi,jpj),          & 
    303                fun_Q10(jpi,jpj),                                      & 
     283               fthetan(jpi,jpj),fprn(jpi,jpj),frn(jpi,jpj),           & 
     284               fthetad(jpi,jpj),fprd(jpi,jpj),frd(jpi,jpj),           & 
     285               fjlim_pn(jpi,jpj),fjlim_pd(jpi,jpj),                   & 
     286               fun_T(jpi,jpj),fun_Q10(jpi,jpj),                       & 
    304287               fprn_ml(jpi,jpj),fprd_ml(jpi,jpj),                     & 
    305288               fnln(jpi,jpj),ffln2(jpi,jpj),                          & 
    306289               fnld(jpi,jpj),ffld(jpi,jpj),fsld(jpi,jpj),             & 
    307290               fsld2(jpi,jpj),                                        & 
    308                fsin(jpi,jpj),fnsi(jpi,jpj),fprds(jpi,jpj),            & 
    309                fsdiss(jpi,jpj),                                       & 
     291               fsin(jpi,jpj),fprds(jpi,jpj),fsdiss(jpi,jpj),          & 
    310292               ffetop(jpi,jpj),ffebot(jpi,jpj),ffescav(jpi,jpj),      & 
    311293               xFree(jpi,jpj),                                        & 
    312                fmi1(jpi,jpj),fmi(jpi,jpj),fgmipn(jpi,jpj),            & 
    313                fgmid(jpi,jpj),fgmidc(jpi,jpj),                        & 
    314                finmi(jpi,jpj),ficmi(jpi,jpj),fstarmi(jpi,jpj),        & 
    315                fmith(jpi,jpj),fmigrow(jpi,jpj),fmiexcr(jpi,jpj),      & 
    316                fmiresp(jpi,jpj),                                      & 
    317                fme1(jpi,jpj),fme(jpi,jpj),fgmepn(jpi,jpj),            & 
    318                fgmepd(jpi,jpj),fgmepds(jpi,jpj),fgmezmi(jpi,jpj),     & 
    319                fgmed(jpi,jpj),fgmedc(jpi,jpj),                        & 
    320                finme(jpi,jpj),ficme(jpi,jpj),fstarme(jpi,jpj),        & 
    321                fmeth(jpi,jpj),fmegrow(jpi,jpj),fmeexcr(jpi,jpj),      & 
    322                fmeresp(jpi,jpj),                                      & 
     294               fgmipn(jpi,jpj),fgmid(jpi,jpj),fgmidc(jpi,jpj),        & 
     295               finmi(jpi,jpj),ficmi(jpi,jpj),                         & 
     296               fmigrow(jpi,jpj),fmiexcr(jpi,jpj),fmiresp(jpi,jpj),    & 
     297               fgmepn(jpi,jpj),fgmepd(jpi,jpj),                       & 
     298               fgmepds(jpi,jpj),fgmezmi(jpi,jpj),fgmed(jpi,jpj),      & 
     299               fgmedc(jpi,jpj),                                       & 
     300               finme(jpi,jpj),ficme(jpi,jpj),                         & 
     301               fmegrow(jpi,jpj),fmeexcr(jpi,jpj),fmeresp(jpi,jpj),    & 
    323302               fdpn(jpi,jpj),fdpd(jpi,jpj),fdpds(jpi,jpj),            & 
    324303               fdzmi(jpi,jpj),fdzme(jpi,jpj),fdd(jpi,jpj),            & 
     
    335314               fregenfastc(jpi,jpj),                                  & 
    336315# endif 
    337                fdep1(jpi,jpj),fcaco3(jpi,jpj),                        & 
     316               fdep1(jpi,jpj),                                        & 
    338317               ftempn(jpi,jpj),ftempsi(jpi,jpj),ftempfe(jpi,jpj),     & 
    339318               ftempc(jpi,jpj),ftempca(jpi,jpj),                      & 
     
    342321               ffastn(jpi,jpj),ffastsi(jpi,jpj),ffastfe(jpi,jpj),     & 
    343322               ffastc(jpi,jpj),ffastca(jpi,jpj),                      & 
    344                fprotf(jpi,jpj),                                       & 
    345323               fsedn(jpi,jpj),fsedsi(jpi,jpj),fsedfe(jpi,jpj),        & 
    346324               fsedc(jpi,jpj),fsedca(jpi,jpj),                        & 
    347325               fccd(jpi,jpj),                                         & 
    348                fccd_dep(jpi,jpj),                                     & 
    349326               ffast2slown(jpi,jpj),ffast2slowc(jpi,jpj),             & 
    350327               ftot_n(jpi,jpj),ftot_si(jpi,jpj),ftot_fe(jpi,jpj),     & 
     
    377354               f_kw660(jpi,jpj),f_o2flux(jpi,jpj),f_o2sat(jpi,jpj),   & 
    378355               f_omcal(jpi,jpj),f_omarg(jpi,jpj),                     & 
    379                f_fco2w(jpi,jpj),f_BetaD(jpi,jpj),f_rhosw(jpi,jpj),    & 
    380                f_opres(jpi,jpj),f_insitut(jpi,jpj),                   & 
    381                f_pco2atm(jpi,jpj),f_fco2atm(jpi,jpj),                 & 
    382                f_schmidtco2(jpi,jpj),f_kwco2(jpi,jpj),f_K0(jpi,jpj),  & 
    383                f_co2starair(jpi,jpj),f_dpco2(jpi,jpj),                & 
    384                f_kwo2(jpi,jpj),                                       & 
    385                iters(jpi,jpj),                                        & 
     356               f_pco2atm(jpi,jpj),                 & 
    386357               fcomm_resp(jpi,jpj),                                   & 
    387358               fcar_prod(jpi,jpj),fcar_cons(jpi,jpj),                 & 
  • branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA/carb_chem.F90

    r8023 r8039  
    3131      !!  - ... 
    3232      !!---------------------------------------------------------------------- 
    33       USE bio_medusa_mod,    ONLY: iters, f_BetaD, f_co2flux,             & 
    34                                    f_co2starair, f_co3, f_dcf, f_dpco2,   & 
    35                                    f_fco2atm, f_fco2w, f_h2co3, f_hco3,   & 
    36                                    f_henry,                               & 
    37                                    f_insitut, f_K0, f_kw660, f_kwco2,     & 
    38                                    f_omarg, f_omcal, f_opres, f_pco2atm,  & 
    39                                    f_pco2w, f_ph, f_pp0, f_rhosw,         & 
    40                                    f_schmidtco2, f_TALK, f_TDIC, f_xco2a, & 
     33      USE bio_medusa_mod,    ONLY: f_co2flux, f_co3, f_dcf,               & 
     34                                   f_h2co3, f_hco3, f_henry,              & 
     35                                   f_kw660, f_omarg, f_omcal,             & 
     36                                   f_pco2atm, f_pco2w, f_ph, f_pp0,       & 
     37                                   f_TALK, f_TDIC, f_xco2a,               & 
    4138# if defined key_mocsy 
    4239                                   zpho,                                  & 
     
    7269      INTEGER, DIMENSION(jpi,jpj) ::     i2_omcal,i2_omarg 
    7370 
     71      !! AXY (23/06/15): additional diagnostics for MOCSY and oxygen 
     72      REAL(wp) :: f_rhosw 
     73      !! Output arguments from mocsy_interface, which aren't used 
     74      REAL(wp) :: f_fco2w_dum, f_BetaD_dum, f_opres_dum 
     75      REAL(wp) :: f_insitut_dum, f_fco2atm_dum 
     76      REAL(wp) :: f_schmidtco2_dum, f_kwco2_dum, f_K0_dum 
     77      REAL(wp) :: f_co2starair_dum, f_dpco2_dum 
    7478      !! temporary variables 
    7579      REAL(wp) ::    fq0,fq1,fq2,fq3,fq4 
    7680 
     81      INTEGER :: iters 
     82      !! Loop variables 
    7783      INTEGER :: ji, jj, jk 
    7884 
     
    155161                                       gphit(ji,jj),f_kw660(ji,jj),         & 
    156162                                       f_xco2a(ji,jj),1,f_ph(ji,jj),        & 
    157                                        f_pco2w(ji,jj),f_fco2w(ji,jj),       & 
     163                                       f_pco2w(ji,jj),f_fco2w_dum,          & 
    158164                                       f_h2co3(ji,jj),f_hco3(ji,jj),        & 
    159165                                       f_co3(ji,jj),f_omarg(ji,jj),         & 
    160                                        f_omcal(ji,jj),f_BetaD(ji,jj),       & 
    161                                        f_rhosw(ji,jj),f_opres(ji,jj),       & 
    162                                        f_insitut(ji,jj),f_pco2atm(ji,jj),   & 
    163                                        f_fco2atm(ji,jj),f_schmidtco2(ji,jj),& 
    164                                        f_kwco2(ji,jj),f_K0(ji,jj),          & 
    165                                        f_co2starair(ji,jj),f_co2flux(ji,jj),&  
    166                                        f_dpco2(ji,jj)) 
     166                                       f_omcal(ji,jj),f_BetaD_dum,          & 
     167                                       f_rhosw,f_opres_dum,                 & 
     168                                       f_insitut_dum,f_pco2atm(ji,jj),      & 
     169                                       f_fco2atm_dum,f_schmidtco2_dum,      & 
     170                                       f_kwco2_dum,f_K0_dum,                & 
     171                                       f_co2starair_dum,f_co2flux(ji,jj),   &  
     172                                       f_dpco2_dum) 
    167173                  !! 
    168174                  !! mmol / m3 -> umol / kg 
    169                   f_TDIC(ji,jj) = (zdic(ji,jj) / f_rhosw(ji,jj)) * 1000. 
     175                  f_TDIC(ji,jj) = (zdic(ji,jj) / f_rhosw) * 1000. 
    170176                  !! meq / m3 -> ueq / kg 
    171                   f_TALK(ji,jj) = (zalk(ji,jj) / f_rhosw(ji,jj)) * 1000. 
    172                   f_dcf(ji,jj)  = f_rhosw(ji,jj) 
     177                  f_TALK(ji,jj) = (zalk(ji,jj) / f_rhosw) * 1000. 
     178                  f_dcf(ji,jj)  = f_rhosw 
    173179#  else 
    174180                  !! AXY (22/06/15): use old PML carbonate chemistry  
     
    183189                                      f_co2flux(ji,jj),f_TDIC(ji,jj),       & 
    184190                                      f_TALK(ji,jj),f_dcf(ji,jj),           & 
    185                                       f_henry(ji,jj),iters(ji,jj)) 
     191                                      f_henry(ji,jj),iters) 
    186192                  !!  
    187193                  !! AXY (28/02/14): check output fields 
    188                   IF (iters(ji,jj) .eq. 25) THEN 
     194                  IF (iters .eq. 25) THEN 
    189195                     IF(lwp) WRITE(numout,*)                                & 
    190                         ' carb_chem: 3D ITERS WARNING, ',                   & 
    191                         iters(ji,jj), ' AT (', ji, ', ', jj, ', ',          & 
    192                         jk, ') AT ', kt 
     196                        ' carb_chem: 3D ITERS WARNING, ', iters, ' AT (',   & 
     197                        ji, ', ', jj, ', ', jk, ') AT ', kt 
    193198                  ENDIF 
    194199#  endif 
  • branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA/detritus_fast_sink.F90

    r8023 r8039  
    3535                                   f_benout_si,                            & 
    3636                                   f_fbenin_c, f_fbenin_ca, f_fbenin_fe,   & 
    37                                    f_fbenin_n, f_fbenin_si,                & 
    38                                    f_omcal, fcaco3,                        & 
    39                                    fccd, fccd_dep, fdep1, fdd,             & 
     37                                   f_fbenin_n, f_fbenin_si, f_omcal,       & 
     38                                   fccd, fdep1, fdd,                       & 
    4039                                   fdpd, fdpd2, fdpds, fdpds2,             & 
    4140                                   fdpn, fdpn2,                            & 
     
    5251                                   fmeexcr, fmiexcr,                       & 
    5352                                   fofd_fe, fofd_n, fofd_si,               & 
    54                                    fprotf,                                 & 
    5553                                   fregen, fregenfast, fregenfastsi,       & 
    5654                                   fregensi,                               & 
     
    7371      USE oce,               ONLY: tsn 
    7472      USE par_kind,          ONLY: wp 
    75       USE par_oce,           ONLY: jpim1, jpjm1 
     73      USE par_oce,           ONLY: jpi, jpim1, jpj, jpjm1 
    7674      USE sms_medusa,        ONLY: f2_ccd_cal, f3_omcal,                   & 
    7775                                   jexport, jfdfate, jinorgben, jocalccd,  & 
     
    102100      INTEGER :: ji, jj 
    103101 
    104       REAL(wp) ::    fb_val, fl_sst 
     102      REAL(wp) :: fb_val, fl_sst 
     103      !! Particle flux 
     104      REAL(wp) :: fcaco3 
     105      REAL(wp) :: fprotf 
     106      REAL(wp), DIMENSION(jpi,jpj) :: fccd_dep 
    105107      !! temporary variables 
    106108      REAL(wp) :: fq0,fq1,fq2,fq3,fq4,fq5,fq6,fq7,fq8 
     
    236238                  !!             primary production 
    237239                  !!               0.10 at equator; 0.02 at pole 
    238                   fcaco3(ji,jj) = xcaco3a + ((xcaco3b - xcaco3a) *           & 
    239                                              ((90.0 - abs(gphit(ji,jj))) /   & 
    240                                                90.0)) 
     240                  fcaco3 = xcaco3a + ((xcaco3b - xcaco3a) *                  & 
     241                                      ((90.0 - abs(gphit(ji,jj))) / 90.0)) 
    241242               elseif (jrratio.eq.1) then 
    242243                  !! CaCO3:      Ridgwell et al. (2007) submodel, version 1 
     
    248249                     fq1 = 0. 
    249250                  endif 
    250                   fcaco3(ji,jj) = xridg_r0 * fq1 
     251                  fcaco3 = xridg_r0 * fq1 
    251252               elseif (jrratio.eq.2) then 
    252253                  !! CaCO3:      Ridgwell et al. (2007) submodel, version 2 
     
    258259                     fq1 = 0. 
    259260                  endif 
    260                   fcaco3(ji,jj) = xridg_r0 * fq1 
     261                  fcaco3 = xridg_r0 * fq1 
    261262               endif 
    262             ENDIF 
    263          ENDDO 
    264       ENDDO 
    265263# else 
    266       DO jj = 2,jpjm1 
    267          DO ji = 2,jpim1 
    268             if (tmask(ji,jj,jk) == 1) then 
    269264               !! CaCO3:      latitudinally-based fraction of total primary 
    270265               !!              production 
    271266               !!               0.10 at equator; 0.02 at pole 
    272                fcaco3(ji,jj) = xcaco3a + ((xcaco3b - xcaco3a) *              & 
    273                                           ((90.0 - abs(gphit(ji,jj))) / 90.0)) 
    274             ENDIF 
    275          ENDDO 
    276       ENDDO 
     267               fcaco3 = xcaco3a + ((xcaco3b - xcaco3a) *                      & 
     268                                   ((90.0 - abs(gphit(ji,jj))) / 90.0)) 
    277269# endif 
    278  
    279       DO jj = 2,jpjm1 
    280          DO ji = 2,jpim1 
    281             if (tmask(ji,jj,jk) == 1) then 
    282270               !! AXY (09/03/09): convert CaCO3 production from function of  
    283271               !! primary production into a function of fast-sinking material;  
     
    286274               !! chlorophyll to an export flux for which they apply conversion  
    287275               !! factors to estimate the various elemental fractions (Si, Ca) 
    288                ftempca(ji,jj) = ftempc(ji,jj) * fcaco3(ji,jj) 
     276               ftempca(ji,jj) = ftempc(ji,jj) * fcaco3 
    289277 
    290278# if defined key_debug_medusa 
     
    316304                  IF (lwp) write (numout,*) 'flat(',jk,')    = ',             & 
    317305                                            abs(gphit(ji,jj)) 
    318                   IF (lwp) write (numout,*) 'fcaco3(',jk,')  = ', fcaco3(ji,jj) 
     306                  IF (lwp) write (numout,*) 'fcaco3(',jk,')  = ', fcaco3 
    319307               endif 
    320308# endif 
     
    428416                        if (fq4.lt.fq1) then 
    429417                           !! protected fraction of total organic C (non-dim) 
    430                            fprotf(ji,jj)   = (fq4 / (fq1 + tiny(fq1))) 
     418                           fprotf   = (fq4 / (fq1 + tiny(fq1))) 
    431419                        else 
    432420                           !! all organic C is protected (non-dim) 
    433                            fprotf(ji,jj)   = 1.0 
     421                           fprotf   = 1.0 
    434422                        endif 
    435423                        !! unprotected fraction of total organic C (non-dim) 
    436                         fq5      = (1.0 - fprotf(ji,jj)) 
     424                        fq5      = (1.0 - fprotf) 
    437425                        !! how much organic C is unprotected (mol) 
    438426                        fq6      = (fq0 * fq5) 
     
    440428                        fq7      = (fq6 * exp(-(fse3t(ji,jj,jk) / xfastc))) 
    441429                        !! how much total C leaves this box (mol) 
    442                         fq8      = (fq7 + (fq0 * fprotf(ji,jj))) 
     430                        fq8      = (fq7 + (fq0 * fprotf)) 
    443431                        !! C remineralisation in this box (mol) 
    444432                        freminc(ji,jj)  = (fq0 - fq8) / fse3t(ji,jj,jk) 
     
    454442                                       fq4 
    455443                              IF (lwp) write (numout,*) 'fprotf(',jk,')  = ', & 
    456                                        fprotf(ji,jj) 
     444                                       fprotf 
    457445                              IF (lwp) write (numout,*)                       & 
    458446                                       '------------------------------' 
     
    480468                     if (iball.eq.1) then 
    481469                        !! unprotected fraction of total organic N (non-dim) 
    482                         fq5      = (1.0 - fprotf(ji,jj)) 
     470                        fq5      = (1.0 - fprotf) 
    483471                        !! how much organic N is unprotected (mol) 
    484472                        fq6      = (fq0 * fq5) 
     
    486474                        fq7      = (fq6 * exp(-(fse3t(ji,jj,jk) / xfastc))) 
    487475                        !! how much total N leaves this box (mol) 
    488                         fq8      = (fq7 + (fq0 * fprotf(ji,jj))) 
     476                        fq8      = (fq7 + (fq0 * fprotf)) 
    489477                        !! N remineralisation in this box (mol) 
    490478                        freminn(ji,jj)  = (fq0 - fq8) / fse3t(ji,jj,jk) 
     
    498486                           IF (lwp) write (numout,*) 'prtctN(',jk,')  = ', fq4 
    499487                           IF (lwp) write (numout,*) 'fprotf(',jk,')  = ',    & 
    500                                     fprotf(ji,jj) 
     488                                    fprotf 
    501489                           IF (lwp) write (numout,*)                          & 
    502490                                    '------------------------------' 
     
    525513                     if (iball.eq.1) then 
    526514                        !! unprotected fraction of total organic Fe (non-dim) 
    527                         fq5      = (1.0 - fprotf(ji,jj)) 
     515                        fq5      = (1.0 - fprotf) 
    528516                        !! how much organic Fe is unprotected (mol) 
    529517                        fq6      = (fq0 * fq5) 
     
    531519                        fq7      = (fq6 * exp(-(fse3t(ji,jj,jk) / xfastc))) 
    532520                        !! how much total Fe leaves this box (mol) 
    533                         fq8      = (fq7 + (fq0 * fprotf(ji,jj))) 
     521                        fq8      = (fq7 + (fq0 * fprotf)) 
    534522                        !! Fe remineralisation in this box (mol) 
    535523                        freminfe(ji,jj) = (fq0 - fq8) / fse3t(ji,jj,jk) 
  • branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA/phytoplankton.F90

    r7975 r8039  
    3131      !! growth. 
    3232      !!---------------------------------------------------------------------- 
    33       USE bio_medusa_mod,    ONLY: fald, faln, fchd, fchd1, fchn, fchn1, & 
    34                                    fdep1, ffld, ffln2, fjld, fjln,       & 
    35                                    fjlim_pd, fjlim_pn, fjln,             & 
    36                                    fnld, fnln, fnsi,                     & 
    37                                    fpdlim, fpnlim, fprd, fprd_ml, fprds, & 
     33      USE bio_medusa_mod,    ONLY: fdep1, ffld, ffln2,                   & 
     34                                   fjlim_pd, fjlim_pn,                   & 
     35                                   fnld, fnln,                           & 
     36                                   fprd, fprd_ml, fprds,                 & 
    3837                                   fprn, fprn_ml, frd, frn,              & 
    3938                                   fsin, fsld, fsld2, fthetad, fthetan,  &  
     
    4140                                   ftot_pn, ftot_zme, ftot_zmi,          & 
    4241                                   fun_Q10, fun_T, idf, idfval,          & 
    43                                    xvpdT, xvpnT,                         & 
    4442                                   zchd, zchn, zdet, zdin, zdtc,         & 
    4543                                   zfer, zpds, zphd, zphn, zsil,         & 
     
    4947      USE oce,               ONLY: tsn 
    5048      USE par_kind,          ONLY: wp 
    51       USE par_oce,           ONLY: jp_tem, jpim1, jpjm1 
     49      USE par_oce,           ONLY: jp_tem, jpi, jpim1, jpj, jpjm1 
    5250      USE phycst,            ONLY: rsmall 
    5351      USE sms_medusa,        ONLY: jliebig, jphy, jq10,                  & 
     
    6664      INTEGER :: ji, jj 
    6765 
    68       REAL(wp)                     ::    fsin1,fnsi1,fnsi2 
    69       REAL(wp) ::    fq0 
     66      REAL(wp), DIMENSION(jpi,jpj) :: faln, fchn, fjln 
     67      REAL(wp), DIMENSION(jpi,jpj) :: fald, fchd, fjld 
     68      REAL(wp)                     :: fchn1, fchd1 
     69      !! AXY (03/02/11): add in Liebig terms 
     70      REAL(wp)                     :: fpnlim, fpdlim 
     71      !! AXY (16/07/09): add in Eppley curve functionality 
     72      REAL(wp)                     :: xvpnT,xvpdT 
     73      !! silicon cycle 
     74      REAL(wp)                     :: fnsi 
     75 
     76      REAL(wp)                     :: fsin1, fnsi1, fnsi2 
     77      REAL(wp)                     :: fq0 
    7078 
    7179      DO jj = 2,jpjm1 
     
    137145               fun_Q10(ji,jj) = jq10**((tsn(ji,jj,jk,jp_tem) - 0.0) / 10.0) 
    138146               if (jphy.eq.1) then 
    139                   xvpnT(ji,jj) = xvpn * fun_T(ji,jj) 
    140                   xvpdT(ji,jj) = xvpd * fun_T(ji,jj) 
     147                  xvpnT = xvpn * fun_T(ji,jj) 
     148                  xvpdT = xvpd * fun_T(ji,jj) 
    141149               elseif (jphy.eq.2) then 
    142                   xvpnT(ji,jj) = xvpn * fun_Q10(ji,jj) 
    143                   xvpdT(ji,jj) = xvpd * fun_Q10(ji,jj) 
    144                else 
    145                   xvpnT(ji,jj) = xvpn 
    146                   xvpdT(ji,jj) = xvpd 
    147                endif 
    148             ENDIF 
    149          ENDDO 
    150       ENDDO 
    151  
    152       DO jj = 2,jpjm1 
    153          DO ji = 2,jpim1 
    154             if (tmask(ji,jj,1) == 1) then            
     150                  xvpnT = xvpn * fun_Q10(ji,jj) 
     151                  xvpdT = xvpd * fun_Q10(ji,jj) 
     152               else 
     153                  xvpnT = xvpn 
     154                  xvpdT = xvpd 
     155               endif 
    155156               !! 
    156157               !! non-diatoms 
    157                fchn1(ji,jj)   = (xvpnT(ji,jj) * xvpnT(ji,jj)) +              & 
    158                                  (faln(ji,jj) * faln(ji,jj) *                & 
    159                                   xpar(ji,jj,jk) * xpar(ji,jj,jk)) 
    160                if (fchn1(ji,jj).GT.rsmall) then 
    161                   fchn(ji,jj)    = xvpnT(ji,jj) / (sqrt(fchn1(ji,jj)) +      & 
    162                                                    tiny(fchn1(ji,jj))) 
    163                else 
    164                   fchn(ji,jj)    = 0. 
     158               fchn1 = (xvpnT * xvpnT) +                                     & 
     159                       (faln(ji,jj) * faln(ji,jj) * xpar(ji,jj,jk) *         & 
     160                        xpar(ji,jj,jk)) 
     161               if (fchn1.GT.rsmall) then 
     162                  fchn(ji,jj) = xvpnT / (sqrt(fchn1) + tiny(fchn1)) 
     163               else 
     164                  fchn(ji,jj) = 0. 
    165165               endif 
    166166               !! non-diatom J term 
    167167               fjln(ji,jj)     = fchn(ji,jj) * faln(ji,jj) * xpar(ji,jj,jk) 
    168                fjlim_pn(ji,jj) = fjln(ji,jj) / xvpnT(ji,jj) 
    169             ENDIF 
    170          ENDDO 
    171       ENDDO 
    172  
    173       DO jj = 2,jpjm1 
    174          DO ji = 2,jpim1 
    175             if (tmask(ji,jj,1) == 1) then 
     168               fjlim_pn(ji,jj) = fjln(ji,jj) / xvpnT 
    176169               !! 
    177170               !! diatoms 
    178                fchd1(ji,jj)   = (xvpdT(ji,jj) * xvpdT(ji,jj)) +              & 
    179                                 (fald(ji,jj) * fald(ji,jj) *                 & 
    180                                  xpar(ji,jj,jk) * xpar(ji,jj,jk)) 
    181                if (fchd1(ji,jj).GT.rsmall) then 
    182                   fchd(ji,jj)    = xvpdT(ji,jj) / (sqrt(fchd1(ji,jj)) +      & 
    183                                                    tiny(fchd1(ji,jj))) 
    184                else 
    185                   fchd(ji,jj)    = 0. 
     171               fchd1 = (xvpdT * xvpdT) +                                     & 
     172                       (fald(ji,jj) * fald(ji,jj) * xpar(ji,jj,jk) *         & 
     173                        xpar(ji,jj,jk)) 
     174               if (fchd1.GT.rsmall) then 
     175                  fchd(ji,jj) = xvpdT / (sqrt(fchd1) + tiny(fchd1)) 
     176               else 
     177                  fchd(ji,jj) = 0. 
    186178               endif 
    187179               !! diatom J term 
    188180               fjld(ji,jj)    = fchd(ji,jj) * fald(ji,jj) * xpar(ji,jj,jk) 
    189                fjlim_pd(ji,jj) = fjld(ji,jj) / xvpdT(ji,jj) 
     181               fjlim_pd(ji,jj) = fjld(ji,jj) / xvpdT 
    190182       
    191183# if defined key_debug_medusa 
     
    250242               if (jliebig .eq. 0) then 
    251243                  !! multiplicative nutrient limitation 
    252                   fpnlim(ji,jj) = fnln(ji,jj) * ffln2(ji,jj) 
     244                  fpnlim = fnln(ji,jj) * ffln2(ji,jj) 
    253245               elseif (jliebig .eq. 1) then 
    254246                  !! Liebig Law (= most limiting) nutrient limitation 
    255                   fpnlim(ji,jj) = min(fnln(ji,jj), ffln2(ji,jj)) 
    256                endif 
    257                fprn(ji,jj) = fjln(ji,jj) * fpnlim(ji,jj) 
     247                  fpnlim = min(fnln(ji,jj), ffln2(ji,jj)) 
     248               endif 
     249               fprn(ji,jj) = fjln(ji,jj) * fpnlim 
    258250            ENDIF 
    259251         ENDDO 
     
    277269               if (jliebig .eq. 0) then 
    278270                  !! multiplicative nutrient limitation 
    279                   fpdlim(ji,jj) = fnld(ji,jj) * ffld(ji,jj) 
     271                  fpdlim = fnld(ji,jj) * ffld(ji,jj) 
    280272               elseif (jliebig .eq. 1) then 
    281273                  !! Liebig Law (= most limiting) nutrient limitation 
    282                   fpdlim(ji,jj) = min(fnld(ji,jj), ffld(ji,jj)) 
     274                  fpdlim = min(fnld(ji,jj), ffld(ji,jj)) 
    283275               endif 
    284276               !! 
     
    287279                  ! fsin(ji,jj)  = zpds(ji,jj) / (zphd(ji,jj) +              & 
    288280                  !                               tiny(zphd(ji,jj))) 
    289                   ! fnsi(ji,jj)  = zphd(ji,jj) / (zpds(ji,jj) +              & 
     281                  ! fnsi         = zphd(ji,jj) / (zpds(ji,jj) +              & 
    290282                  !                               tiny(zpds(ji,jj))) 
    291283                  fsin(ji,jj) = 0.0 
    292284                  IF( zphd(ji,jj) .GT. rsmall) fsin(ji,jj)  = zpds(ji,jj) /  & 
    293285                                                              zphd(ji,jj) 
    294                   fnsi(ji,jj) = 0.0 
    295                   IF( zpds(ji,jj) .GT. rsmall) fnsi(ji,jj)  = zphd(ji,jj) /  & 
    296                                                               zpds(ji,jj) 
     286                  fnsi = 0.0 
     287                  IF( zpds(ji,jj) .GT. rsmall) fnsi  = zphd(ji,jj) /         & 
     288                                                       zpds(ji,jj) 
    297289                  !! AXY (23/02/10): these next variables derive from  
    298290                  !! Mongin et al. (2003) 
     
    310302                                            (fsin(ji,jj) +                   & 
    311303                                             tiny(fsin(ji,jj)))) *           & 
    312                                     (fjld(ji,jj) * fpdlim(ji,jj)) 
     304                                    (fjld(ji,jj) * fpdlim) 
    313305                     fsld2(ji,jj) = xuif * ((fsin(ji,jj) - xsin0) /          & 
    314306                                            (fsin(ji,jj) +                   & 
    315307                                             tiny(fsin(ji,jj)))) 
    316308                  elseif (fsin(ji,jj).ge.fsin1) then 
    317                      fprd(ji,jj)  = (fjld(ji,jj) * fpdlim(ji,jj)) 
     309                     fprd(ji,jj)  = (fjld(ji,jj) * fpdlim) 
    318310                     fsld2(ji,jj) = 1.0 
    319311                  endif 
     
    323315                     fprds(ji,jj) = (fjld(ji,jj) * fsld(ji,jj)) 
    324316                  elseif (fsin(ji,jj).lt.fnsi2) then 
    325                      fprds(ji,jj) = xuif * ((fnsi(ji,jj) - xnsi0) /          & 
    326                                             (fnsi(ji,jj) +                   & 
    327                                              tiny(fnsi(ji,jj)))) *           & 
     317                     fprds(ji,jj) = xuif * ((fnsi - xnsi0) /          & 
     318                                            (fnsi + tiny(fnsi))) *           & 
    328319                                    (fjld(ji,jj) * fsld(ji,jj)) 
    329320                  else 
     
    332323               else 
    333324                  fsin(ji,jj)  = 0.0 
    334                   fnsi(ji,jj)  = 0.0 
     325                  fnsi         = 0.0 
    335326                  fprd(ji,jj)  = 0.0 
    336327                  fsld2(ji,jj) = 0.0 
     
    344335                  IF (lwp) write (numout,*) '------------------------------' 
    345336                  IF (lwp) write (numout,*) 'fsin(',jk,')   = ', fsin(ji,jj) 
    346                   IF (lwp) write (numout,*) 'fnsi(',jk,')   = ', fnsi(ji,jj) 
     337                  IF (lwp) write (numout,*) 'fnsi(',jk,')   = ', fnsi 
    347338                  IF (lwp) write (numout,*) 'fsld2(',jk,')  = ', fsld2(ji,jj) 
    348339                  IF (lwp) write (numout,*) 'fprn(',jk,')   = ', fprn(ji,jj) 
  • branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA/zooplankton.F90

    r7975 r8039  
    3535                                   fgmid, fgmidc, fgmipn,                & 
    3636                                   ficme, ficmi, finme, finmi,           & 
    37                                    fme, fme1, fmeexcr, fmegrow,          & 
    38                                    fmeresp, fmeth,                       & 
    39                                    fmi, fmi1, fmiexcr, fmigrow,          & 
    40                                    fmiresp, fmith,                       &  
    41                                    fsin, fstarme, fstarmi,               & 
     37                                   fmeexcr, fmegrow, fmeresp,            & 
     38                                   fmiexcr, fmigrow, fmiresp,            &  
     39                                   fsin,                                 & 
    4240                                   fzme_i, fzme_o, fzmi_i, fzmi_o,       & 
    4341                                   idf, idfval,                          & 
    4442                                   zdet, zdtc, zphd, zphn, zzme, zzmi 
    4543      USE dom_oce,           ONLY: e3t_0, e3t_n, tmask 
     44      USE par_kind,          ONLY: wp 
    4645      USE par_oce,           ONLY: jpim1, jpjm1 
    4746      USE phycst,            ONLY: rsmall 
     
    6160      INTEGER :: ji, jj 
    6261 
     62      !! Microzooplankton grazing 
     63      REAL(wp) :: fmi1, fmi 
     64      REAL(wp) :: fstarmi, fmith 
     65      !! 
     66      !! Mesozooplankton grazing 
     67      REAL(wp) :: fme1, fme 
     68      REAL(wp) :: fstarme, fmeth 
     69 
    6370      DO jj = 2,jpjm1 
    6471         DO ji = 2,jpim1 
     
    8289               !!---------------------------------------------------------- 
    8390               !! 
    84                fmi1(ji,jj)    = (xkmi * xkmi) + (xpmipn * zphn(ji,jj) *      & 
     91               fmi1           = (xkmi * xkmi) + (xpmipn * zphn(ji,jj) *      & 
    8592                                                 zphn(ji,jj)) +              & 
    8693                                (xpmid * zdet(ji,jj) * zdet(ji,jj)) 
    87                fmi(ji,jj)     = xgmi * zzmi(ji,jj) / fmi1(ji,jj) 
     94               fmi            = xgmi * zzmi(ji,jj) / fmi1 
    8895               !! grazing on non-diatoms 
    89                fgmipn(ji,jj)  = fmi(ji,jj) * xpmipn * zphn(ji,jj) *          & 
    90                                 zphn(ji,jj) 
     96               fgmipn(ji,jj)  = fmi * xpmipn * zphn(ji,jj) * zphn(ji,jj) 
    9197               !! grazing on detrital nitrogen 
    92                fgmid(ji,jj)   = fmi(ji,jj) * xpmid  * zdet(ji,jj) *          & 
    93                                 zdet(ji,jj) 
     98               fgmid(ji,jj)   = fmi * xpmid  * zdet(ji,jj) * zdet(ji,jj) 
    9499# if defined key_roam    
    95100               ! acc             
     
    104109               fgmidc(ji,jj)  = xthetad * fgmid(ji,jj) 
    105110# endif 
     111# if defined key_debug_medusa 
     112               !! report microzooplankton grazing 
     113               if (idf.eq.1.AND.idfval.eq.1) then 
     114                  IF (lwp) write (numout,*) '------------------------------' 
     115                  IF (lwp) write (numout,*) 'fmi1(',jk,')    = ', fmi1 
     116               endif 
     117# endif 
    106118            ENDIF 
    107119         ENDDO 
     
    119131               !! the ideal food C:N ratio for microzooplankton 
    120132               !! xbetan = 0.77; xthetaz = 5.625; xbetac = 0.64; xkc = 0.80 
    121                fstarmi(ji,jj) = (xbetan * xthetazmi) / (xbetac * xkc) 
     133               fstarmi = (xbetan * xthetazmi) / (xbetac * xkc) 
    122134               !! 
    123135               !! process these to determine proportioning of grazed N and C 
    124136               !! (since there is no explicit consideration of respiration, 
    125137               !! only growth and excretion are calculated here) 
    126                fmith(ji,jj)   = (ficmi(ji,jj) / (finmi(ji,jj) +              & 
    127                                  tiny(finmi(ji,jj)))) 
    128                if (fmith(ji,jj).ge.fstarmi(ji,jj)) then 
     138               fmith = (ficmi(ji,jj) / (finmi(ji,jj) + tiny(finmi(ji,jj)))) 
     139               if (fmith.ge.fstarmi) then 
    129140                  fmigrow(ji,jj) = xbetan * finmi(ji,jj) 
    130141                  fmiexcr(ji,jj) = 0.0 
     
    132143                  fmigrow(ji,jj) = (xbetac * xkc * ficmi(ji,jj)) / xthetazmi 
    133144                  fmiexcr(ji,jj) = ficmi(ji,jj) *                            & 
    134                                    ((xbetan / (fmith(ji,jj) +                & 
    135                                                tiny(fmith(ji,jj)))) -        & 
     145                                   ((xbetan / (fmith + tiny(fmith))) -       & 
    136146                                    ((xbetac * xkc) / xthetazmi)) 
    137147               endif 
     
    145155               if (idf.eq.1.AND.idfval.eq.1) then 
    146156                  IF (lwp) write (numout,*) '------------------------------' 
    147                   IF (lwp) write (numout,*) 'fmi1(',jk,')    = ', fmi1(ji,jj) 
    148                   IF (lwp) write (numout,*) 'fmi(',jk,')     = ', fmi(ji,jj) 
    149157                  IF (lwp) write (numout,*) 'fgmipn(',jk,')  = ', fgmipn(ji,jj) 
    150158                  IF (lwp) write (numout,*) 'fgmid(',jk,')   = ', fgmid(ji,jj) 
     
    152160                  IF (lwp) write (numout,*) 'finmi(',jk,')   = ', finmi(ji,jj) 
    153161                  IF (lwp) write (numout,*) 'ficmi(',jk,')   = ', ficmi(ji,jj) 
    154                   IF (lwp) write (numout,*) 'fstarmi(',jk,') = ', fstarmi(ji,jj) 
    155                   IF (lwp) write (numout,*) 'fmith(',jk,')   = ', fmith(ji,jj) 
     162                  IF (lwp) write (numout,*) 'fstarmi(',jk,') = ', fstarmi 
     163                  IF (lwp) write (numout,*) 'fmith(',jk,')   = ', fmith 
    156164                  IF (lwp) write (numout,*) 'fmigrow(',jk,') = ', fmigrow(ji,jj) 
    157165                  IF (lwp) write (numout,*) 'fmiexcr(',jk,') = ', fmiexcr(ji,jj) 
     
    172180               !!---------------------------------------------------------- 
    173181               !! 
    174                fme1(ji,jj)    = (xkme * xkme) + (xpmepn * zphn(ji,jj) *       & 
     182               fme1           = (xkme * xkme) + (xpmepn * zphn(ji,jj) *       & 
    175183                                                 zphn(ji,jj)) +               & 
    176184                                (xpmepd * zphd(ji,jj) * zphd(ji,jj)) +        &  
    177185                                (xpmezmi * zzmi(ji,jj) * zzmi(ji,jj)) +       & 
    178186                                (xpmed * zdet(ji,jj) * zdet(ji,jj)) 
    179                fme(ji,jj)     = xgme * zzme(ji,jj) / fme1(ji,jj) 
     187               fme            = xgme * zzme(ji,jj) / fme1 
    180188               !! grazing on non-diatoms 
    181                fgmepn(ji,jj)  = fme(ji,jj) * xpmepn  * zphn(ji,jj) *          & 
    182                                 zphn(ji,jj) 
     189               fgmepn(ji,jj)  = fme * xpmepn  * zphn(ji,jj) * zphn(ji,jj) 
    183190               !! grazing on diatoms 
    184                fgmepd(ji,jj)  = fme(ji,jj) * xpmepd  * zphd(ji,jj) *          & 
    185                                 zphd(ji,jj) 
     191               fgmepd(ji,jj)  = fme * xpmepd  * zphd(ji,jj) * zphd(ji,jj) 
    186192               !! grazing on diatom silicon 
    187193               fgmepds(ji,jj) = fsin(ji,jj) * fgmepd(ji,jj) 
    188194               !! grazing on microzooplankton 
    189                fgmezmi(ji,jj) = fme(ji,jj) * xpmezmi * zzmi(ji,jj) *          & 
    190                                 zzmi(ji,jj) 
     195               fgmezmi(ji,jj) = fme * xpmezmi * zzmi(ji,jj) * zzmi(ji,jj) 
    191196               !! grazing on detrital nitrogen 
    192                fgmed(ji,jj)   = fme(ji,jj) * xpmed   * zdet(ji,jj) *          & 
    193                                 zdet(ji,jj) 
     197               fgmed(ji,jj)   = fme * xpmed   * zdet(ji,jj) * zdet(ji,jj) 
    194198# if defined key_roam 
    195199               !! acc 
     
    212216                                (xthetapd * fgmepd(ji,jj)) +                 & 
    213217                                (xthetazmi * fgmezmi(ji,jj)) + fgmedc(ji,jj)) 
     218# if defined key_debug_medusa 
     219               !! report mesozooplankton grazing 
     220               if (idf.eq.1.AND.idfval.eq.1) then 
     221                  IF (lwp) write (numout,*) '------------------------------' 
     222                  IF (lwp) write (numout,*) 'fme1(',jk,')    = ', fme1 
     223                  IF (lwp) write (numout,*) 'fme(',jk,')     = ', fme 
     224               endif 
     225# endif 
    214226            ENDIF 
    215227         ENDDO 
     
    222234               !! the ideal food C:N ratio for mesozooplankton 
    223235               !! xbetan = 0.77; xthetaz = 5.625; xbetac = 0.64; xkc = 0.80 
    224                fstarme(ji,jj) = (xbetan * xthetazme) / (xbetac * xkc) 
     236               fstarme        = (xbetan * xthetazme) / (xbetac * xkc) 
    225237               !! 
    226238               !! process these to determine proportioning of grazed N and C 
    227239               !! (since there is no explicit consideration of respiration, 
    228240               !! only growth and excretion are calculated here) 
    229                fmeth(ji,jj)   = (ficme(ji,jj) / (finme(ji,jj) +              & 
    230                                                  tiny(finme(ji,jj)))) 
    231                if (fmeth(ji,jj).ge.fstarme(ji,jj)) then 
     241               fmeth   = (ficme(ji,jj) / (finme(ji,jj) + tiny(finme(ji,jj)))) 
     242               if (fmeth.ge.fstarme) then 
    232243                  fmegrow(ji,jj) = xbetan * finme(ji,jj) 
    233244                  fmeexcr(ji,jj) = 0.0 
     
    235246                  fmegrow(ji,jj) = (xbetac * xkc * ficme(ji,jj)) / xthetazme 
    236247                  fmeexcr(ji,jj) = ficme(ji,jj) *                            & 
    237                                    ((xbetan / (fmeth(ji,jj) +                & 
    238                                                tiny(fmeth(ji,jj)))) -        & 
     248                                   ((xbetan / (fmeth + tiny(fmeth))) -       & 
    239249                                    ((xbetac * xkc) / xthetazme)) 
    240250               endif 
     
    248258               if (idf.eq.1.AND.idfval.eq.1) then 
    249259                  IF (lwp) write (numout,*) '------------------------------' 
    250                   IF (lwp) write (numout,*) 'fme1(',jk,')    = ', fme1(ji,jj) 
    251                   IF (lwp) write (numout,*) 'fme(',jk,')     = ', fme(ji,jj) 
    252260                  IF (lwp) write (numout,*) 'fgmepn(',jk,')  = ', fgmepn(ji,jj) 
    253261                  IF (lwp) write (numout,*) 'fgmepd(',jk,')  = ', fgmepd(ji,jj) 
     
    258266                  IF (lwp) write (numout,*) 'finme(',jk,')   = ', finme(ji,jj) 
    259267                  IF (lwp) write (numout,*) 'ficme(',jk,')   = ', ficme(ji,jj) 
    260                   IF (lwp) write (numout,*) 'fstarme(',jk,') = ', fstarme(ji,jj) 
    261                   IF (lwp) write (numout,*) 'fmeth(',jk,')   = ', fmeth(ji,jj) 
     268                  IF (lwp) write (numout,*) 'fstarme(',jk,') = ', fstarme 
     269                  IF (lwp) write (numout,*) 'fmeth(',jk,')   = ', fmeth 
    262270                  IF (lwp) write (numout,*) 'fmegrow(',jk,') = ', fmegrow(ji,jj) 
    263271                  IF (lwp) write (numout,*) 'fmeexcr(',jk,') = ', fmeexcr(ji,jj) 
Note: See TracChangeset for help on using the changeset viewer.