Ignore:
Timestamp:
2018-09-24T11:47:08+02:00 (2 years ago)
Author:
frrh
Message:

Met Office GMED ticket 379: Merged David Ford's MEDUSA assimilation changes
using command:

svn merge -r 10054:10141 svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/UKMO/dev_r5518_GO6_package_asm_3d_bgc_v3

Location:
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC
Files:
10 edited

Legend:

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

    r10020 r10149  
    7474                                   jriver_alk, jriver_c,                  & 
    7575                                   jriver_n, jriver_si,                   & 
     76                                   ln_foam_medusa,                        & 
    7677                                   riv_alk, riv_c, riv_n, riv_si,         & 
    7778                                   zn_dms_chd, zn_dms_chn, zn_dms_din,    & 
    7879                                   zn_dms_mld, zn_dms_qsr,                & 
     80                                   f2_pco2w, f2_fco2w,                    & 
    7981                                   xnln, xnld  
    8082      USE trc,               ONLY: med_diag 
     
    8789#  else 
    8890      USE trcco2_medusa,     ONLY: trc_co2_medusa 
     91      USE mocsy_mainmod,     ONLY: p2fCO2 
    8992#  endif 
    9093      USE trcdms_medusa,     ONLY: trc_dms_medusa 
     
    327330                     iters, ' AT (', ji, ', ', jj, ', 1) AT ', kt 
    328331               endif 
     332               IF ( ln_foam_medusa ) THEN 
     333                  !! DAF (Aug 2017): calculate fCO2 for observation operator 
     334                  CALL p2fCO2( f_pco2w, ztmp, f_pp0, 0.0, 1, f_fco2w ) 
     335               ENDIF 
    329336            ENDIF 
    330337         ENDDO 
     
    506513                              CO2flux_conv 
    507514               !! ENDIF 
     515               IF ( ln_foam_medusa ) THEN 
     516                  !! DAF (Aug 2017): Save pCO2 and fCO2 for observation operator 
     517                  f2_pco2w(ji,jj) = f_pco2w(ji,jj) 
     518                  f2_fco2w(ji,jj) = f_pco2w(ji,jj) 
     519               ENDIF 
    508520               IF ( lk_iomput ) THEN 
    509521                  IF( med_diag%ATM_PCO2%dgsave ) THEN 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_fin.F90

    r10020 r10149  
    4646                                   f3_co3, f3_h2co3, f3_hco3,           & 
    4747                                   f3_omarg, f3_omcal, f3_pH,           & 
     48                                   ln_foam_medusa, mld_max, pgrow_avg,  & 
     49                                   ploss_avg, phyt_avg,                 & 
    4850                                   za_sed_c, za_sed_ca, za_sed_fe,      & 
    4951                                   za_sed_n, za_sed_si,                 & 
     
    5557      USE trc,               ONLY: med_diag, nittrc000, trn  
    5658      USE trcnam_trp,        ONLY: ln_trcadv_cen2, ln_trcadv_tvd 
     59      USE zdfmxl,            ONLY: hmld 
    5760  
    5861      !! time (integer timestep) 
     
    113116# endif       
    114117 
     118      IF ( ln_foam_medusa ) THEN 
     119         !!---------------------------------------------------------------------- 
     120         !! Diagnostics required for ocean colour assimilation: 
     121         !! Mixed layer average phytoplankton growth, loss and concentration 
     122         !! Maximum mixed layer depth 
     123         !!---------------------------------------------------------------------- 
     124         !! 
     125         DO jj = 2,jpjm1 
     126            DO ji = 2,jpim1 
     127               IF ( hmld(ji,jj) .GT. 0.0 ) THEN 
     128                  pgrow_avg(ji,jj) = pgrow_avg(ji,jj) / hmld(ji,jj) 
     129                  ploss_avg(ji,jj) = ploss_avg(ji,jj) / hmld(ji,jj) 
     130                  phyt_avg(ji,jj)  = phyt_avg(ji,jj)  / hmld(ji,jj) 
     131                  IF ( hmld(ji,jj) .GT. mld_max(ji,jj) ) THEN 
     132                     mld_max(ji,jj) = hmld(ji,jj) 
     133                  ENDIF 
     134               ENDIF 
     135            END DO 
     136         END DO 
     137      ENDIF 
     138 
    115139#  if defined key_debug_medusa 
    116140         !! AXY (12/07/17) 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_init.F90

    r10020 r10149  
    3535      USE bio_medusa_mod 
    3636      USE par_oce,           ONLY: jpi, jpj, jpk 
    37       USE sms_medusa,        ONLY: jdms 
     37      USE sms_medusa,        ONLY: jdms, pgrow_avg, ploss_avg, phyt_avg, mld_max 
    3838      USE trc,               ONLY: ln_diatrc, med_diag, nittrc000  
    3939      USE in_out_manager,    ONLY: lwp, numout 
     
    195195      fslowsinkc(:,:) = 0.0 
    196196# endif       
     197      !! 
     198      pgrow_avg(:,:) = 0.0 
     199      ploss_avg(:,:) = 0.0 
     200      phyt_avg(:,:)  = 0.0 
     201      IF( kt == nittrc000 ) THEN 
     202         mld_max(:,:) = 0.0 
     203      ENDIF 
    197204      !! 
    198205      !! allocate and initiate 2D diag 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/MEDUSA/plankton.F90

    r8441 r10149  
    3636                                   fdpn, fdpn2, fdzme, fdzme2,             & 
    3737                                   fdzmi, fdzmi2, fsdiss, fsin,            & 
     38                                   fdep1, fprn, fprd,                      & 
     39                                   fgmepd, fgmepn, fgmipn,                 & 
    3840                                   zphd, zphn, zpds, zzme, zzmi 
    39       USE dom_oce,           ONLY: tmask 
     41      USE dom_oce,           ONLY: e3t_0, e3t_n, gdepw_0, gdepw_n, tmask 
     42      USE par_kind,          ONLY: wp 
    4043      USE par_oce,           ONLY: jpim1, jpjm1 
    4144      USE phytoplankton_mod, ONLY: phytoplankton 
    4245      USE sms_medusa,        ONLY: jmpd, jmpn, jmzme, jmzmi,               & 
     46                                   ln_foam_medusa,                         & 
     47                                   pgrow_avg, ploss_avg, phyt_avg,         & 
    4348                                   xkphd, xkphn, xkzme, xkzmi,             & 
    4449                                   xmetapd, xmetapn, xmetazme, xmetazmi,   & 
    4550                                   xmpd, xmpn, xmzme, xmzmi, xsdiss 
     51      USE zdfmxl,            ONLY: hmld 
    4652      USE zooplankton_mod,   ONLY: zooplankton 
     53 
     54   !!* Substitution 
     55#  include "domzgr_substitute.h90" 
    4756 
    4857      !! Level 
     
    5059 
    5160      INTEGER :: ji, jj 
     61 
     62      REAL(wp) :: fq0 
    5263 
    5364      !!------------------------------------------------------------------- 
     
    188199      ENDDO 
    189200 
     201      IF ( ln_foam_medusa ) THEN 
     202         !! Mixed layer averages for ocean colour assimilation 
     203         !! 
     204         DO jj = 2,jpjm1 
     205            DO ji = 2,jpim1 
     206               IF (tmask(ji,jj,jk) == 1) THEN 
     207                  if (fdep1(ji,jj).le.hmld(ji,jj)) then 
     208                     !! this level is entirely in the mixed layer 
     209                     fq0 = 1.0 
     210                  elseif (fsdepw(ji,jj,jk).ge.hmld(ji,jj)) then 
     211                     !! this level is entirely below the mixed layer 
     212                     fq0 = 0.0 
     213                  else 
     214                     !! this level straddles the mixed layer 
     215                     fq0 = (hmld(ji,jj) - fsdepw(ji,jj,jk)) / fse3t(ji,jj,jk) 
     216                  endif 
     217                  !! 
     218                  pgrow_avg(ji,jj) = pgrow_avg(ji,jj) +                   & 
     219                                     (((fprn(ji,jj) * zphn(ji,jj)) +      & 
     220                                       (fprd(ji,jj) * zphd(ji,jj))  ) *   & 
     221                                      fse3t(ji,jj,jk) * fq0) 
     222                  ploss_avg(ji,jj) = ploss_avg(ji,jj) +                   & 
     223                                     ((fgmepd(ji,jj) + fdpd(ji,jj) +      & 
     224                                       fdpd2(ji,jj)                +      & 
     225                                       fgmepn(ji,jj) + fdpn(ji,jj) +      & 
     226                                       fdpn2(ji,jj)  + fgmipn(ji,jj) ) *  & 
     227                                      fse3t(ji,jj,jk) * fq0) 
     228                  phyt_avg(ji,jj)  = phyt_avg(ji,jj)  +                   & 
     229                                     ((zphn(ji,jj) + zphd(ji,jj)) *       & 
     230                                      fse3t(ji,jj,jk) * fq0) 
     231               ENDIF 
     232            ENDDO 
     233         ENDDO 
     234      ENDIF 
     235 
    190236   END SUBROUTINE plankton 
    191237 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/MEDUSA/sms_medusa.F90

    r9385 r10149  
    212212   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: f2_ccd_arg  !: 2D aragonite CCD depth 
    213213!! 
     214!! 2D fields of pCO2 and fCO2 for observation operator 
     215   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: f2_pco2w    !: 2D pCO2 
     216   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: f2_fco2w    !: 2D fCO2 
     217!! 
    214218!! 2D fields of organic and inorganic material sedimented on the seafloor 
    215219   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zb_sed_n    !: 2D organic nitrogen   (before) 
     
    289293   INTEGER  :: co2_rec 
    290294   REAL(wp) :: co2_yinit, co2_yend    !: First and Last year read in the xCO2.atm file 
     295   REAL(wp) :: xobs_xco2a             !: Observed atmospheric xCO2, from namelist 
    291296#endif 
    292297 
     
    349354   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: cmask       !: ??? 
    350355 
     356!!---------------------------------------------------------------------- 
     357!! Parameters required for ocean colour assimilation 
     358!!---------------------------------------------------------------------- 
     359!! 
     360   LOGICAL :: ln_foam_medusa                                 !: Flag to calculate and save diagnostics 
     361   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: pgrow_avg  !: Mixed layer average phytoplankton growth 
     362   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ploss_avg  !: Mixed layer average phytoplankton loss 
     363   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: phyt_avg   !: Mixed layer average phytoplankton 
     364   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: mld_max    !: Maximum mixed layer depth 
     365!! 
     366 
    351367   !!---------------------------------------------------------------------- 
    352368   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     
    361377      !!---------------------------------------------------------------------- 
    362378      USE lib_mpp , ONLY: ctl_warn 
    363       INTEGER ::   ierr(8)        ! Local variables 
     379      INTEGER ::   ierr(9)        ! Local variables 
    364380      !!---------------------------------------------------------------------- 
    365381      ierr(:) = 0 
     
    371387      !* 2D and 3D fields of carbonate system parameters 
    372388      ALLOCATE( f2_ccd_cal(jpi,jpj)  , f2_ccd_arg(jpi,jpj)  ,       & 
     389                f2_pco2w(jpi,jpj)    , f2_fco2w(jpi,jpj)    ,       & 
    373390         &      f3_pH(jpi,jpj,jpk)   , f3_h2co3(jpi,jpj,jpk),       & 
    374391         &      f3_hco3(jpi,jpj,jpk) , f3_co3(jpi,jpj,jpk)  ,       & 
     
    419436         &      ffln(jpi,jpj,jpk)    , fflf(jpi,jpj,jpk)    ,       & 
    420437         &      ffls(jpi,jpj,jpk)    , cmask(jpi,jpj)       ,    STAT=ierr(8) )  
     438      !* Fields for ocean colour data assimilation 
     439      ALLOCATE( pgrow_avg(jpi,jpj)   , ploss_avg(jpi,jpj)   ,       & 
     440         &      phyt_avg(jpi,jpj)    , mld_max(jpi,jpj)     ,    STAT=ierr(9) ) 
    421441#endif 
    422442      ! 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcbio_medusa.F90

    r10020 r10149  
    105105      USE sbc_oce,                    ONLY: lk_oasis 
    106106      USE sms_medusa,                 ONLY: hist_pco2, co2_yinit, co2_yend, & 
    107                                             lk_pi_co2 
     107# if defined key_roam 
     108                                            xobs_xco2a,                     & 
     109# endif 
     110                                            pgrow_avg,                      & 
     111                                            ploss_avg, phyt_avg, mld_max,   & 
     112                                            lk_pi_co2, ln_foam_medusa 
    108113      USE trc,                        ONLY: ln_rsttr, nittrc000, trn 
    109114      USE bio_medusa_init_mod,        ONLY: bio_medusa_init 
     
    330335         !! f_xco2a(:,:) = 284.725       !! CMIP5 pre-industrial pCO2 
    331336         f_xco2a(:,:) = 284.317          !! CMIP6 pre-industrial pCO2  
     337      ELSEIF ( xobs_xco2a > 0.0 ) THEN 
     338         IF(lwp) WRITE(numout,*) ' using observed atm pCO2 = ', xobs_xco2a 
     339         f_xco2a(:,:) = xobs_xco2a 
    332340      ELSE       
    333341         !! xCO2 from file 
     
    418426      !! now use the NEMO calendar tool : nsec_month to be sure to call  
    419427      !! at the beginning of a new month . 
     428      !! DAF: For FOAM we want to run daily 
    420429      IF ( (kt == nittrc000 .AND. .NOT.ln_rsttr) .OR.                        & 
    421            ( nsec_month .LE. INT(rdt) ) )  THEN 
     430           ( nsec_month .LE. INT(rdt) )          .OR.                        & 
     431           ( nsec_day   .LE. INT(rdt) .AND. ln_foam_medusa ) )  THEN 
    422432           IF ( lwp )  WRITE(numout,*)                                       &          
    423433                              ' *** 3D carb chem call *** -- kt:', kt,       & 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcini_medusa.F90

    r9385 r10149  
    330330      !!---------------------------------------------------------------------- 
    331331      !!  
    332       IF( ( .NOT.lk_oasis ) .AND. ( .NOT.lk_pi_co2 ) ) THEN 
     332      IF( ( .NOT.lk_oasis ) .AND. ( .NOT.lk_pi_co2 ) .AND. ( xobs_xco2a <= 0.0 ) ) THEN 
    333333         IF(lwp) WRITE(numout,*) ' trc_ini_medusa: initialisating atm CO2 record' 
    334334         CALL trc_ini_medusa_co2atm 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcnam_medusa.F90

    r9258 r10149  
    8787      &  xsdiss,                                              & 
    8888      &  sedlam,sedlostpoc,jpkb,jdms,jdms_input,jdms_model,   & 
    89       &  scl_chl, chl_out, dmsmin, dmscut, dmsslp 
     89      &  scl_chl, chl_out, dmsmin, dmscut, dmsslp,            & 
     90      &  ln_foam_medusa 
    9091#if defined key_roam 
    9192      NAMELIST/natroam/ xthetaphy,xthetazoo,xthetanit,        & 
     93      &    xobs_xco2a,                                        & 
    9294      &    xthetarem,xo2min  
    9395#endif 
     
    255257      dmscut      = 1.72 !! Anderson DMS default 
    256258      dmsslp      = 8.24 !! Anderson DMS default 
     259!! 
     260      ln_foam_medusa = .FALSE. 
    257261             
    258262      !REWIND(numnatm) 
     
    415419!!       chl_out     : select the chl field to send at the UM: 
    416420!!                     1- Surf Chl ; 2- MLD Chl  
     421!! 
     422!! FOAM - observation operator and data assimilation 
     423!!       ln_foam_medusa : calculate required diagnostics 
    417424 
    418425      IF(lwp) THEN 
     
    975982            ENDIF 
    976983         ENDIF ! IF lk_oasis=true 
     984!! FOAM 
     985         WRITE(numout,*) '=== FOAM-related parameters' 
     986         WRITE(numout,*)     & 
     987         &   ' calculate diagnostics for data assimilation,            ln_foam_medusa = ', ln_foam_medusa 
    977988!! 
    978989      ENDIF 
     
    10301041      xthetarem = 0. 
    10311042      xo2min    = 0. 
     1043      xobs_xco2a = 0. 
    10321044 
    10331045      !READ(numnatm,natroam) 
     
    10491061!!       xthetarem :  oxygen consumption by carbon remineralisation 
    10501062!!       xo2min    :  oxygen minimum concentration 
     1063!!       xobs_xco2a : observed atmospheric xCO2 (not used if <= 0) 
    10511064 
    10521065      IF(lwp) THEN 
     
    10661079          WRITE(numout,*)     & 
    10671080          &   ' oxygen minimum concentration                               xo2min      = ', xo2min 
     1081          WRITE(numout,*)     & 
     1082          &   ' observed atmospheric xCO2 (not used if <= 0)               xobs_xco2a  = ', xobs_xco2a 
    10681083       ENDIF 
    10691084 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r9262 r10149  
    3636   USE sbc_oce 
    3737   USE trcice          ! tracers in sea ice 
     38# if defined key_medusa 
    3839   USE sms_medusa      ! MEDUSA   initialisation 
     40# endif 
    3941   IMPLICIT NONE 
    4042   PRIVATE 
     
    107109      !                                                              ! total volume of the ocean  
    108110      areatot = glob_sum( cvol(:,:,:) ) 
     111# if defined key_medusa && defined key_roam 
    109112      carea(:,:) = e1e2t(:,:) * tmask(:,:,1)  
     113# endif 
    110114 
    111115      IF( lk_pisces  )       CALL trc_ini_pisces       ! PISCES  bio-model 
  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r9975 r10149  
    4545   USE oce,     ONLY: CO2Flux_out_cpl, DMS_out_cpl, chloro_out_cpl  !! Coupling variable 
    4646   USE trcstat 
     47   USE obs_const, ONLY: obfillflt  ! Observation operator fill value 
    4748 
    4849   IMPLICIT NONE 
     
    338339         IF(lwp) WRITE(numout,*) 'Or don t start from uncomplete restart...'  
    339340      ENDIF 
     341      ! 
     342      IF ( ln_foam_medusa ) THEN 
     343         !! 2D fields of pCO2 and fCO2 for observation operator on first timestep 
     344         IF( iom_varid( numrtr, 'PCO2W', ldstop = .FALSE. ) > 0 ) THEN 
     345            IF(lwp) WRITE(numout,*) ' MEDUSA pCO2 present - reading in ...' 
     346            CALL iom_get( numrtr, jpdom_autoglo, 'PCO2W',  f2_pco2w(:,:)  ) 
     347            CALL iom_get( numrtr, jpdom_autoglo, 'FCO2W',  f2_fco2w(:,:)  ) 
     348         ELSE 
     349            IF(lwp) WRITE(numout,*) ' MEDUSA pCO2 absent - setting to fill ...' 
     350            f2_pco2w(:,:) = obfillflt * tmask(:,:,1) 
     351            f2_fco2w(:,:) = obfillflt * tmask(:,:,1) 
     352         ENDIF 
     353      ENDIF 
    340354# endif 
    341  
     355      IF ( ln_foam_medusa ) THEN 
     356         !! Fields for ocean colour assimilation on first timestep 
     357         IF( iom_varid( numrtr, 'pgrow_avg', ldstop = .FALSE. ) > 0 ) THEN 
     358            IF(lwp) WRITE(numout,*) ' MEDUSA pgrow_avg present - reading in ...' 
     359            CALL iom_get( numrtr, jpdom_autoglo, 'pgrow_avg',  pgrow_avg(:,:)  ) 
     360            CALL iom_get( numrtr, jpdom_autoglo, 'ploss_avg',  ploss_avg(:,:)  ) 
     361            CALL iom_get( numrtr, jpdom_autoglo, 'phyt_avg',   phyt_avg(:,:)   ) 
     362            CALL iom_get( numrtr, jpdom_autoglo, 'mld_max',    mld_max(:,:)    ) 
     363         ELSE 
     364            IF(lwp) WRITE(numout,*) ' MEDUSA pgrow_avg absent - setting to zero ...' 
     365            pgrow_avg(:,:) = 0.0 
     366            ploss_avg(:,:) = 0.0 
     367            phyt_avg(:,:)  = 0.0 
     368            mld_max(:,:)   = 0.0 
     369         ENDIF 
     370      ENDIF 
    342371 
    343372#endif 
     
    510539      call trc_rst_dia_stat( f2_ccd_arg(:,:),'CCD_ARG') 
    511540      !! 
     541      IF ( ln_foam_medusa ) THEN 
     542         !! Fields for observation operator on first timestep 
     543         IF(lwp) WRITE(numout,*) ' MEDUSA OBS fields - writing out ...' 
     544         CALL iom_rstput( kt, nitrst, numrtw, 'PCO2W', f2_pco2w(:,:)  ) 
     545         CALL iom_rstput( kt, nitrst, numrtw, 'FCO2W', f2_fco2w(:,:)  ) 
     546      ENDIF 
    512547# endif 
     548      IF ( ln_foam_medusa ) THEN 
     549         !! Fields for assimilation on first timestep 
     550         IF(lwp) WRITE(numout,*) ' MEDUSA ASM fields - writing out ...' 
     551         CALL iom_rstput( kt, nitrst, numrtw, 'pgrow_avg', pgrow_avg(:,:) ) 
     552         CALL iom_rstput( kt, nitrst, numrtw, 'ploss_avg', ploss_avg(:,:) ) 
     553         CALL iom_rstput( kt, nitrst, numrtw, 'phyt_avg',  phyt_avg(:,:)  ) 
     554         CALL iom_rstput( kt, nitrst, numrtw, 'mld_max',   mld_max(:,:)   ) 
     555      ENDIF 
    513556!! 
    514557#endif 
Note: See TracChangeset for help on using the changeset viewer.