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 for branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA/zooplankton.F90 – NEMO

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

File:
1 edited

Legend:

Unmodified
Added
Removed
  • 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.