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 13097 – NEMO

Changeset 13097


Ignore:
Timestamp:
2020-06-11T19:32:37+02:00 (4 years ago)
Author:
dford
Message:

Allow nitrogen balancing for both 2D and 3D chlorophyll increments.

Location:
branches/UKMO/dev_r5518_GO6_package_FOAMv14_phytobal3d/NEMOGCM/NEMO
Files:
5 edited
2 moved

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14_phytobal3d/NEMOGCM/NEMO/OPA_SRC/ASM/asmbgc.F90

    r10302 r13097  
    1818   !! asm_bgc_bal_wri       : write out bgc balancing increments 
    1919   !! asm_bgc_bkg_wri       : write out bgc background 
    20    !! phyto2d_asm_inc       : apply the ocean colour increments 
     20   !! asm_bgc_unlog_2d      : calculate non-log versions of 2D log increments 
     21   !! asm_bgc_unlog_3d      : calculate non-log versions of 3D log increments 
     22   !! phyto2d_asm_inc       : apply the 2D phytoplankton increments 
    2123   !! phyto3d_asm_inc       : apply the 3D phytoplankton increments 
    2224   !! pco2_asm_inc          : apply the pCO2/fCO2 increments 
     
    5658#endif 
    5759#if defined key_medusa 
    58    USE asmphyto2dbal_medusa, ONLY: & ! phyto2d balancing for MEDUSA 
    59       & asm_phyto2d_bal_medusa 
     60   USE asmphytobal_medusa, ONLY: & ! phytoplankton balancing for MEDUSA 
     61      & asm_phyto_bal_medusa 
    6062   USE asmpco2bal, ONLY:    & ! pCO2 balancing for MEDUSA 
    6163      & asm_pco2_bal 
     
    7072      & ploss_avg,          & 
    7173      & phyt_avg,           & 
     74      & pgrow_avg_3d,       & 
     75      & ploss_avg_3d,       & 
     76      & phyt_avg_3d,        & 
    7277      & mld_max 
    7378#elif defined key_hadocc 
    74    USE asmphyto2dbal_hadocc, ONLY: & ! phyto2d balancing for HadOCC 
    75       & asm_phyto2d_bal_hadocc 
     79   USE asmphytobal_hadocc, ONLY: & ! phytoplankton balancing for HadOCC 
     80      & asm_phyto_bal_hadocc 
    7681   USE asmpco2bal, ONLY:    & ! pCO2 balancing for HadOCC 
    7782      & asm_pco2_bal 
     
    8287      & ploss_avg,          & 
    8388      & phyt_avg,           & 
     89      & pgrow_avg_3d,       & 
     90      & ploss_avg_3d,       & 
     91      & phyt_avg_3d,        & 
    8492      & mld_max,            & 
    8593      & HADOCC_CHL 
     
    98106   PUBLIC  asm_bgc_bal_wri        ! called by nemo_gcm in nemogcm.F90 
    99107   PUBLIC  asm_bgc_bkg_wri        ! called by asm_bkg_wri in asmbkg.F90 
     108   PRIVATE asm_bgc_unlog_2d       ! called by phyto2d_asm_inc 
     109   PRIVATE asm_bgc_unlog_3d       ! called by phyto3d_asm_inc 
    100110   PUBLIC  phyto2d_asm_inc        ! called by bgc_asm_inc in asminc.F90 
    101111   PUBLIC  phyto3d_asm_inc        ! called by bgc_asm_inc in asminc.F90 
     
    168178   REAL(wp), DIMENSION(:,:),     ALLOCATABLE :: ploss_avg_bkg   ! Background phyto loss 
    169179   REAL(wp), DIMENSION(:,:),     ALLOCATABLE :: phyt_avg_bkg    ! Background phyto conc 
     180   REAL(wp), DIMENSION(:,:,:),   ALLOCATABLE :: pgrow_avg_3d_bkg   ! Background phyto growth 
     181   REAL(wp), DIMENSION(:,:,:),   ALLOCATABLE :: ploss_avg_3d_bkg   ! Background phyto loss 
     182   REAL(wp), DIMENSION(:,:,:),   ALLOCATABLE :: phyt_avg_3d_bkg    ! Background phyto conc 
    170183   REAL(wp), DIMENSION(:,:),     ALLOCATABLE :: mld_max_bkg     ! Background max MLD 
    171184   REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tracer_bkg      ! Background tracer state 
     
    212225         & ( .NOT. ln_slchlnoninc ).AND.( .NOT. ln_schltotinc  ).AND. & 
    213226         & ( .NOT. ln_slphytotinc ).AND.( .NOT. ln_slphydiainc ).AND. & 
    214          & ( .NOT. ln_slphynoninc ) ) THEN 
     227         & ( .NOT. ln_slphynoninc ).AND.( .NOT. ln_plchltotinc ).AND. & 
     228         & ( .NOT. ln_pchltotinc  ) ) THEN 
    215229         CALL ctl_warn( ' Cannot calculate phytoplankton balancing increments', & 
    216             &           ' if not assimilating ocean colour,',                   & 
     230            &           ' if not assimilating phytoplankton,',                   & 
    217231            &           ' so ln_phytobal will be set to .false.') 
    218232         ln_phytobal = .FALSE. 
     
    524538         ALLOCATE( ploss_avg_bkg(jpi,jpj)        ) 
    525539         ALLOCATE( phyt_avg_bkg(jpi,jpj)         ) 
     540         ALLOCATE( pgrow_avg_3d_bkg(jpi,jpj,jpk) ) 
     541         ALLOCATE( ploss_avg_3d_bkg(jpi,jpj,jpk) ) 
     542         ALLOCATE( phyt_avg_3d_bkg(jpi,jpj,jpk)  ) 
    526543         ALLOCATE( mld_max_bkg(jpi,jpj)          ) 
    527544         ALLOCATE( tracer_bkg(jpi,jpj,jpk,jptra) ) 
     
    529546         ploss_avg_bkg(:,:)  = 0.0 
    530547         phyt_avg_bkg(:,:)   = 0.0 
     548         pgrow_avg_3d_bkg(:,:,:)  = 0.0 
     549         ploss_avg_3d_bkg(:,:,:)  = 0.0 
     550         phyt_avg_3d_bkg(:,:,:)   = 0.0 
    531551         mld_max_bkg(:,:)    = 0.0 
    532552         tracer_bkg(:,:,:,:) = 0.0 
     
    564584            CALL iom_get( inum, jpdom_autoglo, 'ploss_avg', ploss_avg_bkg ) 
    565585            CALL iom_get( inum, jpdom_autoglo, 'phyt_avg',  phyt_avg_bkg  ) 
     586            CALL iom_get( inum, jpdom_autoglo, 'pgrow_avg_3d', pgrow_avg_3d_bkg ) 
     587            CALL iom_get( inum, jpdom_autoglo, 'ploss_avg_3d', ploss_avg_3d_bkg ) 
     588            CALL iom_get( inum, jpdom_autoglo, 'phyt_avg_3d',  phyt_avg_3d_bkg  ) 
    566589            CALL iom_get( inum, jpdom_autoglo, 'mld_max',   mld_max_bkg   ) 
    567590            pgrow_avg_bkg(:,:) = pgrow_avg_bkg(:,:) * tmask(:,:,1) 
    568591            ploss_avg_bkg(:,:) = ploss_avg_bkg(:,:) * tmask(:,:,1) 
    569592            phyt_avg_bkg(:,:)  = phyt_avg_bkg(:,:)  * tmask(:,:,1) 
     593            pgrow_avg_3d_bkg(:,:,:) = pgrow_avg_3d_bkg(:,:,:) * tmask(:,:,:) 
     594            ploss_avg_3d_bkg(:,:,:) = ploss_avg_3d_bkg(:,:,:) * tmask(:,:,:) 
     595            phyt_avg_3d_bkg(:,:,:)  = phyt_avg_3d_bkg(:,:,:)  * tmask(:,:,:) 
    570596            mld_max_bkg(:,:)   = mld_max_bkg(:,:)   * tmask(:,:,1) 
    571597 
     
    726752            CALL iom_rstput( kt, kt, inum, 'phy3d_phd', phyto3d_balinc(:,:,:,jpphd) ) 
    727753            CALL iom_rstput( kt, kt, inum, 'phy3d_pds', phyto3d_balinc(:,:,:,jppds) ) 
     754            IF ( ln_phytobal ) THEN 
     755               CALL iom_rstput( kt, kt, inum, 'phy3d_zmi', phyto3d_balinc(:,:,:,jpzmi) ) 
     756               CALL iom_rstput( kt, kt, inum, 'phy3d_zme', phyto3d_balinc(:,:,:,jpzme) ) 
     757               CALL iom_rstput( kt, kt, inum, 'phy3d_din', phyto3d_balinc(:,:,:,jpdin) ) 
     758               CALL iom_rstput( kt, kt, inum, 'phy3d_sil', phyto3d_balinc(:,:,:,jpsil) ) 
     759               CALL iom_rstput( kt, kt, inum, 'phy3d_fer', phyto3d_balinc(:,:,:,jpfer) ) 
     760               CALL iom_rstput( kt, kt, inum, 'phy3d_det', phyto3d_balinc(:,:,:,jpdet) ) 
     761               CALL iom_rstput( kt, kt, inum, 'phy3d_dtc', phyto3d_balinc(:,:,:,jpdtc) ) 
     762               CALL iom_rstput( kt, kt, inum, 'phy3d_dic', phyto3d_balinc(:,:,:,jpdic) ) 
     763               CALL iom_rstput( kt, kt, inum, 'phy3d_alk', phyto3d_balinc(:,:,:,jpalk) ) 
     764               CALL iom_rstput( kt, kt, inum, 'phy3d_oxy', phyto3d_balinc(:,:,:,jpoxy) ) 
     765            ENDIF 
    728766#elif defined key_hadocc 
    729767            CALL iom_rstput( kt, kt, inum, 'phy3d_phy', phyto3d_balinc(:,:,:,jp_had_phy) ) 
     768            IF ( ln_phytobal ) THEN 
     769               CALL iom_rstput( kt, kt, inum, 'phy3d_nut', phyto3d_balinc(:,:,:,jp_had_nut) ) 
     770               CALL iom_rstput( kt, kt, inum, 'phy3d_zoo', phyto3d_balinc(:,:,:,jp_had_zoo) ) 
     771               CALL iom_rstput( kt, kt, inum, 'phy3d_det', phyto3d_balinc(:,:,:,jp_had_pdn) ) 
     772               CALL iom_rstput( kt, kt, inum, 'phy3d_dic', phyto3d_balinc(:,:,:,jp_had_dic) ) 
     773               CALL iom_rstput( kt, kt, inum, 'phy3d_alk', phyto3d_balinc(:,:,:,jp_had_alk) ) 
     774            ENDIF 
    730775#endif 
    731776         ENDIF 
     
    792837      !!------------------------------------------------------------------------ 
    793838 
    794 #if defined key_hadocc 
    795839      CALL iom_rstput( kt, nitbkg_r, knum, 'pgrow_avg'   , pgrow_avg             ) 
    796840      CALL iom_rstput( kt, nitbkg_r, knum, 'ploss_avg'   , ploss_avg             ) 
    797841      CALL iom_rstput( kt, nitbkg_r, knum, 'phyt_avg'    , phyt_avg              ) 
     842      CALL iom_rstput( kt, nitbkg_r, knum, 'pgrow_avg_3d', pgrow_avg_3d          ) 
     843      CALL iom_rstput( kt, nitbkg_r, knum, 'ploss_avg_3d', ploss_avg_3d          ) 
     844      CALL iom_rstput( kt, nitbkg_r, knum, 'phyt_avg_3d' , phyt_avg_3d           ) 
    798845      CALL iom_rstput( kt, nitbkg_r, knum, 'mld_max'     , mld_max               ) 
     846#if defined key_hadocc 
    799847      CALL iom_rstput( kt, nitbkg_r, knum, 'hadocc_nut'  , trn(:,:,:,jp_had_nut) ) 
    800848      CALL iom_rstput( kt, nitbkg_r, knum, 'hadocc_phy'  , trn(:,:,:,jp_had_phy) ) 
     
    806854      CALL iom_rstput( kt, nitbkg_r, knum, 'hadocc_cchl' , cchl_p(:,:,:)         ) 
    807855#elif defined key_medusa 
    808       CALL iom_rstput( kt, nitbkg_r, knum, 'pgrow_avg'   , pgrow_avg        ) 
    809       CALL iom_rstput( kt, nitbkg_r, knum, 'ploss_avg'   , ploss_avg        ) 
    810       CALL iom_rstput( kt, nitbkg_r, knum, 'phyt_avg'    , phyt_avg         ) 
    811       CALL iom_rstput( kt, nitbkg_r, knum, 'mld_max'     , mld_max          ) 
    812856      CALL iom_rstput( kt, nitbkg_r, knum, 'medusa_chn'  , trn(:,:,:,jpchn) ) 
    813857      CALL iom_rstput( kt, nitbkg_r, knum, 'medusa_chd'  , trn(:,:,:,jpchd) ) 
     
    876920   !!=========================================================================== 
    877921 
     922   SUBROUTINE asm_bgc_unlog_3d( pbkg, pinc_log, pinc_nonlog ) 
     923      !!------------------------------------------------------------------------ 
     924      !!                    ***  ROUTINE asm_bgc_init_incs  *** 
     925      !! 
     926      !! ** Purpose :   convert log increments to non-log 
     927      !! 
     928      !! ** Method  :   need to account for model background, 
     929      !!                cannot simply do 10^log_inc. Need to: 
     930      !!                1) Add log_inc to log10(background) to get log10(analysis) 
     931      !!                2) Take 10^log10(analysis) to get analysis 
     932      !!                3) Subtract background from analysis to get non-log incs 
     933      !! 
     934      !! ** Action  :   return non-log increments 
     935      !! 
     936      !! References :    
     937      !!------------------------------------------------------------------------ 
     938      !! 
     939      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpk) :: pbkg        ! Background 
     940      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpk) :: pinc_log    ! Log incs 
     941      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj,jpk) :: pinc_nonlog ! Non-log incs 
     942      ! 
     943      INTEGER                                         :: ji, jj, jk  ! Loop counters 
     944      !! 
     945      !!------------------------------------------------------------------------ 
     946 
     947      DO jk = 1, jpk 
     948         DO jj = 1, jpj 
     949            DO ji = 1, jpi 
     950               IF ( pbkg(ji,jj,jk) > 0.0 ) THEN 
     951                  pinc_nonlog(ji,jj,jk) = 10**( LOG10( pbkg(ji,jj,jk) ) + & 
     952                     &                          pinc_log(ji,jj,jk) )      & 
     953                     &                    - pbkg(ji,jj,jk) 
     954               ELSE 
     955                  pinc_nonlog(ji,jj,jk) = 0.0 
     956               ENDIF 
     957            END DO 
     958         END DO 
     959      END DO 
     960 
     961   END SUBROUTINE asm_bgc_unlog_3d 
     962 
     963   !!=========================================================================== 
     964   !!=========================================================================== 
     965   !!=========================================================================== 
     966 
    878967   SUBROUTINE phyto2d_asm_inc( kt, ll_asmdin, ll_asmiau, kcycper, pwgtiau ) 
    879968      !!------------------------------------------------------------------------ 
     
    894983      REAL(wp), DIMENSION(kcycper), INTENT(IN) :: pwgtiau   ! IAU weights 
    895984      ! 
    896       INTEGER                      :: jk          ! Loop counter 
    897       INTEGER                      :: it          ! Index 
    898       REAL(wp)                     :: zincwgt     ! IAU weight for current time step 
    899       REAL(wp)                     :: zincper     ! IAU interval in seconds 
    900       REAL(wp), DIMENSION(jpi,jpj) :: zmld        ! Mixed layer depth 
    901       REAL(wp), DIMENSION(jpi,jpj) :: zinc_chltot ! Local chltot incs 
    902       REAL(wp), DIMENSION(jpi,jpj) :: zbkg_chltot ! Local chltot bkg 
    903       REAL(wp), DIMENSION(jpi,jpj) :: zinc_phytot ! Local phytot incs 
    904       REAL(wp), DIMENSION(jpi,jpj) :: zbkg_phytot ! Local phytot bkg 
    905 #if defined key_medusa 
    906       REAL(wp), DIMENSION(jpi,jpj) :: zinc_chldia ! Local chldia incs 
    907       REAL(wp), DIMENSION(jpi,jpj) :: zbkg_chldia ! Local chldia bkg 
    908       REAL(wp), DIMENSION(jpi,jpj) :: zinc_chlnon ! Local chlnon incs 
    909       REAL(wp), DIMENSION(jpi,jpj) :: zbkg_chlnon ! Local chlnon bkg 
    910       REAL(wp), DIMENSION(jpi,jpj) :: zinc_phydia ! Local phydia incs 
    911       REAL(wp), DIMENSION(jpi,jpj) :: zbkg_phydia ! Local phydia bkg 
    912       REAL(wp), DIMENSION(jpi,jpj) :: zinc_phynon ! Local phynon incs 
    913       REAL(wp), DIMENSION(jpi,jpj) :: zbkg_phynon ! Local phynon bkg 
    914 #endif 
     985      INTEGER                        :: jk          ! Loop counter 
     986      INTEGER                        :: it          ! Index 
     987      REAL(wp)                       :: zincwgt     ! IAU weight for current time step 
     988      REAL(wp)                       :: zincper     ! IAU interval in seconds 
     989      REAL(wp), DIMENSION(jpi,jpj)   :: zmld        ! Mixed layer depth 
     990      REAL(wp), DIMENSION(jpi,jpj,1) :: zinc_chltot ! Local chltot incs 
     991      REAL(wp), DIMENSION(jpi,jpj)   :: zbkg_chltot ! Local chltot bkg 
     992      REAL(wp), DIMENSION(jpi,jpj,1) :: zinc_phytot ! Local phytot incs 
     993      REAL(wp), DIMENSION(jpi,jpj)   :: zbkg_phytot ! Local phytot bkg 
     994#if defined key_medusa 
     995      REAL(wp), DIMENSION(jpi,jpj,1) :: zinc_chldia ! Local chldia incs 
     996      REAL(wp), DIMENSION(jpi,jpj)   :: zbkg_chldia ! Local chldia bkg 
     997      REAL(wp), DIMENSION(jpi,jpj,1) :: zinc_chlnon ! Local chlnon incs 
     998      REAL(wp), DIMENSION(jpi,jpj)   :: zbkg_chlnon ! Local chlnon bkg 
     999      REAL(wp), DIMENSION(jpi,jpj,1) :: zinc_phydia ! Local phydia incs 
     1000      REAL(wp), DIMENSION(jpi,jpj)   :: zbkg_phydia ! Local phydia bkg 
     1001      REAL(wp), DIMENSION(jpi,jpj,1) :: zinc_phynon ! Local phynon incs 
     1002      REAL(wp), DIMENSION(jpi,jpj)   :: zbkg_phynon ! Local phynon bkg 
     1003#endif 
     1004      REAL(wp), DIMENSION(jpi,jpj,1) :: zpgrow_avg_bkg ! Local pgrow_avg_bkg 
     1005      REAL(wp), DIMENSION(jpi,jpj,1) :: zploss_avg_bkg ! Local ploss_avg_bkg 
     1006      REAL(wp), DIMENSION(jpi,jpj,1) :: zphyt_avg_bkg  ! Local phyt_avg_bkg 
    9151007      !!------------------------------------------------------------------------ 
    9161008       
     
    9281020            zbkg_chltot(:,:) = chl_bkg(:,:,1) 
    9291021#endif 
    930             CALL asm_bgc_unlog_2d( zbkg_chltot, slchltot_bkginc, zinc_chltot ) 
     1022            CALL asm_bgc_unlog_2d( zbkg_chltot, slchltot_bkginc, zinc_chltot(:,:,1) ) 
    9311023         ELSE IF ( ln_schltotinc ) THEN 
    932             zinc_chltot(:,:) = schltot_bkginc(:,:) 
     1024            zinc_chltot(:,:,1) = schltot_bkginc(:,:) 
    9331025         ELSE 
    934             zinc_chltot(:,:) = 0.0 
     1026            zinc_chltot(:,:,:) = 0.0 
    9351027         ENDIF 
    9361028 
     
    9391031         IF ( ln_slchldiainc ) THEN 
    9401032            zbkg_chldia(:,:) = tracer_bkg(:,:,1,jpchd) 
    941             CALL asm_bgc_unlog_2d( zbkg_chldia, slchldia_bkginc, zinc_chldia ) 
     1033            CALL asm_bgc_unlog_2d( zbkg_chldia, slchldia_bkginc, zinc_chldia(:,:,1) ) 
    9421034         ELSE 
    943             zinc_chldia(:,:) = 0.0 
     1035            zinc_chldia(:,:,:) = 0.0 
    9441036         ENDIF 
    9451037#endif 
     
    9491041         IF ( ln_slchlnoninc ) THEN 
    9501042            zbkg_chlnon(:,:) = tracer_bkg(:,:,1,jpchn) 
    951             CALL asm_bgc_unlog_2d( zbkg_chlnon, slchlnon_bkginc, zinc_chlnon ) 
     1043            CALL asm_bgc_unlog_2d( zbkg_chlnon, slchlnon_bkginc, zinc_chlnon(:,:,1) ) 
    9521044         ELSE 
    953             zinc_chlnon(:,:) = 0.0 
     1045            zinc_chlnon(:,:,:) = 0.0 
    9541046         ENDIF 
    9551047#endif 
     
    9621054            zbkg_phytot(:,:) = trn(:,:,1,jp_had_phy) * c2n_p 
    9631055#endif 
    964             CALL asm_bgc_unlog_2d( zbkg_phytot, slphytot_bkginc, zinc_phytot ) 
     1056            CALL asm_bgc_unlog_2d( zbkg_phytot, slphytot_bkginc, zinc_phytot(:,:,1) ) 
    9651057         ELSE 
    966             zinc_phytot(:,:) = 0.0 
     1058            zinc_phytot(:,:,:) = 0.0 
    9671059         ENDIF 
    9681060 
     
    9711063         IF ( ln_slphydiainc ) THEN 
    9721064            zbkg_phydia(:,:) = trn(:,:,1,jpphd) * xthetapd 
    973             CALL asm_bgc_unlog_2d( zbkg_phydia, slphydia_bkginc, zinc_phydia ) 
     1065            CALL asm_bgc_unlog_2d( zbkg_phydia, slphydia_bkginc, zinc_phydia(:,:,1) ) 
    9741066         ELSE 
    975             zinc_phydia(:,:) = 0.0 
     1067            zinc_phydia(:,:,:) = 0.0 
    9761068         ENDIF 
    9771069#endif 
     
    9811073         IF ( ln_slphynoninc ) THEN 
    9821074            zbkg_phynon(:,:) = trn(:,:,1,jpphn) * xthetapn 
    983             CALL asm_bgc_unlog_2d( zbkg_phynon, slphynon_bkginc, zinc_phynon ) 
     1075            CALL asm_bgc_unlog_2d( zbkg_phynon, slphynon_bkginc, zinc_phynon(:,:,1) ) 
    9841076         ELSE 
    985             zinc_phynon(:,:) = 0.0 
     1077            zinc_phynon(:,:,:) = 0.0 
    9861078         ENDIF 
    9871079#endif 
     
    10241116 
    10251117         zincper = (nitiaufin_r - nitiaustr_r + 1) * rdt 
    1026  
    1027 #if defined key_medusa 
    1028          CALL asm_phyto2d_bal_medusa( (ln_slchltotinc .OR. ln_schltotinc), & 
    1029             &                         zinc_chltot,                         & 
    1030             &                         ln_slchldiainc,                      & 
    1031             &                         zinc_chldia,                         & 
    1032             &                         ln_slchlnoninc,                      & 
    1033             &                         zinc_chlnon,                         & 
    1034             &                         ln_slphytotinc,                      & 
    1035             &                         zinc_phytot,                         & 
    1036             &                         ln_slphydiainc,                      & 
    1037             &                         zinc_phydia,                         & 
    1038             &                         ln_slphynoninc,                      & 
    1039             &                         zinc_phynon,                         & 
    1040             &                         zincper,                             & 
    1041             &                         rn_maxchlinc, ln_phytobal, zmld,     & 
    1042             &                         pgrow_avg_bkg, ploss_avg_bkg,        & 
    1043             &                         phyt_avg_bkg, mld_max_bkg,           & 
    1044             &                         tracer_bkg, phyto2d_balinc ) 
     1118          
     1119         zpgrow_avg_bkg(:,:,1) = pgrow_avg_bkg(:,:) 
     1120         zploss_avg_bkg(:,:,1) = ploss_avg_bkg(:,:) 
     1121         zphyt_avg_bkg(:,:,1)  = phyt_avg_bkg(:,:) 
     1122 
     1123#if defined key_medusa 
     1124         CALL asm_phyto_bal_medusa( 1,                                   & 
     1125            &                       (ln_slchltotinc .OR. ln_schltotinc), & 
     1126            &                       zinc_chltot,                         & 
     1127            &                       ln_slchldiainc,                      & 
     1128            &                       zinc_chldia,                         & 
     1129            &                       ln_slchlnoninc,                      & 
     1130            &                       zinc_chlnon,                         & 
     1131            &                       ln_slphytotinc,                      & 
     1132            &                       zinc_phytot,                         & 
     1133            &                       ln_slphydiainc,                      & 
     1134            &                       zinc_phydia,                         & 
     1135            &                       ln_slphynoninc,                      & 
     1136            &                       zinc_phynon,                         & 
     1137            &                       zincper,                             & 
     1138            &                       rn_maxchlinc, ln_phytobal, zmld,     & 
     1139            &                       zpgrow_avg_bkg, zploss_avg_bkg,      & 
     1140            &                       zphyt_avg_bkg, mld_max_bkg,          & 
     1141            &                       tracer_bkg, phyto2d_balinc ) 
    10451142#elif defined key_hadocc 
    1046          CALL asm_phyto2d_bal_hadocc( (ln_slchltotinc .OR. ln_schltotinc), & 
    1047             &                         zinc_chltot,                         & 
    1048             &                         ln_slphytotinc,                      & 
    1049             &                         zinc_phytot,                         & 
    1050             &                         zincper,                             & 
    1051             &                         rn_maxchlinc, ln_phytobal, zmld,     & 
    1052             &                         pgrow_avg_bkg, ploss_avg_bkg,        & 
    1053             &                         phyt_avg_bkg, mld_max_bkg,           & 
    1054             &                         cchl_p_bkg(:,:,1),                   & 
    1055             &                         tracer_bkg, phyto2d_balinc ) 
     1143         CALL asm_phyto_bal_hadocc( 1,                                   & 
     1144            &                       (ln_slchltotinc .OR. ln_schltotinc), & 
     1145            &                       zinc_chltot,                         & 
     1146            &                       ln_slphytotinc,                      & 
     1147            &                       zinc_phytot,                         & 
     1148            &                       zincper,                             & 
     1149            &                       rn_maxchlinc, ln_phytobal, zmld,     & 
     1150            &                       zpgrow_avg_bkg, zploss_avg_bkg,      & 
     1151            &                       zphyt_avg_bkg, mld_max_bkg,          & 
     1152            &                       cchl_p_bkg(:,:,1),                   & 
     1153            &                       tracer_bkg, phyto2d_balinc ) 
    10561154#else 
    10571155         CALL ctl_stop( 'Attempting to assimilate phyto2d data, ', & 
     
    11661264      INTEGER                          :: ji, jj, jk   ! Loop counters 
    11671265      INTEGER                          :: it           ! Index 
     1266      REAL(wp)                         :: zincper      ! IAU interval in seconds 
    11681267      REAL(wp)                         :: zincwgt      ! IAU weight for timestep 
    1169       REAL(wp)                         :: zfrac_chn    ! Fraction of jpchn 
    1170       REAL(wp)                         :: zfrac_chd    ! Fraction of jpchd 
    1171       REAL(wp)                         :: zrat_phn_chn ! jpphn:jpchn ratio 
    1172       REAL(wp)                         :: zrat_phd_chd ! jpphd:jpchd ratio 
    1173       REAL(wp)                         :: zrat_pds_chd ! jppds:jpchd ratio 
    1174       REAL(wp), DIMENSION(jpi,jpj,jpk) :: chl_inc      ! Chlorophyll increments 
    1175       REAL(wp), DIMENSION(jpi,jpj,jpk) :: bkg_chl      ! Chlorophyll background 
     1268      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zinc_chltot  ! Chlorophyll increments 
     1269      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zbkg_chltot  ! Chlorophyll background 
     1270      REAL(wp), DIMENSION(jpi,jpj)     :: zdummy_2d    ! Dummy array for call 
     1271      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdummy_3d    ! Dummy array for call 
    11761272      !!------------------------------------------------------------------------ 
    11771273 
     
    11791275 
    11801276         IF ( ln_plchltotinc ) THEN 
    1181             ! Convert log10(chlorophyll) increment back to a chlorophyll increment 
    1182             ! In order to transform logchl incs to chl incs, need to account for model 
    1183             ! background, cannot simply do 10^logchl_bkginc. Need to: 
    1184             ! 1) Add logchl inc to log10(background) to get log10(analysis) 
    1185             ! 2) Take 10^log10(analysis) to get analysis 
    1186             ! 3) Subtract background from analysis to get chl incs 
    1187             ! If rn_maxchlinc > 0 then cap total absolute chlorophyll increment at that value 
    1188 #if defined key_medusa 
    1189             bkg_chl(:,:,:) = tracer_bkg(:,:,:,jpchn) + tracer_bkg(:,:,:,jpchd) 
     1277#if defined key_medusa 
     1278            zbkg_chltot(:,:,:) = tracer_bkg(:,:,:,jpchn) + tracer_bkg(:,:,:,jpchd) 
    11901279#elif defined key_hadocc 
    1191             bkg_chl(:,:,:) = chl_bkg(:,:,:) 
    1192 #endif 
    1193             DO jk = 1, jpk 
    1194                DO jj = 1, jpj 
    1195                   DO ji = 1, jpi 
    1196                      IF ( bkg_chl(ji,jj,jk) > 0.0 ) THEN 
    1197                         chl_inc(ji,jj,jk) = 10**( LOG10( bkg_chl(ji,jj,jk) ) + plchltot_bkginc(ji,jj,jk) ) - bkg_chl(ji,jj,jk) 
    1198                         IF ( rn_maxchlinc > 0.0 ) THEN 
    1199                            chl_inc(ji,jj,jk) = MAX( -1.0 * rn_maxchlinc, MIN( chl_inc(ji,jj,jk), rn_maxchlinc ) ) 
    1200                         ENDIF 
    1201                      ELSE 
    1202                         chl_inc(ji,jj,jk) = 0.0 
    1203                      ENDIF 
    1204                   END DO 
    1205                END DO 
    1206             END DO 
     1280            zbkg_chltot(:,:,:) = chl_bkg(:,:,:) 
     1281#endif 
     1282            CALL asm_bgc_unlog_3d( zbkg_chltot, plchltot_bkginc, zinc_chltot ) 
    12071283         ELSE IF ( ln_pchltotinc ) THEN 
    1208             DO jk = 1, jpk 
    1209                DO jj = 1, jpj 
    1210                   DO ji = 1, jpi 
    1211                      IF ( rn_maxchlinc > 0.0 ) THEN 
    1212                         chl_inc(ji,jj,jk) = MAX( -1.0 * rn_maxchlinc, MIN( pchltot_bkginc(ji,jj,jk), rn_maxchlinc ) ) 
    1213                      ELSE 
    1214                         chl_inc(ji,jj,jk) = pchltot_bkginc(ji,jj,jk) 
    1215                      ENDIF 
    1216                   END DO 
    1217                END DO 
    1218             END DO 
    1219          ENDIF 
    1220  
    1221 #if defined key_medusa 
    1222          ! Loop over each grid point partioning the increments based on existing ratios 
    1223          DO jk = 1, jpk 
    1224             DO jj = 1, jpj 
    1225                DO ji = 1, jpi 
    1226                   IF ( ( tracer_bkg(ji,jj,jk,jpchn) > 0.0 ) .AND. ( tracer_bkg(ji,jj,jk,jpchd) > 0.0 ) ) THEN 
    1227                      zfrac_chn = tracer_bkg(ji,jj,jk,jpchn) / (tracer_bkg(ji,jj,jk,jpchn) + tracer_bkg(ji,jj,jk,jpchd)) 
    1228                      zfrac_chd = 1.0 - zfrac_chn 
    1229                      phyto3d_balinc(ji,jj,jk,jpchn) = chl_inc(ji,jj,jk) * zfrac_chn 
    1230                      phyto3d_balinc(ji,jj,jk,jpchd) = chl_inc(ji,jj,jk) * zfrac_chd 
    1231                      zrat_phn_chn = tracer_bkg(ji,jj,jk,jpphn) / tracer_bkg(ji,jj,jk,jpchn) 
    1232                      zrat_phd_chd = tracer_bkg(ji,jj,jk,jpphd) / tracer_bkg(ji,jj,jk,jpchd) 
    1233                      zrat_pds_chd = tracer_bkg(ji,jj,jk,jppds) / tracer_bkg(ji,jj,jk,jpchd) 
    1234                      phyto3d_balinc(ji,jj,jk,jpphn) = phyto3d_balinc(ji,jj,jk,jpchn) * zrat_phn_chn 
    1235                      phyto3d_balinc(ji,jj,jk,jpphd) = phyto3d_balinc(ji,jj,jk,jpchd) * zrat_phd_chd 
    1236                      phyto3d_balinc(ji,jj,jk,jppds) = phyto3d_balinc(ji,jj,jk,jpchd) * zrat_pds_chd 
    1237                   ENDIF 
    1238                END DO 
    1239             END DO 
    1240          END DO 
     1284            zinc_chltot(:,:,:) = pchltot_bkginc(:,:,:) 
     1285         ENDIF 
     1286 
     1287         zincper = (nitiaufin_r - nitiaustr_r + 1) * rdt 
     1288 
     1289#if defined key_medusa 
     1290         CALL asm_phyto_bal_medusa( jpk,                                  & 
     1291            &                       (ln_plchltotinc .OR. ln_pchltotinc),  & 
     1292            &                       zinc_chltot,                          & 
     1293            &                       .FALSE.,                              & 
     1294            &                       zdummy_3d,                            & 
     1295            &                       .FALSE.,                              & 
     1296            &                       zdummy_3d,                            & 
     1297            &                       .FALSE.,                              & 
     1298            &                       zdummy_3d,                            & 
     1299            &                       .FALSE.,                              & 
     1300            &                       zdummy_3d,                            & 
     1301            &                       .FALSE.,                              & 
     1302            &                       zdummy_3d,                            & 
     1303            &                       zincper,                              & 
     1304            &                       rn_maxchlinc, ln_phytobal, zdummy_2d, & 
     1305            &                       pgrow_avg_3d_bkg, ploss_avg_3d_bkg,   & 
     1306            &                       phyt_avg_3d_bkg, mld_max_bkg,         & 
     1307            &                       tracer_bkg, phyto3d_balinc ) 
    12411308#elif defined key_hadocc 
    1242          phyto3d_balinc(:,:,:,jp_had_phy) = ( cchl_p_bkg(:,:,:) / (mw_carbon * c2n_p) ) * chl_inc(:,:,:) 
    1243 #else 
    1244          CALL ctl_stop( 'Attempting to assimilate p(l)chltot, ', & 
     1309         CALL asm_phyto_bal_hadocc( jpk,                                  & 
     1310            &                       (ln_plchltotinc .OR. ln_pchltotinc),  & 
     1311            &                       zinc_chltot,                          & 
     1312            &                       .FALSE.,                              & 
     1313            &                       zdummy_3d,                            & 
     1314            &                       zincper,                              & 
     1315            &                       rn_maxchlinc, ln_phytobal, zdummy_2d, & 
     1316            &                       pgrow_avg_3d_bkg, ploss_avg_3d_bkg,   & 
     1317            &                       phyt_avg_3d_bkg, mld_max_bkg,         & 
     1318            &                       cchl_p_bkg,                           & 
     1319            &                       tracer_bkg, phyto3d_balinc ) 
     1320#else 
     1321         CALL ctl_stop( 'Attempting to assimilate phyto3d data, ', & 
    12451322            &           'but not defined a biogeochemical model' ) 
    12461323#endif 
     
    14231500         ! Account for phytoplankton balancing if required 
    14241501         IF ( ln_phytobal ) THEN 
    1425             dic_bkg_temp(:,:) = tracer_bkg(:,:,1,jpdic) + phyto2d_balinc(:,:,1,jpdic) 
    1426             alk_bkg_temp(:,:) = tracer_bkg(:,:,1,jpalk) + phyto2d_balinc(:,:,1,jpalk) 
     1502            IF ( ALLOCATED(phyto2d_balinc) ) THEN 
     1503               dic_bkg_temp(:,:) = tracer_bkg(:,:,1,jpdic) + phyto2d_balinc(:,:,1,jpdic) 
     1504               alk_bkg_temp(:,:) = tracer_bkg(:,:,1,jpalk) + phyto2d_balinc(:,:,1,jpalk) 
     1505            ENDIF 
     1506            IF ( ALLOCATED(phyto3d_balinc) ) THEN 
     1507               dic_bkg_temp(:,:) = tracer_bkg(:,:,1,jpdic) + phyto3d_balinc(:,:,1,jpdic) 
     1508               alk_bkg_temp(:,:) = tracer_bkg(:,:,1,jpalk) + phyto3d_balinc(:,:,1,jpalk) 
     1509            ENDIF 
    14271510         ELSE 
    14281511            dic_bkg_temp(:,:) = tracer_bkg(:,:,1,jpdic) 
     
    14371520         ! Account for phytoplankton balancing if required 
    14381521         IF ( ln_phytobal ) THEN 
    1439             dic_bkg_temp(:,:) = tracer_bkg(:,:,1,jp_had_dic) + phyto2d_balinc(:,:,1,jp_had_dic) 
    1440             alk_bkg_temp(:,:) = tracer_bkg(:,:,1,jp_had_alk) + phyto2d_balinc(:,:,1,jp_had_alk) 
     1522            IF ( ALLOCATED(phyto2d_balinc) ) THEN 
     1523               dic_bkg_temp(:,:) = tracer_bkg(:,:,1,jp_had_dic) + phyto2d_balinc(:,:,1,jp_had_dic) 
     1524               alk_bkg_temp(:,:) = tracer_bkg(:,:,1,jp_had_alk) + phyto2d_balinc(:,:,1,jp_had_alk) 
     1525            ENDIF 
     1526            IF ( ALLOCATED(phyto3d_balinc) ) THEN 
     1527               dic_bkg_temp(:,:) = tracer_bkg(:,:,1,jp_had_dic) + phyto3d_balinc(:,:,1,jp_had_dic) 
     1528               alk_bkg_temp(:,:) = tracer_bkg(:,:,1,jp_had_alk) + phyto3d_balinc(:,:,1,jp_had_alk) 
     1529            ENDIF 
    14411530         ELSE 
    14421531            dic_bkg_temp(:,:) = tracer_bkg(:,:,1,jp_had_dic) 
     
    16691758         ! Account for phytoplankton balancing if required 
    16701759         IF ( ln_phytobal ) THEN 
    1671             dic_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpdic) + phyto2d_balinc(:,:,:,jpdic) 
    1672             alk_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpalk) + phyto2d_balinc(:,:,:,jpalk) 
    1673             din_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpdin) + phyto2d_balinc(:,:,:,jpdin) 
    1674             sil_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpsil) + phyto2d_balinc(:,:,:,jpsil) 
     1760            IF ( ALLOCATED(phyto2d_balinc) ) THEN 
     1761               dic_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpdic) + phyto2d_balinc(:,:,:,jpdic) 
     1762               alk_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpalk) + phyto2d_balinc(:,:,:,jpalk) 
     1763               din_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpdin) + phyto2d_balinc(:,:,:,jpdin) 
     1764               sil_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpsil) + phyto2d_balinc(:,:,:,jpsil) 
     1765            ENDIF 
     1766            IF ( ALLOCATED(phyto3d_balinc) ) THEN 
     1767               dic_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpdic) + phyto3d_balinc(:,:,:,jpdic) 
     1768               alk_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpalk) + phyto3d_balinc(:,:,:,jpalk) 
     1769               din_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpdin) + phyto3d_balinc(:,:,:,jpdin) 
     1770               sil_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpsil) + phyto3d_balinc(:,:,:,jpsil) 
     1771            ENDIF 
    16751772         ELSE 
    16761773            dic_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpdic) 
     
    18631960            it = jpdin 
    18641961#endif 
    1865             IF ( ln_phytobal ) THEN 
     1962            IF ( ALLOCATED(phyto2d_balinc) ) THEN 
    18661963               pno3_bkginc(:,:,:) = pno3_bkginc(:,:,:) - phyto2d_balinc(:,:,:,it) 
    18671964            ENDIF 
    1868             IF ( ln_plchltotinc .OR. ln_pchltotinc ) THEN 
     1965            IF ( ALLOCATED(phyto3d_balinc) ) THEN 
    18691966               pno3_bkginc(:,:,:) = pno3_bkginc(:,:,:) - phyto3d_balinc(:,:,:,it) 
    18701967            ENDIF 
     
    18831980#if defined key_medusa 
    18841981            it = jpsil 
    1885             IF ( ln_phytobal ) THEN 
     1982            IF ( ALLOCATED(phyto2d_balinc) ) THEN 
    18861983               psi4_bkginc(:,:,:) = psi4_bkginc(:,:,:) - phyto2d_balinc(:,:,:,it) 
    18871984            ENDIF 
    1888             IF ( ln_plchltotinc .OR. ln_pchltotinc ) THEN 
     1985            IF ( ALLOCATED(phyto3d_balinc) ) THEN 
    18891986               psi4_bkginc(:,:,:) = psi4_bkginc(:,:,:) - phyto3d_balinc(:,:,:,it) 
    18901987            ENDIF 
     
    19072004            it = jpdic 
    19082005#endif 
    1909             IF ( ln_phytobal ) THEN 
     2006            IF ( ALLOCATED(phyto2d_balinc) ) THEN 
    19102007               pdic_bkginc(:,:,:) = pdic_bkginc(:,:,:) - phyto2d_balinc(:,:,:,it) 
    19112008            ENDIF 
    1912             IF ( ln_plchltotinc .OR. ln_pchltotinc ) THEN 
     2009            IF ( ALLOCATED(phyto3d_balinc) ) THEN 
    19132010               pdic_bkginc(:,:,:) = pdic_bkginc(:,:,:) - phyto3d_balinc(:,:,:,it) 
    19142011            ENDIF 
     
    19312028            it = jpalk 
    19322029#endif 
    1933             IF ( ln_phytobal ) THEN 
     2030            IF ( ALLOCATED(phyto2d_balinc) ) THEN 
    19342031               palk_bkginc(:,:,:) = palk_bkginc(:,:,:) - phyto2d_balinc(:,:,:,it) 
    19352032            ENDIF 
    1936             IF ( ln_plchltotinc .OR. ln_pchltotinc ) THEN 
     2033            IF ( ALLOCATED(phyto3d_balinc) ) THEN 
    19372034               palk_bkginc(:,:,:) = palk_bkginc(:,:,:) - phyto3d_balinc(:,:,:,it) 
    19382035            ENDIF 
     
    19512048#if defined key_medusa 
    19522049            it = jpoxy 
    1953             IF ( ln_phytobal ) THEN 
     2050            IF ( ALLOCATED(phyto2d_balinc) ) THEN 
    19542051               po2_bkginc(:,:,:) = po2_bkginc(:,:,:) - phyto2d_balinc(:,:,:,it) 
    19552052            ENDIF 
    1956             IF ( ln_plchltotinc .OR. ln_pchltotinc ) THEN 
     2053            IF ( ALLOCATED(phyto3d_balinc) ) THEN 
    19572054               po2_bkginc(:,:,:) = po2_bkginc(:,:,:) - phyto3d_balinc(:,:,:,it) 
    19582055            ENDIF 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14_phytobal3d/NEMOGCM/NEMO/OPA_SRC/ASM/asmphytobal_hadocc.F90

    r13096 r13097  
    1 MODULE asmphyto2dbal_hadocc 
     1MODULE asmphytobal_hadocc 
    22   !!====================================================================== 
    3    !!                       ***  MODULE asmphyto2dbal_hadocc  *** 
    4    !! Calculate increments to HadOCC based on surface phyto2d increments 
     3   !!                       ***  MODULE asmphytobal_hadocc  *** 
     4   !! Calculate increments to HadOCC based on surface phyto increments 
    55   !! 
    66   !! IMPORTANT NOTE: This calls the bioanalysis routine of Hemmings et al. 
     
    1717   !! 'key_hadocc'          : HadOCC model 
    1818   !!---------------------------------------------------------------------- 
    19    !! asm_phyto2d_bal_hadocc : routine to calculate increments to HadOCC 
     19   !! asm_phyto_bal_hadocc : routine to calculate increments to HadOCC 
    2020   !!---------------------------------------------------------------------- 
    2121   USE par_kind,      ONLY: wp             ! kind parameters 
     
    3232   PRIVATE                    
    3333 
    34    PUBLIC asm_phyto2d_bal_hadocc 
     34   PUBLIC asm_phyto_bal_hadocc 
    3535 
    3636   ! Default values for biological assimilation parameters 
     
    6767CONTAINS 
    6868 
    69    SUBROUTINE asm_phyto2d_bal_hadocc( ld_chltot,                      & 
    70       &                               pinc_chltot,                    & 
    71       &                               ld_phytot,                      & 
    72       &                               pinc_phytot,                    & 
    73       &                               pincper,                        & 
    74       &                               p_maxchlinc, ld_phytobal, pmld, & 
    75       &                               pgrow_avg_bkg, ploss_avg_bkg,   & 
    76       &                               phyt_avg_bkg, mld_max_bkg,      & 
    77       &                               cchl_p_bkg,                     & 
    78       &                               tracer_bkg, phyto2d_balinc ) 
     69   SUBROUTINE asm_phyto_bal_hadocc( kdeps,                              & 
     70      &                             ld_chltot,                          & 
     71      &                             pinc_chltot_3d,                     & 
     72      &                             ld_phytot,                          & 
     73      &                             pinc_phytot_3d,                     & 
     74      &                             pincper,                            & 
     75      &                             p_maxchlinc, ld_phytobal, pmld,     & 
     76      &                             pgrow_avg_bkg_3d, ploss_avg_bkg_3d, & 
     77      &                             phyt_avg_bkg_3d, mld_max_bkg,       & 
     78      &                             cchl_p_bkg_3d,                      & 
     79      &                             tracer_bkg, phyto_balinc ) 
    7980      !!--------------------------------------------------------------------------- 
    80       !!                    ***  ROUTINE asm_phyto2d_bal_hadocc  *** 
     81      !!                    ***  ROUTINE asm_phyto_bal_hadocc  *** 
    8182      !! 
    8283      !! ** Purpose :   calculate increments to HadOCC from 2d phytoplankton increments 
     
    8485      !! ** Method  :   call nitrogen balancing scheme 
    8586      !! 
    86       !! ** Action  :   populate phyto2d_balinc 
     87      !! ** Action  :   populate phyto_balinc 
    8788      !! 
    8889      !! References :   Hemmings et al., 2008, J. Mar. Res. 
     
    9091      !!--------------------------------------------------------------------------- 
    9192      !! 
    92       LOGICAL,  INTENT(in   )                               :: ld_chltot      ! Assim chltot y/n 
    93       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj)           :: pinc_chltot    ! chltot increments 
    94       LOGICAL,  INTENT(in   )                               :: ld_phytot      ! Assim phytot y/n 
    95       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj)           :: pinc_phytot    ! phytot increments 
    96       REAL(wp), INTENT(in   )                               :: pincper        ! Assimilation period 
    97       REAL(wp), INTENT(in   )                               :: p_maxchlinc    ! Max chl increment 
    98       LOGICAL,  INTENT(in   )                               :: ld_phytobal    ! Balancing y/n 
    99       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj)           :: pmld           ! Mixed layer depth 
    100       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj)           :: pgrow_avg_bkg  ! Avg phyto growth 
    101       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj)           :: ploss_avg_bkg  ! Avg phyto loss 
    102       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj)           :: phyt_avg_bkg   ! Avg phyto 
    103       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj)           :: mld_max_bkg    ! Max MLD 
    104       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj)           :: cchl_p_bkg     ! Surface C:Chl 
    105       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpk,jptra) :: tracer_bkg     ! State variables 
    106       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj,jpk,jptra) :: phyto2d_balinc ! Balancing increments 
    107       !! 
    108       INTEGER                                               :: ji, jj, jk, jn ! Loop counters 
    109       INTEGER                                               :: jkmax          ! Loop index 
    110       INTEGER,                 DIMENSION(6)                 :: i_tracer       ! Tracer indices 
    111       REAL(wp),                DIMENSION(16)                :: modparm        ! Model parameters 
    112       REAL(wp),                DIMENSION(20)                :: assimparm      ! Assimilation parameters 
    113       REAL(wp),                DIMENSION(jpi,jpj,jpk,6)     :: bstate         ! Background state 
    114       REAL(wp),                DIMENSION(jpi,jpj,jpk,6)     :: outincs        ! Balancing increments 
    115       REAL(wp),                DIMENSION(jpi,jpj,22)        :: diag           ! Depth-indep diagnostics 
    116       REAL(wp),                DIMENSION(jpi,jpj,jpk,22)    :: diag_fulldepth ! Full-depth diagnostics 
     93      INTEGER,  INTENT(in   )                               :: kdeps            ! No. inc deps 1 or jpk 
     94      LOGICAL,  INTENT(in   )                               :: ld_chltot        ! Assim chltot y/n 
     95      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,kdeps)     :: pinc_chltot_3d   ! chltot increments 
     96      LOGICAL,  INTENT(in   )                               :: ld_phytot        ! Assim phytot y/n 
     97      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,kdeps)     :: pinc_phytot_3d   ! phytot increments 
     98      REAL(wp), INTENT(in   )                               :: pincper          ! Assimilation period 
     99      REAL(wp), INTENT(in   )                               :: p_maxchlinc      ! Max chl increment 
     100      LOGICAL,  INTENT(in   )                               :: ld_phytobal      ! Balancing y/n 
     101      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj)           :: pmld             ! Mixed layer depth 
     102      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,kdeps)     :: pgrow_avg_bkg_3d ! Avg phyto growth 
     103      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,kdeps)     :: ploss_avg_bkg_3d ! Avg phyto loss 
     104      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,kdeps)     :: phyt_avg_bkg_3d  ! Avg phyto 
     105      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj)           :: mld_max_bkg      ! Max MLD 
     106      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,kdeps)     :: cchl_p_bkg_3d    ! C:Chl 
     107      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpk,jptra) :: tracer_bkg       ! State variables 
     108      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj,jpk,jptra) :: phyto_balinc     ! Balancing increments 
     109      !! 
     110      INTEGER                                               :: ji, jj, jk, jn    ! Loop counters 
     111      INTEGER                                               :: jkmax             ! Loop index 
     112      INTEGER,                 DIMENSION(6)                 :: i_tracer          ! Tracer indices 
     113      REAL(wp),                DIMENSION(16)                :: modparm           ! Model parameters 
     114      REAL(wp),                DIMENSION(20)                :: assimparm         ! Assimilation parameters 
     115      REAL(wp),                DIMENSION(jpi,jpj,1,6)       :: bstate_2d         ! Background state (2D) 
     116      REAL(wp),                DIMENSION(jpi,jpj,jpk,6)     :: bstate_3d         ! Background state (3D) 
     117      REAL(wp),                DIMENSION(jpi,jpj,1,6)       :: outincs_2d        ! Balancing increments (2D) 
     118      REAL(wp),                DIMENSION(jpi,jpj,jpk,6)     :: outincs_3d        ! Balancing increments (3D) 
     119      REAL(wp),                DIMENSION(jpi,jpj,22)        :: diag              ! Depth-indep diagnostics 
     120      REAL(wp),                DIMENSION(jpi,jpj,1,22)      :: diag_fulldepth_2d ! Full-depth diagnostics (2D) 
     121      REAL(wp),                DIMENSION(jpi,jpj,jpk,22)    :: diag_fulldepth_3d ! Full-depth diagnostics (3D) 
     122      REAL(wp),                DIMENSION(jpi,jpj)           :: cchl_p_bkg_2d     ! C:Chl for total phy (2D) 
     123      REAL(wp),                DIMENSION(jpi,jpj,1)         :: tmask_2d          ! Single-level tmask 
     124      REAL(wp),                DIMENSION(jpi,jpj)           :: pinc_chltot_2d    ! chltot increments (2D) 
     125      REAL(wp),                DIMENSION(jpi,jpj)           :: pinc_phytot_2d    ! phytot increments (2D) 
     126      REAL(wp),                DIMENSION(jpi,jpj)           :: pgrow_avg_bkg_2d  ! Avg phyto growth (2D) 
     127      REAL(wp),                DIMENSION(jpi,jpj)           :: ploss_avg_bkg_2d  ! Avg phyto loss (2D) 
     128      REAL(wp),                DIMENSION(jpi,jpj)           :: phyt_avg_bkg_2d   ! Avg phyto (2D) 
    117129      !!--------------------------------------------------------------------------- 
    118130 
    119131      IF ( ( .NOT. ld_chltot ) .AND. ( .NOT. ld_phytot ) ) THEN 
    120          CALL ctl_stop( ' Trying to do phyto2d balancing but nothing to assimilate' ) 
     132         CALL ctl_stop( ' Trying to do phyto balancing but nothing to assimilate' ) 
    121133      ENDIF 
    122134       
     
    124136      IF ( p_maxchlinc > 0.0 ) THEN 
    125137         IF ( ld_chltot ) THEN 
    126             DO jj = 1, jpj 
    127                DO ji = 1, jpi 
    128                   pinc_chltot(ji,jj) = MAX( -1.0 * p_maxchlinc, MIN( pinc_chltot(ji,jj), p_maxchlinc ) ) 
     138            DO jk = 1, kdeps 
     139               DO jj = 1, jpj 
     140                  DO ji = 1, jpi 
     141                     pinc_chltot_3d(ji,jj,jk) = MAX( -1.0 * p_maxchlinc, MIN( pinc_chltot_3d(ji,jj,jk), p_maxchlinc ) ) 
     142                  END DO 
    129143               END DO 
    130144            END DO 
     
    187201 
    188202         ! Set background state 
    189          bstate(:,:,:,i_tracer(1)) = tracer_bkg(:,:,:,jp_had_nut) 
    190          bstate(:,:,:,i_tracer(2)) = tracer_bkg(:,:,:,jp_had_phy) 
    191          bstate(:,:,:,i_tracer(3)) = tracer_bkg(:,:,:,jp_had_zoo) 
    192          bstate(:,:,:,i_tracer(4)) = tracer_bkg(:,:,:,jp_had_pdn) 
    193          bstate(:,:,:,i_tracer(5)) = tracer_bkg(:,:,:,jp_had_dic) 
    194          bstate(:,:,:,i_tracer(6)) = tracer_bkg(:,:,:,jp_had_alk) 
     203         bstate_3d(:,:,:,i_tracer(1)) = tracer_bkg(:,:,:,jp_had_nut) 
     204         bstate_3d(:,:,:,i_tracer(2)) = tracer_bkg(:,:,:,jp_had_phy) 
     205         bstate_3d(:,:,:,i_tracer(3)) = tracer_bkg(:,:,:,jp_had_zoo) 
     206         bstate_3d(:,:,:,i_tracer(4)) = tracer_bkg(:,:,:,jp_had_pdn) 
     207         bstate_3d(:,:,:,i_tracer(5)) = tracer_bkg(:,:,:,jp_had_dic) 
     208         bstate_3d(:,:,:,i_tracer(6)) = tracer_bkg(:,:,:,jp_had_alk) 
    195209 
    196210         ! Call nitrogen balancing routine 
    197          CALL bio_analysis( jpi, jpj, jpk, ZDZ(:,:,:), i_tracer, modparm,               & 
    198             &               n2be_p, n2be_z, n2be_d, assimparm,                          & 
    199             &               INT(pincper), 1, kmt(:,:), tmask(:,:,:),                    & 
    200             &               pmld(:,:), mld_max_bkg(:,:), pinc_chltot(:,:), cchl_p_bkg(:,:), & 
    201             &               nbal_active, phyt_avg_bkg(:,:),                             & 
    202             &               gl_active, pgrow_avg_bkg(:,:), ploss_avg_bkg(:,:),          & 
    203             &               subsurf_active, deepneg_active,                             & 
    204             &               deeppos_active, nutprof_active,                             & 
    205             &               bstate, outincs,                                            & 
    206             &               diag_active, diag,                                          & 
    207             &               diag_fulldepth_active, diag_fulldepth ) 
     211         IF (kdeps == 1) THEN 
     212            pinc_chltot_2d(:,:)   = pinc_chltot_3d(:,:,1) 
     213            cchl_p_bkg_2d(:,:)    = cchl_p_bkg_3d(:,:,1) 
     214            phyt_avg_bkg_2d(:,:)  = phyt_avg_bkg_3d(:,:,1) 
     215            pgrow_avg_bkg_2d(:,:) = pgrow_avg_bkg_3d(:,:,1) 
     216            ploss_avg_bkg_2d(:,:) = ploss_avg_bkg_3d(:,:,1) 
     217             
     218            CALL bio_analysis( jpi, jpj, jpk, ZDZ(:,:,:), i_tracer, modparm,               & 
     219               &               n2be_p, n2be_z, n2be_d, assimparm,                          & 
     220               &               INT(pincper), 1, kmt(:,:), tmask(:,:,:),                    & 
     221               &               pmld(:,:), mld_max_bkg(:,:), pinc_chltot_2d(:,:), cchl_p_bkg_2d(:,:), & 
     222               &               nbal_active, phyt_avg_bkg_2d(:,:),                          & 
     223               &               gl_active, pgrow_avg_bkg_2d(:,:), ploss_avg_bkg_2d(:,:),    & 
     224               &               subsurf_active, deepneg_active,                             & 
     225               &               deeppos_active, nutprof_active,                             & 
     226               &               bstate_3d, outincs_3d,                                      & 
     227               &               diag_active, diag,                                          & 
     228               &               diag_fulldepth_active, diag_fulldepth_3d ) 
     229         ELSE 
     230            pmld(:,:) = 0.5 
     231             
     232            DO jk = 1, kdeps 
     233               pinc_chltot_2d(:,:)   = pinc_chltot_3d(:,:,jk) 
     234               cchl_p_bkg_2d(:,:)    = cchl_p_bkg_3d(:,:,jk) 
     235               phyt_avg_bkg_2d(:,:)  = phyt_avg_bkg_3d(:,:,jk) 
     236               pgrow_avg_bkg_2d(:,:) = pgrow_avg_bkg_3d(:,:,jk) 
     237               ploss_avg_bkg_2d(:,:) = ploss_avg_bkg_3d(:,:,jk) 
     238               tmask_2d(:,:,1)       = tmask(:,:,jk) 
     239               bstate_2d(:,:,1,:)    = bstate_3d(:,:,jk,:) 
     240               outincs_2d(:,:,:,:)   = 0.0 
     241 
     242               CALL bio_analysis( jpi, jpj, 1, gdepw_n(:,:,2), i_tracer, modparm,            & 
     243                  &               n2be_p, n2be_z, n2be_d, assimparm,                         & 
     244                  &               INT(pincper), 1, INT(SUM(tmask_2d,3)), tmask_2d(:,:,:),    & 
     245                  &               pmld(:,:), pmld(:,:), pinc_chltot_2d(:,:), cchl_p_bkg_2d(:,:), & 
     246                  &               nbal_active, phyt_avg_bkg_2d(:,:),                         & 
     247                  &               gl_active, pgrow_avg_bkg_2d(:,:), ploss_avg_bkg_2d(:,:),   & 
     248                  &               subsurf_active, deepneg_active,                            & 
     249                  &               deeppos_active, nutprof_active,                            & 
     250                  &               bstate_2d, outincs_2d,                                     & 
     251                  &               diag_active, diag,                                         & 
     252                  &               diag_fulldepth_active, diag_fulldepth_2d ) 
     253 
     254               outincs_3d(:,:,jk,:) = outincs_2d(:,:,1,:) 
     255            END DO 
     256         ENDIF 
    208257 
    209258         ! Save balancing increments 
    210          phyto2d_balinc(:,:,:,jp_had_nut) = outincs(:,:,:,i_tracer(1)) 
    211          phyto2d_balinc(:,:,:,jp_had_phy) = outincs(:,:,:,i_tracer(2)) 
    212          phyto2d_balinc(:,:,:,jp_had_zoo) = outincs(:,:,:,i_tracer(3)) 
    213          phyto2d_balinc(:,:,:,jp_had_pdn) = outincs(:,:,:,i_tracer(4)) 
    214          phyto2d_balinc(:,:,:,jp_had_dic) = outincs(:,:,:,i_tracer(5)) 
    215          phyto2d_balinc(:,:,:,jp_had_alk) = outincs(:,:,:,i_tracer(6)) 
     259         phyto_balinc(:,:,:,jp_had_nut) = outincs_3d(:,:,:,i_tracer(1)) 
     260         phyto_balinc(:,:,:,jp_had_phy) = outincs_3d(:,:,:,i_tracer(2)) 
     261         phyto_balinc(:,:,:,jp_had_zoo) = outincs_3d(:,:,:,i_tracer(3)) 
     262         phyto_balinc(:,:,:,jp_had_pdn) = outincs_3d(:,:,:,i_tracer(4)) 
     263         phyto_balinc(:,:,:,jp_had_dic) = outincs_3d(:,:,:,i_tracer(5)) 
     264         phyto_balinc(:,:,:,jp_had_alk) = outincs_3d(:,:,:,i_tracer(6)) 
    216265       
    217266      ELSE   ! No nitrogen balancing 
    218267       
    219268         ! Initialise phytoplankton increment to zero 
    220          phyto2d_balinc(:,:,:,jp_had_phy) = 0.0 
     269         phyto_balinc(:,:,:,jp_had_phy) = 0.0 
    221270          
    222271         ! Convert surface chlorophyll increment to phytoplankton nitrogen 
    223          phyto2d_balinc(:,:,1,jp_had_phy) = ( cchl_p_bkg(:,:) / (mw_carbon * c2n_p) ) * pinc_chltot(:,:) 
     272         DO jk = 1, kdeps 
     273            phyto_balinc(:,:,jk,jp_had_phy) = ( cchl_p_bkg_3d(:,:,jk) / (mw_carbon * c2n_p) ) * pinc_chltot_3d(:,:,jk) 
     274         END DO 
    224275          
    225          ! Propagate through mixed layer 
    226          DO jj = 1, jpj 
    227             DO ji = 1, jpi 
    228                ! 
    229                jkmax = jpk-1 
    230                DO jk = jpk-1, 1, -1 
    231                   IF ( ( pmld(ji,jj) >  gdepw_n(ji,jj,jk)   ) .AND. & 
    232                      & ( pmld(ji,jj) <= gdepw_n(ji,jj,jk+1) ) ) THEN 
    233                      pmld(ji,jj) = gdepw_n(ji,jj,jk+1) 
    234                      jkmax = jk 
    235                   ENDIF 
     276         IF (kdeps == 1) THEN 
     277            ! Propagate through mixed layer 
     278            DO jj = 1, jpj 
     279               DO ji = 1, jpi 
     280                  ! 
     281                  jkmax = jpk-1 
     282                  DO jk = jpk-1, 1, -1 
     283                     IF ( ( pmld(ji,jj) >  gdepw_n(ji,jj,jk)   ) .AND. & 
     284                        & ( pmld(ji,jj) <= gdepw_n(ji,jj,jk+1) ) ) THEN 
     285                        pmld(ji,jj) = gdepw_n(ji,jj,jk+1) 
     286                        jkmax = jk 
     287                     ENDIF 
     288                  END DO 
     289                  ! 
     290                  DO jk = 2, jkmax 
     291                     phyto_balinc(ji,jj,jk,jp_had_phy) = phyto_balinc(ji,jj,1,jp_had_phy) 
     292                  END DO 
     293                  ! 
    236294               END DO 
    237                ! 
    238                DO jk = 2, jkmax 
    239                   phyto2d_balinc(ji,jj,jk,jp_had_phy) = phyto2d_balinc(ji,jj,1,jp_had_phy) 
    240                END DO 
    241                ! 
    242295            END DO 
    243          END DO 
     296         ENDIF 
    244297 
    245298         ! Set other balancing increments to zero 
    246          phyto2d_balinc(:,:,:,jp_had_nut) = 0.0 
    247          phyto2d_balinc(:,:,:,jp_had_zoo) = 0.0 
    248          phyto2d_balinc(:,:,:,jp_had_pdn) = 0.0 
    249          phyto2d_balinc(:,:,:,jp_had_dic) = 0.0 
    250          phyto2d_balinc(:,:,:,jp_had_alk) = 0.0 
     299         phyto_balinc(:,:,:,jp_had_nut) = 0.0 
     300         phyto_balinc(:,:,:,jp_had_zoo) = 0.0 
     301         phyto_balinc(:,:,:,jp_had_pdn) = 0.0 
     302         phyto_balinc(:,:,:,jp_had_dic) = 0.0 
     303         phyto_balinc(:,:,:,jp_had_alk) = 0.0 
    251304       
    252305      ENDIF 
    253306 
    254    END SUBROUTINE asm_phyto2d_bal_hadocc 
     307   END SUBROUTINE asm_phyto_bal_hadocc 
    255308 
    256309#else 
     
    259312   !!---------------------------------------------------------------------- 
    260313CONTAINS 
    261    SUBROUTINE asm_phyto2d_bal_hadocc( ld_chltot,                      & 
    262       &                               pinc_chltot,                    & 
    263       &                               ld_phytot,                      & 
    264       &                               pinc_phytot,                    & 
    265       &                               pincper,                        & 
    266       &                               p_maxchlinc, ld_phytobal, pmld, & 
    267       &                               pgrow_avg_bkg, ploss_avg_bkg,   & 
    268       &                               phyt_avg_bkg, mld_max_bkg,      & 
    269       &                               cchl_p_bkg,                     & 
    270       &                               tracer_bkg, phyto2d_balinc ) 
     314   SUBROUTINE asm_phyto_bal_hadocc( kdeps,                              & 
     315      &                             ld_chltot,                          & 
     316      &                             pinc_chltot_3d,                     & 
     317      &                             ld_phytot,                          & 
     318      &                             pinc_phytot,                        & 
     319      &                             pincper,                            & 
     320      &                             p_maxchlinc, ld_phytobal, pmld,     & 
     321      &                             pgrow_avg_bkg_3d, ploss_avg_bkg_3d, & 
     322      &                             phyt_avg_bkg_3d, mld_max_bkg,       & 
     323      &                             cchl_p_bkg_3d,                      & 
     324      &                             tracer_bkg, phyto_balinc ) 
     325      INTEGER :: kdeps 
    271326      LOGICAL :: ld_chltot 
    272       REAL    :: pinc_chltot(:,:) 
     327      REAL    :: pinc_chltot_3d(:,:,:) 
    273328      LOGICAL :: ld_phytot 
    274       REAL    :: pinc_phytot(:,:) 
     329      REAL    :: pinc_phytot_3d(:,:,:) 
    275330      REAL    :: pincper 
    276331      REAL    :: p_maxchlinc 
    277332      LOGICAL :: ld_phytobal 
    278333      REAL    :: pmld(:,:) 
    279       REAL    :: pgrow_avg_bkg(:,:) 
    280       REAL    :: ploss_avg_bkg(:,:) 
    281       REAL    :: phyt_avg_bkg(:,:) 
     334      REAL    :: pgrow_avg_bkg_3d(:,:,:) 
     335      REAL    :: ploss_avg_bkg_3d(:,:,:) 
     336      REAL    :: phyt_avg_bkg_3d(:,:,:) 
    282337      REAL    :: mld_max_bkg(:,:) 
    283       REAL    :: cchl_p_bkg(:,:) 
     338      REAL    :: cchl_p_bkg_3d(:,:,:) 
    284339      REAL    :: tracer_bkg(:,:,:,:) 
    285       REAL    :: phyto2d_balinc(:,:,:,:) 
    286       WRITE(*,*) 'asm_phyto2d_bal_hadocc: You should not have seen this print! error?' 
    287    END SUBROUTINE asm_phyto2d_bal_hadocc 
     340      REAL    :: phyto_balinc(:,:,:,:) 
     341      WRITE(*,*) 'asm_phyto_bal_hadocc: You should not have seen this print! error?' 
     342   END SUBROUTINE asm_phyto_bal_hadocc 
    288343#endif 
    289344 
    290345   !!====================================================================== 
    291 END MODULE asmphyto2dbal_hadocc 
     346END MODULE asmphytobal_hadocc 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14_phytobal3d/NEMOGCM/NEMO/OPA_SRC/ASM/asmphytobal_medusa.F90

    r13096 r13097  
    1 MODULE asmphyto2dbal_medusa 
     1MODULE asmphytobal_medusa 
    22   !!====================================================================== 
    33   !!                       ***  MODULE asmphyto2dbal_medusa  *** 
     
    3333   PRIVATE                    
    3434 
    35    PUBLIC asm_phyto2d_bal_medusa 
     35   PUBLIC asm_phyto_bal_medusa 
    3636 
    3737   ! Default values for biological assimilation parameters 
     
    6868CONTAINS 
    6969 
    70    SUBROUTINE asm_phyto2d_bal_medusa( ld_chltot,                      & 
    71       &                               pinc_chltot,                    & 
    72       &                               ld_chldia,                      & 
    73       &                               pinc_chldia,                    & 
    74       &                               ld_chlnon,                      & 
    75       &                               pinc_chlnon,                    & 
    76       &                               ld_phytot,                      & 
    77       &                               pinc_phytot,                    & 
    78       &                               ld_phydia,                      & 
    79       &                               pinc_phydia,                    & 
    80       &                               ld_phynon,                      & 
    81       &                               pinc_phynon,                    & 
    82       &                               pincper,                        & 
    83       &                               p_maxchlinc, ld_phytobal, pmld, & 
    84       &                               pgrow_avg_bkg, ploss_avg_bkg,   & 
    85       &                               phyt_avg_bkg, mld_max_bkg,      & 
    86       &                               tracer_bkg, phyto2d_balinc ) 
     70   SUBROUTINE asm_phyto_bal_medusa( kdeps,                              & 
     71      &                             ld_chltot,                          & 
     72      &                             pinc_chltot_3d,                     & 
     73      &                             ld_chldia,                          & 
     74      &                             pinc_chldia_3d,                     & 
     75      &                             ld_chlnon,                          & 
     76      &                             pinc_chlnon_3d,                     & 
     77      &                             ld_phytot,                          & 
     78      &                             pinc_phytot_3d,                     & 
     79      &                             ld_phydia,                          & 
     80      &                             pinc_phydia_3d,                     & 
     81      &                             ld_phynon,                          & 
     82      &                             pinc_phynon_3d,                     & 
     83      &                             pincper,                            & 
     84      &                             p_maxchlinc, ld_phytobal, pmld,     & 
     85      &                             pgrow_avg_bkg_3d, ploss_avg_bkg_3d, & 
     86      &                             phyt_avg_bkg_3d, mld_max_bkg,       & 
     87      &                             tracer_bkg, phyto_balinc ) 
    8788      !!--------------------------------------------------------------------------- 
    88       !!                    ***  ROUTINE asm_phyto2d_bal_medusa  *** 
     89      !!                    ***  ROUTINE asm_phyto_bal_medusa  *** 
    8990      !! 
    90       !! ** Purpose :   calculate increments to MEDUSA from 2d phytoplankton increments 
     91      !! ** Purpose :   calculate increments to MEDUSA from phytoplankton increments 
    9192      !! 
    9293      !! ** Method  :   average up MEDUSA to look like HadOCC 
     
    9495      !!                separate back out to MEDUSA 
    9596      !! 
    96       !! ** Action  :   populate phyto2d_balinc 
     97      !! ** Action  :   populate phyto_balinc 
    9798      !! 
    9899      !! References :   Hemmings et al., 2008, J. Mar. Res. 
     
    100101      !!--------------------------------------------------------------------------- 
    101102      !! 
    102       LOGICAL,  INTENT(in   )                               :: ld_chltot      ! Assim chltot y/n 
    103       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj)           :: pinc_chltot    ! chltot increments 
    104       LOGICAL,  INTENT(in   )                               :: ld_chldia      ! Assim chldia y/n 
    105       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj)           :: pinc_chldia    ! chldia increments 
    106       LOGICAL,  INTENT(in   )                               :: ld_chlnon      ! Assim chlnon y/n 
    107       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj)           :: pinc_chlnon    ! chlnon increments 
    108       LOGICAL,  INTENT(in   )                               :: ld_phytot      ! Assim phytot y/n 
    109       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj)           :: pinc_phytot    ! phytot increments 
    110       LOGICAL,  INTENT(in   )                               :: ld_phydia      ! Assim phydia y/n 
    111       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj)           :: pinc_phydia    ! phydia increments 
    112       LOGICAL,  INTENT(in   )                               :: ld_phynon      ! Assim phynon y/n 
    113       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj)           :: pinc_phynon    ! phynon increments 
    114       REAL(wp), INTENT(in   )                               :: pincper        ! Assimilation period 
    115       REAL(wp), INTENT(in   )                               :: p_maxchlinc    ! Max chl increment 
    116       LOGICAL,  INTENT(in   )                               :: ld_phytobal    ! Balancing y/n 
    117       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj)           :: pmld           ! Mixed layer depth 
    118       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj)           :: pgrow_avg_bkg  ! Avg phyto growth 
    119       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj)           :: ploss_avg_bkg  ! Avg phyto loss 
    120       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj)           :: phyt_avg_bkg   ! Avg phyto 
    121       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj)           :: mld_max_bkg    ! Max MLD 
    122       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpk,jptra) :: tracer_bkg     ! State variables 
    123       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj,jpk,jptra) :: phyto2d_balinc ! Balancing increments 
     103      INTEGER,  INTENT(in   )                               :: kdeps            ! No. inc deps 1 or jpk 
     104      LOGICAL,  INTENT(in   )                               :: ld_chltot        ! Assim chltot y/n 
     105      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,kdeps)     :: pinc_chltot_3d   ! chltot increments (3D) 
     106      LOGICAL,  INTENT(in   )                               :: ld_chldia        ! Assim chldia y/n 
     107      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,kdeps)     :: pinc_chldia_3d   ! chldia increments (3D) 
     108      LOGICAL,  INTENT(in   )                               :: ld_chlnon        ! Assim chlnon y/n 
     109      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,kdeps)     :: pinc_chlnon_3d   ! chlnon increments (3D) 
     110      LOGICAL,  INTENT(in   )                               :: ld_phytot        ! Assim phytot y/n 
     111      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,kdeps)     :: pinc_phytot_3d   ! phytot increments (3D) 
     112      LOGICAL,  INTENT(in   )                               :: ld_phydia        ! Assim phydia y/n 
     113      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,kdeps)     :: pinc_phydia_3d   ! phydia increments (3D) 
     114      LOGICAL,  INTENT(in   )                               :: ld_phynon        ! Assim phynon y/n 
     115      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,kdeps)     :: pinc_phynon_3d   ! phynon increments (3D) 
     116      REAL(wp), INTENT(in   )                               :: pincper          ! Assimilation period 
     117      REAL(wp), INTENT(in   )                               :: p_maxchlinc      ! Max chl increment 
     118      LOGICAL,  INTENT(in   )                               :: ld_phytobal      ! Balancing y/n 
     119      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj)           :: pmld             ! Mixed layer depth 
     120      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,kdeps)     :: pgrow_avg_bkg_3d ! Avg phyto growth (3D) 
     121      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,kdeps)     :: ploss_avg_bkg_3d ! Avg phyto loss (3D) 
     122      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,kdeps)     :: phyt_avg_bkg_3d  ! Avg phyto (3D) 
     123      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj)           :: mld_max_bkg      ! Max MLD 
     124      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpk,jptra) :: tracer_bkg       ! State variables 
     125      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj,jpk,jptra) :: phyto_balinc     ! Balancing increments 
    124126      !! 
    125127      INTEGER                                               :: ji, jj, jk, jn ! Loop counters 
    126128      INTEGER                                               :: jkmax          ! Loop index 
     129      INTEGER                                               :: jkinc          ! Loop index 
    127130      INTEGER,                 DIMENSION(6)                 :: i_tracer       ! Tracer indices 
    128131      REAL(wp)                                              :: n2be_p         ! N:biomass for total phy 
     
    143146      REAL(wp)                                              :: zrat_pds_chd   ! Ratio of jppds:jpchd 
    144147      REAL(wp)                                              :: zrat_dtc_det   ! Ratio of jpdtc:jpdet 
    145       REAL(wp),                DIMENSION(jpi,jpj)           :: cchl_p         ! C:Chl for total phy 
     148      REAL(wp),                DIMENSION(jpi,jpj)           :: cchl_p_2d      ! C:Chl for total phy (2D) 
     149      REAL(wp),                DIMENSION(jpi,jpj,jpk)       :: cchl_p_3d      ! C:Chl for total phy (3D) 
    146150      REAL(wp),                DIMENSION(16)                :: modparm        ! Model parameters 
    147151      REAL(wp),                DIMENSION(20)                :: assimparm      ! Assimilation parameters 
    148       REAL(wp),                DIMENSION(jpi,jpj,jpk,6)     :: bstate         ! Background state 
    149       REAL(wp),                DIMENSION(jpi,jpj,jpk,6)     :: outincs        ! Balancing increments 
    150       REAL(wp),                DIMENSION(jpi,jpj,22)        :: diag           ! Depth-indep diagnostics 
    151       REAL(wp),                DIMENSION(jpi,jpj,jpk,22)    :: diag_fulldepth ! Full-depth diagnostics 
     152      REAL(wp),                DIMENSION(jpi,jpj,1,6)       :: bstate_2d      ! Background state (2D) 
     153      REAL(wp),                DIMENSION(jpi,jpj,jpk,6)     :: bstate_3d      ! Background state (3D) 
     154      REAL(wp),                DIMENSION(jpi,jpj,1,6)       :: outincs_2d     ! Balancing increments (2D) 
     155      REAL(wp),                DIMENSION(jpi,jpj,jpk,6)     :: outincs_3d     ! Balancing increments (3D) 
     156      REAL(wp),                DIMENSION(jpi,jpj,22)        :: diag              ! Depth-indep diagnostics 
     157      REAL(wp),                DIMENSION(jpi,jpj,1,22)      :: diag_fulldepth_2d ! Full-depth diagnostics (2D) 
     158      REAL(wp),                DIMENSION(jpi,jpj,jpk,22)    :: diag_fulldepth_3d ! Full-depth diagnostics (3D) 
     159      REAL(wp),                DIMENSION(jpi,jpj,1)         :: tmask_2d          ! Single-level tmask 
     160      REAL(wp),                DIMENSION(jpi,jpj)           :: pinc_chltot_2d    ! chltot increments (2D) 
     161      REAL(wp),                DIMENSION(jpi,jpj)           :: pinc_chldia_2d    ! chldia increments (2D) 
     162      REAL(wp),                DIMENSION(jpi,jpj)           :: pinc_chlnon_2d    ! chlnon increments (2D) 
     163      REAL(wp),                DIMENSION(jpi,jpj)           :: pinc_phytot_2d    ! phytot increments (2D) 
     164      REAL(wp),                DIMENSION(jpi,jpj)           :: pinc_phydia_2d    ! phydia increments (2D) 
     165      REAL(wp),                DIMENSION(jpi,jpj)           :: pinc_phynon_2d    ! phynon increments (2D) 
     166      REAL(wp),                DIMENSION(jpi,jpj)           :: pgrow_avg_bkg_2d  ! Avg phyto growth (2D) 
     167      REAL(wp),                DIMENSION(jpi,jpj)           :: ploss_avg_bkg_2d  ! Avg phyto loss (2D) 
     168      REAL(wp),                DIMENSION(jpi,jpj)           :: phyt_avg_bkg_2d   ! Avg phyto (2D) 
    152169      !!--------------------------------------------------------------------------- 
    153170 
    154171      ! If p_maxchlinc > 0 then cap total absolute chlorophyll increment at that value 
    155172      IF ( p_maxchlinc > 0.0 ) THEN 
    156          IF ( ld_chltot ) THEN 
     173         DO jk = 1, kdeps 
    157174            DO jj = 1, jpj 
    158175               DO ji = 1, jpi 
    159                   pinc_chltot(ji,jj) = MAX( -1.0 * p_maxchlinc, MIN( pinc_chltot(ji,jj), p_maxchlinc ) ) 
     176                  IF ( ld_chltot ) THEN 
     177                     pinc_chltot_3d(ji,jj,jk) = MAX( -1.0 * p_maxchlinc, MIN( pinc_chltot_3d(ji,jj,jk), p_maxchlinc ) ) 
     178                  ELSE IF ( ld_chldia .AND. ld_chlnon ) THEN 
     179                     pinc_chltot_3d(ji,jj,jk) = pinc_chldia_3d(ji,jj,jk) + pinc_chlnon_3d(ji,jj,jk) 
     180                     pinc_chltot_3d(ji,jj,jk) = MAX( -1.0 * p_maxchlinc, MIN( pinc_chltot_3d(ji,jj,jk), p_maxchlinc ) ) 
     181                     IF ( pinc_chltot_3d(ji,jj,jk) .NE. ( pinc_chldia_3d(ji,jj,jk) + pinc_chlnon_3d(ji,jj,jk) ) ) THEN 
     182                        zfrac = pinc_chltot_3d(ji,jj,jk) / ( pinc_chldia_3d(ji,jj,jk) + pinc_chlnon_3d(ji,jj,jk) ) 
     183                        pinc_chldia_3d(ji,jj,jk) = pinc_chldia_3d(ji,jj,jk) * zfrac 
     184                        pinc_chlnon_3d(ji,jj,jk) = pinc_chlnon_3d(ji,jj,jk) * zfrac 
     185                     ENDIF 
     186                  ELSE IF ( ld_chldia ) THEN 
     187                     pinc_chldia_3d(ji,jj,jk) = MAX( -1.0 * p_maxchlinc, MIN( pinc_chldia_3d(ji,jj,jk), p_maxchlinc ) ) 
     188                     pinc_chltot_3d(ji,jj,jk) = pinc_chldia_3d(ji,jj,jk) 
     189                  ELSE IF ( ld_chlnon ) THEN 
     190                     pinc_chlnon_3d(ji,jj,jk) = MAX( -1.0 * p_maxchlinc, MIN( pinc_chlnon_3d(ji,jj,jk), p_maxchlinc ) ) 
     191                     pinc_chltot_3d(ji,jj,jk) = pinc_chlnon_3d(ji,jj,jk) 
     192                  ENDIF 
    160193               END DO 
    161194            END DO 
    162          ELSE IF ( ld_chldia .AND. ld_chlnon ) THEN 
    163             DO jj = 1, jpj 
    164                DO ji = 1, jpi 
    165                   pinc_chltot(ji,jj) = pinc_chldia(ji,jj) + pinc_chlnon(ji,jj) 
    166                   pinc_chltot(ji,jj) = MAX( -1.0 * p_maxchlinc, MIN( pinc_chltot(ji,jj), p_maxchlinc ) ) 
    167                   IF ( pinc_chltot(ji,jj) .NE. ( pinc_chldia(ji,jj) + pinc_chlnon(ji,jj) ) ) THEN 
    168                      zfrac = pinc_chltot(ji,jj) / ( pinc_chldia(ji,jj) + pinc_chlnon(ji,jj) ) 
    169                      pinc_chldia(ji,jj) = pinc_chldia(ji,jj) * zfrac 
    170                      pinc_chlnon(ji,jj) = pinc_chlnon(ji,jj) * zfrac 
    171                   ENDIF 
    172                END DO 
    173             END DO 
    174          ELSE IF ( ld_chldia ) THEN 
    175             DO jj = 1, jpj 
    176                DO ji = 1, jpi 
    177                   pinc_chldia(ji,jj) = MAX( -1.0 * p_maxchlinc, MIN( pinc_chldia(ji,jj), p_maxchlinc ) ) 
    178                   pinc_chltot(ji,jj) = pinc_chldia(ji,jj) 
    179                END DO 
    180             END DO 
    181          ELSE IF ( ld_chlnon ) THEN 
    182             DO jj = 1, jpj 
    183                DO ji = 1, jpi 
    184                   pinc_chlnon(ji,jj) = MAX( -1.0 * p_maxchlinc, MIN( pinc_chlnon(ji,jj), p_maxchlinc ) ) 
    185                   pinc_chltot(ji,jj) = pinc_chlnon(ji,jj) 
    186                END DO 
    187             END DO 
    188          ENDIF 
     195         END DO 
    189196      ENDIF 
    190197 
     
    250257 
    251258         ! Set background state 
    252          bstate(:,:,:,i_tracer(1)) = tracer_bkg(:,:,:,jpdin) 
    253          bstate(:,:,:,i_tracer(2)) = tracer_bkg(:,:,:,jpphn) + tracer_bkg(:,:,:,jpphd) 
    254          bstate(:,:,:,i_tracer(3)) = tracer_bkg(:,:,:,jpzmi) + tracer_bkg(:,:,:,jpzme) 
    255          bstate(:,:,:,i_tracer(4)) = tracer_bkg(:,:,:,jpdet) 
    256          bstate(:,:,:,i_tracer(5)) = tracer_bkg(:,:,:,jpdic) 
    257          bstate(:,:,:,i_tracer(6)) = tracer_bkg(:,:,:,jpalk) 
     259         bstate_3d(:,:,:,i_tracer(1)) = tracer_bkg(:,:,:,jpdin) 
     260         bstate_3d(:,:,:,i_tracer(2)) = tracer_bkg(:,:,:,jpphn) + tracer_bkg(:,:,:,jpphd) 
     261         bstate_3d(:,:,:,i_tracer(3)) = tracer_bkg(:,:,:,jpzmi) + tracer_bkg(:,:,:,jpzme) 
     262         bstate_3d(:,:,:,i_tracer(4)) = tracer_bkg(:,:,:,jpdet) 
     263         bstate_3d(:,:,:,i_tracer(5)) = tracer_bkg(:,:,:,jpdic) 
     264         bstate_3d(:,:,:,i_tracer(6)) = tracer_bkg(:,:,:,jpalk) 
    258265 
    259266         ! Calculate carbon to chlorophyll ratio for combined phytoplankton 
    260267         ! and nitrogen to biomass equivalent for PZD 
    261268         ! Hardwire nitrogen mass to 14.01 for now as it doesn't seem to be set in MEDUSA 
    262          cchl_p(:,:) = 0.0 
    263          DO jj = 1, jpj 
    264             DO ji = 1, jpi 
    265                IF ( ( tracer_bkg(ji,jj,1,jpchn) + tracer_bkg(ji,jj,1,jpchd ) ) .GT. 0.0 ) THEN 
    266                   cchl_p(ji,jj) = xmassc * ( ( tracer_bkg(ji,jj,1,jpphn) * xthetapn ) +      & 
    267                      &                       ( tracer_bkg(ji,jj,1,jpphd) * xthetapd )   ) /  & 
    268                      &            ( tracer_bkg(ji,jj,1,jpchn) + tracer_bkg(ji,jj,1,jpchd ) ) 
    269                ENDIF 
     269         cchl_p_3d(:,:,:) = 0.0 
     270         DO jk = 1, jpk 
     271            DO jj = 1, jpj 
     272               DO ji = 1, jpi 
     273                  IF ( ( tracer_bkg(ji,jj,jk,jpchn) + tracer_bkg(ji,jj,jk,jpchd ) ) .GT. 0.0 ) THEN 
     274                     cchl_p_3d(ji,jj,jk) = xmassc * ( ( tracer_bkg(ji,jj,jk,jpphn) * xthetapn ) +      & 
     275                        &                             ( tracer_bkg(ji,jj,jk,jpphd) * xthetapd )   ) /  & 
     276                        &                  ( tracer_bkg(ji,jj,jk,jpchn) + tracer_bkg(ji,jj,jk,jpchd ) ) 
     277                  ENDIF 
     278               END DO 
    270279            END DO 
    271280         END DO 
     
    275284 
    276285         ! Call nitrogen balancing routine 
    277          CALL bio_analysis( jpi, jpj, jpk, gdepw_n(:,:,2:jpk), i_tracer, modparm,   & 
    278             &               n2be_p, n2be_z, n2be_d, assimparm,                      & 
    279             &               INT(pincper), 1, INT(SUM(tmask,3)), tmask(:,:,:),       & 
    280             &               pmld(:,:), mld_max_bkg(:,:), pinc_chltot(:,:), cchl_p(:,:), & 
    281             &               nbal_active, phyt_avg_bkg(:,:),                         & 
    282             &               gl_active, pgrow_avg_bkg(:,:), ploss_avg_bkg(:,:),      & 
    283             &               subsurf_active, deepneg_active,                         & 
    284             &               deeppos_active, nutprof_active,                         & 
    285             &               bstate, outincs,                                        & 
    286             &               diag_active, diag,                                      & 
    287             &               diag_fulldepth_active, diag_fulldepth ) 
     286         IF (kdeps == 1) THEN 
     287            pinc_chltot_2d(:,:)   = pinc_chltot_3d(:,:,1) 
     288            cchl_p_2d(:,:)        = cchl_p_3d(:,:,1) 
     289            phyt_avg_bkg_2d(:,:)  = phyt_avg_bkg_3d(:,:,1) 
     290            pgrow_avg_bkg_2d(:,:) = pgrow_avg_bkg_3d(:,:,1) 
     291            ploss_avg_bkg_2d(:,:) = ploss_avg_bkg_3d(:,:,1) 
     292             
     293            CALL bio_analysis( jpi, jpj, jpk, gdepw_n(:,:,2:jpk), i_tracer, modparm,   & 
     294               &               n2be_p, n2be_z, n2be_d, assimparm,                      & 
     295               &               INT(pincper), 1, INT(SUM(tmask,3)), tmask(:,:,:),       & 
     296               &               pmld(:,:), mld_max_bkg(:,:), pinc_chltot_2d(:,:), cchl_p_2d(:,:), & 
     297               &               nbal_active, phyt_avg_bkg_2d(:,:),                      & 
     298               &               gl_active, pgrow_avg_bkg_2d(:,:), ploss_avg_bkg_2d(:,:), & 
     299               &               subsurf_active, deepneg_active,                         & 
     300               &               deeppos_active, nutprof_active,                         & 
     301               &               bstate_3d, outincs_3d,                                  & 
     302               &               diag_active, diag,                                      & 
     303               &               diag_fulldepth_active, diag_fulldepth_3d ) 
     304         ELSE 
     305            pmld(:,:) = 0.5 
     306             
     307            DO jk = 1, kdeps 
     308               pinc_chltot_2d(:,:)   = pinc_chltot_3d(:,:,jk) 
     309               cchl_p_2d(:,:)        = cchl_p_3d(:,:,jk) 
     310               phyt_avg_bkg_2d(:,:)  = phyt_avg_bkg_3d(:,:,jk) 
     311               pgrow_avg_bkg_2d(:,:) = pgrow_avg_bkg_3d(:,:,jk) 
     312               ploss_avg_bkg_2d(:,:) = ploss_avg_bkg_3d(:,:,jk) 
     313               tmask_2d(:,:,1)       = tmask(:,:,jk) 
     314               bstate_2d(:,:,1,:)    = bstate_3d(:,:,jk,:) 
     315               outincs_2d(:,:,:,:)   = 0.0 
     316 
     317               CALL bio_analysis( jpi, jpj, 1, gdepw_n(:,:,2), i_tracer, modparm,            & 
     318                  &               n2be_p, n2be_z, n2be_d, assimparm,                         & 
     319                  &               INT(pincper), 1, INT(SUM(tmask_2d,3)), tmask_2d(:,:,:),    & 
     320                  &               pmld(:,:), pmld(:,:), pinc_chltot_2d(:,:), cchl_p_2d(:,:), & 
     321                  &               nbal_active, phyt_avg_bkg_2d(:,:),                         & 
     322                  &               gl_active, pgrow_avg_bkg_2d(:,:), ploss_avg_bkg_2d(:,:),   & 
     323                  &               subsurf_active, deepneg_active,                            & 
     324                  &               deeppos_active, nutprof_active,                            & 
     325                  &               bstate_2d, outincs_2d,                                     & 
     326                  &               diag_active, diag,                                         & 
     327                  &               diag_fulldepth_active, diag_fulldepth_2d ) 
     328 
     329               outincs_3d(:,:,jk,:) = outincs_2d(:,:,1,:) 
     330            END DO 
     331         ENDIF 
    288332          
    289333         ! Loop over each grid point partioning the increments 
    290          phyto2d_balinc(:,:,:,:) = 0.0 
     334         phyto_balinc(:,:,:,:) = 0.0 
    291335         DO jk = 1, jpk 
     336            IF (kdeps == 1) THEN 
     337               jkinc = 1 
     338            ELSE 
     339               IF (jk > kdeps) THEN 
     340                  EXIT 
     341               ENDIF 
     342               jkinc = jk 
     343            ENDIF 
    292344            DO jj = 1, jpj 
    293345               DO ji = 1, jpi 
     
    296348                  IF ( ( tracer_bkg(ji,jj,jk,jpphn) > 0.0 ) .AND. & 
    297349                     & ( tracer_bkg(ji,jj,jk,jpphd) > 0.0 ) .AND. & 
    298                      & ( pinc_chltot(ji,jj) /= 0.0 ) ) THEN 
     350                     & ( pinc_chltot_3d(ji,jj,jkinc) /= 0.0 ) ) THEN 
    299351                     IF ( ld_chltot ) THEN 
    300352                        ! Phytoplankton nitrogen split up based on existing ratios 
     
    305357                     ELSE IF ( ld_chldia .AND. ld_chlnon ) THEN 
    306358                        ! Phytoplankton nitrogen split up based on assimilation increments 
    307                         zfrac_phn = pinc_chlnon(ji,jj) / pinc_chltot(ji,jj) 
    308                         zfrac_phd = pinc_chldia(ji,jj) / pinc_chltot(ji,jj) 
     359                        zfrac_phn = pinc_chlnon_3d(ji,jj,jkinc) / pinc_chltot_3d(ji,jj,jkinc) 
     360                        zfrac_phd = pinc_chldia_3d(ji,jj,jkinc) / pinc_chltot_3d(ji,jj,jkinc) 
    309361                     ENDIF 
    310362 
     
    318370                     zrat_chd_phd = tracer_bkg(ji,jj,jk,jpchd) / tracer_bkg(ji,jj,jk,jpphd) 
    319371                      
    320                      phyto2d_balinc(ji,jj,jk,jpphn) = outincs(ji,jj,jk,i_tracer(2)) * zfrac_phn 
    321                      phyto2d_balinc(ji,jj,jk,jpphd) = outincs(ji,jj,jk,i_tracer(2)) * zfrac_phd 
    322                      phyto2d_balinc(ji,jj,jk,jppds) = phyto2d_balinc(ji,jj,jk,jpphd) * zrat_pds_phd 
    323                      phyto2d_balinc(ji,jj,jk,jpchn) = phyto2d_balinc(ji,jj,jk,jpphn) * zrat_chn_phn 
    324                      phyto2d_balinc(ji,jj,jk,jpchd) = phyto2d_balinc(ji,jj,jk,jpphd) * zrat_chd_phd 
     372                     phyto_balinc(ji,jj,jk,jpphn) = outincs_3d(ji,jj,jk,i_tracer(2)) * zfrac_phn 
     373                     phyto_balinc(ji,jj,jk,jpphd) = outincs_3d(ji,jj,jk,i_tracer(2)) * zfrac_phd 
     374                     phyto_balinc(ji,jj,jk,jppds) = phyto_balinc(ji,jj,jk,jpphd) * zrat_pds_phd 
     375                     phyto_balinc(ji,jj,jk,jpchn) = phyto_balinc(ji,jj,jk,jpphn) * zrat_chn_phn 
     376                     phyto_balinc(ji,jj,jk,jpchd) = phyto_balinc(ji,jj,jk,jpphd) * zrat_chd_phd 
    325377                  ENDIF 
    326378 
     
    331383                     zfrac_zme = tracer_bkg(ji,jj,jk,jpzme) / & 
    332384                        &        (tracer_bkg(ji,jj,jk,jpzmi) + tracer_bkg(ji,jj,jk,jpzme)) 
    333                      phyto2d_balinc(ji,jj,jk,jpzmi) = outincs(ji,jj,jk,i_tracer(3)) * zfrac_zmi 
    334                      phyto2d_balinc(ji,jj,jk,jpzme) = outincs(ji,jj,jk,i_tracer(3)) * zfrac_zme 
     385                     phyto_balinc(ji,jj,jk,jpzmi) = outincs_3d(ji,jj,jk,i_tracer(3)) * zfrac_zmi 
     386                     phyto_balinc(ji,jj,jk,jpzme) = outincs_3d(ji,jj,jk,i_tracer(3)) * zfrac_zme 
    335387                  ENDIF 
    336388 
    337389                  ! Nitrogen nutrient straight from balancing scheme 
    338                   phyto2d_balinc(ji,jj,jk,jpdin) = outincs(ji,jj,jk,i_tracer(1)) 
     390                  phyto_balinc(ji,jj,jk,jpdin) = outincs_3d(ji,jj,jk,i_tracer(1)) 
    339391 
    340392                  ! Nitrogen detritus straight from balancing scheme 
    341                   phyto2d_balinc(ji,jj,jk,jpdet) = outincs(ji,jj,jk,i_tracer(4)) 
     393                  phyto_balinc(ji,jj,jk,jpdet) = outincs_3d(ji,jj,jk,i_tracer(4)) 
    342394 
    343395                  ! DIC straight from balancing scheme 
    344                   phyto2d_balinc(ji,jj,jk,jpdic) = outincs(ji,jj,jk,i_tracer(5)) 
     396                  phyto_balinc(ji,jj,jk,jpdic) = outincs_3d(ji,jj,jk,i_tracer(5)) 
    345397 
    346398                  ! Alkalinity straight from balancing scheme 
    347                   phyto2d_balinc(ji,jj,jk,jpalk) = outincs(ji,jj,jk,i_tracer(6)) 
     399                  phyto_balinc(ji,jj,jk,jpalk) = outincs_3d(ji,jj,jk,i_tracer(6)) 
    348400 
    349401                  ! Remove diatom silicate increment from nutrient silicate to conserve mass 
    350                   IF ( ( tracer_bkg(ji,jj,jk,jpsil) - phyto2d_balinc(ji,jj,jk,jppds) ) > 0.0 ) THEN 
    351                      phyto2d_balinc(ji,jj,jk,jpsil) = phyto2d_balinc(ji,jj,jk,jppds) * (-1.0) 
     402                  IF ( ( tracer_bkg(ji,jj,jk,jpsil) - phyto_balinc(ji,jj,jk,jppds) ) > 0.0 ) THEN 
     403                     phyto_balinc(ji,jj,jk,jpsil) = phyto_balinc(ji,jj,jk,jppds) * (-1.0) 
    352404                  ENDIF 
    353405 
     
    355407                  IF ( ( tracer_bkg(ji,jj,jk,jpdet) > 0.0 ) .AND. ( tracer_bkg(ji,jj,jk,jpdtc) > 0.0 ) ) THEN 
    356408                     zrat_dtc_det = tracer_bkg(ji,jj,jk,jpdtc) / tracer_bkg(ji,jj,jk,jpdet) 
    357                      phyto2d_balinc(ji,jj,jk,jpdtc) = phyto2d_balinc(ji,jj,jk,jpdet) * zrat_dtc_det 
     409                     phyto_balinc(ji,jj,jk,jpdtc) = phyto_balinc(ji,jj,jk,jpdet) * zrat_dtc_det 
    358410                  ENDIF 
    359411 
    360412                  ! Do nothing with iron or oxygen for the time being 
    361                   phyto2d_balinc(ji,jj,jk,jpfer) = 0.0 
    362                   phyto2d_balinc(ji,jj,jk,jpoxy) = 0.0 
     413                  phyto_balinc(ji,jj,jk,jpfer) = 0.0 
     414                  phyto_balinc(ji,jj,jk,jpoxy) = 0.0 
    363415                   
    364416               END DO 
     
    369421       
    370422         ! Initialise individual chlorophyll increments to zero 
    371          phyto2d_balinc(:,:,:,jpchn) = 0.0 
    372          phyto2d_balinc(:,:,:,jpchd) = 0.0 
     423         phyto_balinc(:,:,:,jpchn) = 0.0 
     424         phyto_balinc(:,:,:,jpchd) = 0.0 
    373425          
    374426         ! Split up total surface chlorophyll increments 
    375          DO jj = 1, jpj 
    376             DO ji = 1, jpi 
    377                IF ( ( tracer_bkg(ji,jj,1,jpchn) > 0.0 ) .AND. & 
    378                   & ( tracer_bkg(ji,jj,1,jpchd) > 0.0 ) ) THEN 
    379                   IF ( ld_chltot ) THEN 
    380                      ! Chlorophyll split up based on existing ratios 
    381                      zfrac_chn = tracer_bkg(ji,jj,1,jpchn) / & 
    382                         &        ( tracer_bkg(ji,jj,1,jpchn) + tracer_bkg(ji,jj,1,jpchd) ) 
    383                      zfrac_chd = tracer_bkg(ji,jj,1,jpchd) / & 
    384                         &        ( tracer_bkg(ji,jj,1,jpchn) + tracer_bkg(ji,jj,1,jpchd) ) 
    385                      phyto2d_balinc(ji,jj,1,jpchn) = pinc_chltot(ji,jj) * zfrac_chn 
    386                      phyto2d_balinc(ji,jj,1,jpchd) = pinc_chltot(ji,jj) * zfrac_chd 
    387                   ENDIF 
    388                   IF( ld_chldia ) THEN 
    389                      phyto2d_balinc(ji,jj,1,jpchd) = pinc_chldia(ji,jj) 
    390                   ENDIF 
    391                   IF( ld_chlnon ) THEN 
    392                      phyto2d_balinc(ji,jj,1,jpchn) = pinc_chlnon(ji,jj) 
    393                   ENDIF 
    394                    
    395                   ! Maintain stoichiometric ratios of nitrogen and silicate 
    396                   IF ( ld_chltot .OR. ld_chlnon ) THEN 
    397                      zrat_phn_chn = tracer_bkg(ji,jj,1,jpphn) / tracer_bkg(ji,jj,1,jpchn) 
    398                      phyto2d_balinc(ji,jj,1,jpphn) = phyto2d_balinc(ji,jj,1,jpchn) * zrat_phn_chn 
    399                   ENDIF 
    400                   IF ( ld_chltot .OR. ld_chldia ) THEN 
    401                      zrat_phd_chd = tracer_bkg(ji,jj,1,jpphd) / tracer_bkg(ji,jj,1,jpchd) 
    402                      phyto2d_balinc(ji,jj,1,jpphd) = phyto2d_balinc(ji,jj,1,jpchd) * zrat_phd_chd 
    403                      zrat_pds_chd = tracer_bkg(ji,jj,1,jppds) / tracer_bkg(ji,jj,1,jpchd) 
    404                      phyto2d_balinc(ji,jj,1,jppds) = phyto2d_balinc(ji,jj,1,jpchd) * zrat_pds_chd 
    405                   ENDIF 
    406                ENDIF 
     427         DO jk = 1, kdeps 
     428            DO jj = 1, jpj 
     429               DO ji = 1, jpi 
     430                  IF ( ( tracer_bkg(ji,jj,jk,jpchn) > 0.0 ) .AND. & 
     431                     & ( tracer_bkg(ji,jj,jk,jpchd) > 0.0 ) ) THEN 
     432                     IF ( ld_chltot ) THEN 
     433                        ! Chlorophyll split up based on existing ratios 
     434                        zfrac_chn = tracer_bkg(ji,jj,jk,jpchn) / & 
     435                           &        ( tracer_bkg(ji,jj,jk,jpchn) + tracer_bkg(ji,jj,jk,jpchd) ) 
     436                        zfrac_chd = tracer_bkg(ji,jj,jk,jpchd) / & 
     437                           &        ( tracer_bkg(ji,jj,jk,jpchn) + tracer_bkg(ji,jj,jk,jpchd) ) 
     438                        phyto_balinc(ji,jj,jk,jpchn) = pinc_chltot_3d(ji,jj,jk) * zfrac_chn 
     439                        phyto_balinc(ji,jj,jk,jpchd) = pinc_chltot_3d(ji,jj,jk) * zfrac_chd 
     440                     ENDIF 
     441                     IF( ld_chldia ) THEN 
     442                        phyto_balinc(ji,jj,jk,jpchd) = pinc_chldia_3d(ji,jj,jk) 
     443                     ENDIF 
     444                     IF( ld_chlnon ) THEN 
     445                        phyto_balinc(ji,jj,jk,jpchn) = pinc_chlnon_3d(ji,jj,jk) 
     446                     ENDIF 
     447 
     448                     ! Maintain stoichiometric ratios of nitrogen and silicate 
     449                     IF ( ld_chltot .OR. ld_chlnon ) THEN 
     450                        zrat_phn_chn = tracer_bkg(ji,jj,jk,jpphn) / tracer_bkg(ji,jj,jk,jpchn) 
     451                        phyto_balinc(ji,jj,jk,jpphn) = phyto_balinc(ji,jj,jk,jpchn) * zrat_phn_chn 
     452                     ENDIF 
     453                     IF ( ld_chltot .OR. ld_chldia ) THEN 
     454                        zrat_phd_chd = tracer_bkg(ji,jj,jk,jpphd) / tracer_bkg(ji,jj,jk,jpchd) 
     455                        phyto_balinc(ji,jj,jk,jpphd) = phyto_balinc(ji,jj,jk,jpchd) * zrat_phd_chd 
     456                        zrat_pds_chd = tracer_bkg(ji,jj,jk,jppds) / tracer_bkg(ji,jj,jk,jpchd) 
     457                        phyto_balinc(ji,jj,jk,jppds) = phyto_balinc(ji,jj,jk,jpchd) * zrat_pds_chd 
     458                     ENDIF 
     459                  ENDIF 
     460               END DO 
    407461            END DO 
    408462         END DO 
    409463          
    410          ! Propagate through mixed layer 
    411          DO jj = 1, jpj 
    412             DO ji = 1, jpi 
    413                ! 
    414                jkmax = jpk-1 
    415                DO jk = jpk-1, 1, -1 
    416                   IF ( ( pmld(ji,jj) >  gdepw_n(ji,jj,jk)   ) .AND. & 
    417                      & ( pmld(ji,jj) <= gdepw_n(ji,jj,jk+1) ) ) THEN 
    418                      pmld(ji,jj) = gdepw_n(ji,jj,jk+1) 
    419                      jkmax = jk 
    420                   ENDIF 
     464         IF (kdeps == 1) THEN 
     465            ! Propagate through mixed layer 
     466            DO jj = 1, jpj 
     467               DO ji = 1, jpi 
     468                  ! 
     469                  jkmax = jpk-1 
     470                  DO jk = jpk-1, 1, -1 
     471                     IF ( ( pmld(ji,jj) >  gdepw_n(ji,jj,jk)   ) .AND. & 
     472                        & ( pmld(ji,jj) <= gdepw_n(ji,jj,jk+1) ) ) THEN 
     473                        pmld(ji,jj) = gdepw_n(ji,jj,jk+1) 
     474                        jkmax = jk 
     475                     ENDIF 
     476                  END DO 
     477                  ! 
     478                  DO jk = 2, jkmax 
     479                     phyto_balinc(ji,jj,jk,jpchn) = phyto_balinc(ji,jj,1,jpchn) 
     480                     phyto_balinc(ji,jj,jk,jpchd) = phyto_balinc(ji,jj,1,jpchd) 
     481                     phyto_balinc(ji,jj,jk,jpphn) = phyto_balinc(ji,jj,1,jpphn) 
     482                     phyto_balinc(ji,jj,jk,jpphd) = phyto_balinc(ji,jj,1,jpphd) 
     483                     phyto_balinc(ji,jj,jk,jppds) = phyto_balinc(ji,jj,1,jppds) 
     484                  END DO 
     485                  ! 
    421486               END DO 
    422                ! 
    423                DO jk = 2, jkmax 
    424                   phyto2d_balinc(ji,jj,jk,jpchn) = phyto2d_balinc(ji,jj,1,jpchn) 
    425                   phyto2d_balinc(ji,jj,jk,jpchd) = phyto2d_balinc(ji,jj,1,jpchd) 
    426                   phyto2d_balinc(ji,jj,jk,jpphn) = phyto2d_balinc(ji,jj,1,jpphn) 
    427                   phyto2d_balinc(ji,jj,jk,jpphd) = phyto2d_balinc(ji,jj,1,jpphd) 
    428                   phyto2d_balinc(ji,jj,jk,jppds) = phyto2d_balinc(ji,jj,1,jppds) 
    429                END DO 
    430                ! 
    431             END DO 
    432          END DO 
     487            END DO 
     488         ENDIF 
    433489 
    434490         ! Set other balancing increments to zero 
    435          phyto2d_balinc(:,:,:,jpzmi) = 0.0 
    436          phyto2d_balinc(:,:,:,jpzme) = 0.0 
    437          phyto2d_balinc(:,:,:,jpdin) = 0.0 
    438          phyto2d_balinc(:,:,:,jpsil) = 0.0 
    439          phyto2d_balinc(:,:,:,jpfer) = 0.0 
    440          phyto2d_balinc(:,:,:,jpdet) = 0.0 
    441          phyto2d_balinc(:,:,:,jpdtc) = 0.0 
    442          phyto2d_balinc(:,:,:,jpdic) = 0.0 
    443          phyto2d_balinc(:,:,:,jpalk) = 0.0 
    444          phyto2d_balinc(:,:,:,jpoxy) = 0.0 
     491         phyto_balinc(:,:,:,jpzmi) = 0.0 
     492         phyto_balinc(:,:,:,jpzme) = 0.0 
     493         phyto_balinc(:,:,:,jpdin) = 0.0 
     494         phyto_balinc(:,:,:,jpsil) = 0.0 
     495         phyto_balinc(:,:,:,jpfer) = 0.0 
     496         phyto_balinc(:,:,:,jpdet) = 0.0 
     497         phyto_balinc(:,:,:,jpdtc) = 0.0 
     498         phyto_balinc(:,:,:,jpdic) = 0.0 
     499         phyto_balinc(:,:,:,jpalk) = 0.0 
     500         phyto_balinc(:,:,:,jpoxy) = 0.0 
    445501 
    446502      ENDIF 
     
    452508         DO jn = 1, jptra 
    453509            DO jk = 1, jpk 
    454                phyto2d_balinc(:,:,jk,jn) = phyto2d_balinc(:,:,jk,jn) * ( 1.0 - mask_itf(:,:) ) 
     510               phyto_balinc(:,:,jk,jn) = phyto_balinc(:,:,jk,jn) * ( 1.0 - mask_itf(:,:) ) 
    455511            END DO 
    456512         END DO 
    457513      ENDIF 
    458514 
    459    END SUBROUTINE asm_phyto2d_bal_medusa 
     515   END SUBROUTINE asm_phyto_bal_medusa 
    460516 
    461517#else 
     
    464520   !!---------------------------------------------------------------------- 
    465521CONTAINS 
    466    SUBROUTINE asm_phyto2d_bal_medusa( ld_chltot,                      & 
    467       &                              pinc_chltot,                    & 
    468       &                              ld_chldia,                      & 
    469       &                              pinc_chldia,                    & 
    470       &                              ld_chlnon,                      & 
    471       &                              pinc_chlnon,                    & 
    472       &                              ld_phytot,                      & 
    473       &                              pinc_phytot,                    & 
    474       &                              ld_phydia,                      & 
    475       &                              pinc_phydia,                    & 
    476       &                              ld_phynon,                      & 
    477       &                              pinc_phynon,                    & 
    478       &                              pincper,                        & 
    479       &                              p_maxchlinc, ld_phytobal, pmld, & 
    480       &                              pgrow_avg_bkg, ploss_avg_bkg,   & 
    481       &                              phyt_avg_bkg, mld_max_bkg,      & 
    482       &                              tracer_bkg, phyto2d_balinc ) 
     522   SUBROUTINE asm_phyto_bal_medusa( kdeps,                          & 
     523      &                             ld_chltot,                      & 
     524      &                             pinc_chltot_3d,                    & 
     525      &                             ld_chldia,                      & 
     526      &                             pinc_chldia_3d,                    & 
     527      &                             ld_chlnon,                      & 
     528      &                             pinc_chlnon_3d,                    & 
     529      &                             ld_phytot,                      & 
     530      &                             pinc_phytot_3d,                    & 
     531      &                             ld_phydia,                      & 
     532      &                             pinc_phydia_3d,                    & 
     533      &                             ld_phynon,                      & 
     534      &                             pinc_phynon_3d,                    & 
     535      &                             pincper,                        & 
     536      &                             p_maxchlinc, ld_phytobal, pmld, & 
     537      &                             pgrow_avg_bkg_3d, ploss_avg_bkg_3d,   & 
     538      &                             phyt_avg_bkg_3d, mld_max_bkg,      & 
     539      &                             tracer_bkg, phyto_balinc ) 
     540      INTEGER :: kdeps 
    483541      LOGICAL :: ld_chltot 
    484       REAL    :: pinc_chltot(:,:) 
     542      REAL    :: pinc_chltot_3d(:,:,:) 
    485543      LOGICAL :: ld_chldia 
    486       REAL    :: pinc_chldia(:,:) 
     544      REAL    :: pinc_chldia_3d(:,:,:) 
    487545      LOGICAL :: ld_chlnon 
    488       REAL    :: pinc_chlnon(:,:) 
     546      REAL    :: pinc_chlnon_3d(:,:,:) 
    489547      LOGICAL :: ld_phytot 
    490       REAL    :: pinc_phytot(:,:) 
     548      REAL    :: pinc_phytot_3d(:,:,:) 
    491549      LOGICAL :: ld_phydia 
    492       REAL    :: pinc_phydia(:,:) 
     550      REAL    :: pinc_phydia_3d(:,:,:) 
    493551      LOGICAL :: ld_phynon 
    494       REAL    :: pinc_phynon(:,:) 
     552      REAL    :: pinc_phynon_3d(:,:,:) 
    495553      REAL    :: pincper 
    496554      REAL    :: p_maxchlinc 
    497555      LOGICAL :: ld_phytobal 
    498556      REAL    :: pmld(:,:) 
    499       REAL    :: pgrow_avg_bkg(:,:) 
    500       REAL    :: ploss_avg_bkg(:,:) 
    501       REAL    :: phyt_avg_bkg(:,:) 
     557      REAL    :: pgrow_avg_bkg_3d(:,:,:) 
     558      REAL    :: ploss_avg_bkg_3d(:,:,:) 
     559      REAL    :: phyt_avg_bkg_3d(:,:,:) 
    502560      REAL    :: mld_max_bkg(:,:) 
    503561      REAL    :: tracer_bkg(:,:,:,:) 
    504       REAL    :: phyto2d_balinc(:,:,:,:) 
    505       WRITE(*,*) 'asm_phyto2d_bal_medusa: You should not have seen this print! error?' 
    506    END SUBROUTINE asm_phyto2d_bal_medusa 
     562      REAL    :: phyto_balinc(:,:,:,:) 
     563      WRITE(*,*) 'asm_phyto_bal_medusa: You should not have seen this print! error?' 
     564   END SUBROUTINE asm_phyto_bal_medusa 
    507565#endif 
    508566 
    509567   !!====================================================================== 
    510 END MODULE asmphyto2dbal_medusa 
     568END MODULE asmphytobal_medusa 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14_phytobal3d/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_init.F90

    r10302 r13097  
    3535      USE bio_medusa_mod 
    3636      USE par_oce,           ONLY: jpi, jpj, jpk 
    37       USE sms_medusa,        ONLY: jdms, pgrow_avg, ploss_avg, phyt_avg, mld_max 
     37      USE sms_medusa,        ONLY: jdms, pgrow_avg, ploss_avg, phyt_avg, mld_max, & 
     38         &                         pgrow_avg_3d, ploss_avg_3d, phyt_avg_3d 
    3839      USE trc,               ONLY: ln_diatrc, med_diag, nittrc000  
    3940      USE in_out_manager,    ONLY: lwp, numout 
     
    199200      ploss_avg(:,:) = 0.0 
    200201      phyt_avg(:,:)  = 0.0 
     202      pgrow_avg_3d(:,:,:) = 0.0 
     203      ploss_avg_3d(:,:,:) = 0.0 
     204      phyt_avg_3d(:,:,:)  = 0.0 
    201205      IF( kt == nittrc000 ) THEN 
    202206         mld_max(:,:) = 0.0 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14_phytobal3d/NEMOGCM/NEMO/TOP_SRC/MEDUSA/plankton.F90

    r10302 r13097  
    4646                                   ln_foam_medusa,                         & 
    4747                                   pgrow_avg, ploss_avg, phyt_avg,         & 
     48                                   pgrow_avg_3d, ploss_avg_3d, phyt_avg_3d, & 
    4849                                   xkphd, xkphn, xkzme, xkzmi,             & 
    4950                                   xmetapd, xmetapn, xmetazme, xmetazmi,   & 
     
    229230                                     ((zphn(ji,jj) + zphd(ji,jj)) *       & 
    230231                                      fse3t(ji,jj,jk) * fq0) 
     232                  !! 
     233                  pgrow_avg_3d(ji,jj,jk) = (fprn(ji,jj) * zphn(ji,jj)) +  & 
     234                                           (fprd(ji,jj) * zphd(ji,jj)) 
     235                  ploss_avg_3d(ji,jj,jk) = fgmepd(ji,jj) + fdpd(ji,jj) +  & 
     236                                           fdpd2(ji,jj)                +  & 
     237                                           fgmepn(ji,jj) + fdpn(ji,jj) +  & 
     238                                           fdpn2(ji,jj)  + fgmipn(ji,jj) 
     239                  phyt_avg_3d(ji,jj,jk)  = zphn(ji,jj) + zphd(ji,jj) 
    231240               ENDIF 
    232241            ENDDO 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14_phytobal3d/NEMOGCM/NEMO/TOP_SRC/MEDUSA/sms_medusa.F90

    r10302 r13097  
    362362   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ploss_avg  !: Mixed layer average phytoplankton loss 
    363363   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: phyt_avg   !: Mixed layer average phytoplankton 
     364   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: pgrow_avg_3d  !: Mixed layer average phytoplankton growth 
     365   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ploss_avg_3d  !: Mixed layer average phytoplankton loss 
     366   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: phyt_avg_3d   !: Mixed layer average phytoplankton 
    364367   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: mld_max    !: Maximum mixed layer depth 
    365368!! 
     
    438441      !* Fields for ocean colour data assimilation 
    439442      ALLOCATE( pgrow_avg(jpi,jpj)   , ploss_avg(jpi,jpj)   ,       & 
     443         &      pgrow_avg_3d(jpi,jpj,jpk) , ploss_avg_3d(jpi,jpj,jpk) , & 
     444         &      phyt_avg_3d(jpi,jpj,jpk)  ,                         & 
    440445         &      phyt_avg(jpi,jpj)    , mld_max(jpi,jpj)     ,    STAT=ierr(9) ) 
    441446#endif 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14_phytobal3d/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r10302 r13097  
    368368            mld_max(:,:)   = 0.0 
    369369         ENDIF 
     370         IF( iom_varid( numrtr, 'pgrow_avg_3d', ldstop = .FALSE. ) > 0 ) THEN 
     371            IF(lwp) WRITE(numout,*) ' MEDUSA pgrow_avg present - reading in ...' 
     372            CALL iom_get( numrtr, jpdom_autoglo, 'pgrow_avg_3d',  pgrow_avg_3d(:,:,:)  ) 
     373            CALL iom_get( numrtr, jpdom_autoglo, 'ploss_avg_3d',  ploss_avg_3d(:,:,:)  ) 
     374            CALL iom_get( numrtr, jpdom_autoglo, 'phyt_avg_3d',   phyt_avg_3d(:,:,:)   ) 
     375         ELSE 
     376            IF(lwp) WRITE(numout,*) ' MEDUSA pgrow_avg_3d absent - setting to zero ...' 
     377            pgrow_avg_3d(:,:,:) = 0.0 
     378            ploss_avg_3d(:,:,:) = 0.0 
     379            phyt_avg_3d(:,:,:)  = 0.0 
     380         ENDIF 
    370381      ENDIF 
    371382 
     
    553564         CALL iom_rstput( kt, nitrst, numrtw, 'phyt_avg',  phyt_avg(:,:)  ) 
    554565         CALL iom_rstput( kt, nitrst, numrtw, 'mld_max',   mld_max(:,:)   ) 
     566         CALL iom_rstput( kt, nitrst, numrtw, 'pgrow_avg_3d', pgrow_avg_3d(:,:,:) ) 
     567         CALL iom_rstput( kt, nitrst, numrtw, 'ploss_avg_3d', ploss_avg_3d(:,:,:) ) 
     568         CALL iom_rstput( kt, nitrst, numrtw, 'phyt_avg_3d',  phyt_avg_3d(:,:,:)  ) 
    555569      ENDIF 
    556570!! 
Note: See TracChangeset for help on using the changeset viewer.