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 8436 for branches/UKMO/dev_r5518_GO6_package_asm_surf_bgc/NEMOGCM/NEMO/TOP_SRC – NEMO

Ignore:
Timestamp:
2017-08-14T15:22:09+02:00 (7 years ago)
Author:
dford
Message:

Implement initial version of surface chlorophyll assimilation for MEDUSA.

Location:
branches/UKMO/dev_r5518_GO6_package_asm_surf_bgc/NEMOGCM/NEMO/TOP_SRC
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_GO6_package_asm_surf_bgc/NEMOGCM/NEMO/TOP_SRC/MEDUSA/sms_medusa.F90

    r8132 r8436  
    205205   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: f2_ccd_arg  !: 2D aragonite CCD depth 
    206206!! 
     207#if defined key_foam_medusa 
     208!! 2D fields of pCO2 and fCO2 for observation operator 
     209   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: f2_pco2w    !: 2D pCO2 
     210   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: f2_fco2w    !: 2D fCO2 
     211!! 
     212#endif 
    207213!! 2D fields of organic and inorganic material sedimented on the seafloor 
    208214   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: zb_sed_n    !: 2D organic nitrogen   (before) 
     
    434440   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: cmask       !: ??? 
    435441 
     442#if defined key_foam_medusa 
     443!!---------------------------------------------------------------------- 
     444!! Parameters required for ocean colour assimilation 
     445!!---------------------------------------------------------------------- 
     446!! 
     447   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: pgrow_avg  !: Mixed layer average phytoplankton growth 
     448   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ploss_avg  !: Mixed layer average phytoplankton loss 
     449   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: phyt_avg   !: Mixed layer average phytoplankton 
     450   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: mld_max    !: Maximum mixed layer depth 
     451!! 
     452#endif 
     453 
    436454   !!---------------------------------------------------------------------- 
    437455   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     
    446464      !!---------------------------------------------------------------------- 
    447465      USE lib_mpp , ONLY: ctl_warn 
    448       INTEGER ::   ierr(8)        ! Local variables 
     466      INTEGER ::   ierr(9)        ! Local variables 
    449467      !!---------------------------------------------------------------------- 
    450468      ierr(:) = 0 
     
    456474      !* 2D and 3D fields of carbonate system parameters 
    457475      ALLOCATE( f2_ccd_cal(jpi,jpj)  , f2_ccd_arg(jpi,jpj)  ,       & 
     476#  if defined key_foam_medusa 
     477                f2_pco2w(jpi,jpj)    , f2_fco2w(jpi,jpj)    ,       & 
     478#  endif 
    458479         &      f3_pH(jpi,jpj,jpk)   , f3_h2co3(jpi,jpj,jpk),       & 
    459480         &      f3_hco3(jpi,jpj,jpk) , f3_co3(jpi,jpj,jpk)  ,       & 
     
    504525         &      ffln(jpi,jpj,jpk)    , fflf(jpi,jpj,jpk)    ,       & 
    505526         &      ffls(jpi,jpj,jpk)    , cmask(jpi,jpj)       ,    STAT=ierr(8) )  
     527# if defined key_foam_medusa 
     528      ALLOCATE( pgrow_avg(jpi,jpj)   , ploss_avg(jpi,jpj)   ,       & 
     529         &      phyt_avg(jpi,jpj)    , mld_max(jpi,jpj)     ,    STAT=ierr(9) ) 
     530# endif 
    506531#endif 
    507532      ! 
  • branches/UKMO/dev_r5518_GO6_package_asm_surf_bgc/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcbio_medusa.F90

    r8224 r8436  
    8080#  else 
    8181      USE trcco2_medusa 
     82#  if defined key_foam_medusa 
     83      USE mocsy_mainmod 
     84#  endif 
    8285#  endif 
    8386      USE trcoxy_medusa 
     
    581584      fslownflux(:,:) = 0.0 
    582585      fslowcflux(:,:) = 0.0 
     586 
     587# if defined key_foam_medusa 
     588      pgrow_avg(:,:) = 0.0 
     589      ploss_avg(:,:) = 0.0 
     590      phyt_avg(:,:)  = 0.0 
     591      IF( kt == nittrc000 ) THEN 
     592         mld_max(:,:) = 0.0 
     593      ENDIF 
     594# endif 
    583595 
    584596      !! 
     
    13471359      !! We want this to be start of month or if starting afresh from  
    13481360      !! climatology - marc 20/6/17 
     1361#if defined key_foam_medusa 
     1362      !! DAF (Aug 2017): For FOAM we want to run daily 
     1363      If ( (kt == nittrc000 .AND. .NOT.ln_rsttr) .OR.                        & 
     1364           (mod(kt*rdt,86400.) == rdt) ) THEN 
     1365#else 
    13491366      If ( (kt == nittrc000 .AND. .NOT.ln_rsttr) .OR.                        & 
    13501367           ((86400*mod(nn_date0,100) + mod(kt*rdt,2592000.)) == rdt) ) THEN 
     1368#endif 
    13511369         !!---------------------------------------------------------------------- 
    13521370         !! Calculate the carbonate chemistry for the whole ocean on the first 
     
    17951813                     iters, ' AT (', ji, ', ', jj, ', ', jk, ') AT ', kt 
    17961814                  endif 
     1815#     if defined key_foam_medusa 
     1816                  !! DAF (Aug 2017): calculate fCO2 for observation operator 
     1817                  CALL p2fCO2( f_pco2w, ztmp, f_pp0, 0.0, 1, f_fco2w ) 
     1818#     endif 
    17971819#   endif 
    17981820#  else 
     
    19321954                     fgco2(ji,jj) = f_co2flux * fthk * CO2flux_conv  !! mmol-C/m3/d -> kg-CO2/m2/s 
    19331955                  !! ENDIF 
     1956#   if defined key_foam_medusa 
     1957                  !! DAF (Aug 2017): Save pCO2 and fCO2 for observation operator 
     1958                  f2_pco2w(ji,jj) = f_pco2w 
     1959                  f2_fco2w(ji,jj) = f_pco2w 
     1960#   endif 
    19341961                  IF ( lk_iomput ) THEN 
    19351962                      IF( med_diag%ATM_PCO2%dgsave ) THEN 
     
    36033630               CALL flush(numout) 
    36043631 
     3632# if defined key_foam_medusa 
     3633               !!---------------------------------------------------------------------- 
     3634               !! Mixed layer averages for ocean colour assimilation 
     3635               !!---------------------------------------------------------------------- 
     3636               !! 
     3637               if (fdep1.le.hmld(ji,jj)) then 
     3638                  !! this level is entirely in the mixed layer 
     3639                  fq0 = 1.0 
     3640               elseif (fdep.ge.hmld(ji,jj)) then 
     3641                  !! this level is entirely below the mixed layer 
     3642                  fq0 = 0.0 
     3643               else 
     3644                  !! this level straddles the mixed layer 
     3645                  fq0 = (hmld(ji,jj) - fdep) / fthk 
     3646               endif 
     3647               !! 
     3648               pgrow_avg(ji,jj) = pgrow_avg(ji,jj) + ( & 
     3649                  ( (fprn * zphn) + (fprd * zphd) ) * fthk * fq0) 
     3650               ploss_avg(ji,jj) = ploss_avg(ji,jj) + ( & 
     3651                  ( fgmipn + fgmepn + fdpn + fdpn2 + fgmepd + fdpd + fdpd2 ) * fthk * fq0 ) 
     3652               phyt_avg(ji,jj)  = phyt_avg(ji,jj)  + ( & 
     3653                  (zphn +zphd) * fthk * fq0 ) 
     3654               !! 
     3655# endif 
    36053656               !!====================================================================== 
    36063657               !! LOCAL GRID CELL TRENDS 
     
    53315382      endif 
    53325383       
     5384# if defined key_foam_medusa 
     5385      !!---------------------------------------------------------------------- 
     5386      !! Dianostics required for ocean colour assimilation: 
     5387      !! Mixed layer average phytoplankton growth, loss and concentration 
     5388      !! Maximum mixed layer depth 
     5389      !!---------------------------------------------------------------------- 
     5390      !! 
     5391      DO jj = 2,jpjm1 
     5392         DO ji = 2,jpim1 
     5393            pgrow_avg(ji,jj) = pgrow_avg(ji,jj) / hmld(ji,jj) 
     5394            ploss_avg(ji,jj) = ploss_avg(ji,jj) / hmld(ji,jj) 
     5395            phyt_avg(ji,jj)  = phyt_avg(ji,jj)  / hmld(ji,jj) 
     5396            IF ( hmld(ji,jj) .GT. mld_max(ji,jj) ) THEN 
     5397               mld_max(ji,jj) = hmld(ji,jj) 
     5398            ENDIF 
     5399         END DO 
     5400      END DO 
     5401# endif 
     5402 
    53335403      IF( ln_diatrc ) THEN 
    53345404         !!---------------------------------------------------------------------- 
  • branches/UKMO/dev_r5518_GO6_package_asm_surf_bgc/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r8280 r8436  
    4343   USE sbc_oce, ONLY: lk_oasis  
    4444   USE oce,     ONLY: CO2Flux_out_cpl, DMS_out_cpl, chloro_out_cpl  !! Coupling variable 
     45#if defined key_foam_medusa 
     46   USE obs_const, ONLY: obfillflt  ! Observation operator fill value 
     47#endif 
    4548 
    4649   IMPLICIT NONE 
     
    329332         IF(lwp) WRITE(numout,*) 'Or don t start from uncomplete restart...'  
    330333      ENDIF 
     334      ! 
     335#  if defined key_foam_medusa 
     336      !! 2D fields of pCO2 and fCO2 for observation operator on first timestep 
     337      IF( iom_varid( numrtr, 'PCO2W', ldstop = .FALSE. ) > 0 ) THEN 
     338         IF(lwp) WRITE(numout,*) ' MEDUSA pCO2 present - reading in ...' 
     339         CALL iom_get( numrtr, jpdom_autoglo, 'PCO2W',  f2_pco2w(:,:)  ) 
     340         CALL iom_get( numrtr, jpdom_autoglo, 'FCO2W',  f2_fco2w(:,:)  ) 
     341      ELSE 
     342         IF(lwp) WRITE(numout,*) ' MEDUSA pCO2 absent - setting to fill ...' 
     343         f2_pco2w(:,:) = obfillflt 
     344         f2_fco2w(:,:) = obfillflt 
     345      ENDIF 
     346#  endif 
     347# endif 
     348# if defined key_foam_medusa 
     349      !! Fields for ocean colour assimilation on first timestep 
     350      IF( iom_varid( numrtr, 'pgrow_avg', ldstop = .FALSE. ) > 0 ) THEN 
     351         IF(lwp) WRITE(numout,*) ' MEDUSA pgrow_avg present - reading in ...' 
     352         CALL iom_get( numrtr, jpdom_autoglo, 'pgrow_avg',  pgrow_avg(:,:)  ) 
     353         CALL iom_get( numrtr, jpdom_autoglo, 'ploss_avg',  ploss_avg(:,:)  ) 
     354         CALL iom_get( numrtr, jpdom_autoglo, 'phyt_avg',   phyt_avg(:,:)   ) 
     355         CALL iom_get( numrtr, jpdom_autoglo, 'mld_max',    mld_max(:,:)    ) 
     356      ELSE 
     357         IF(lwp) WRITE(numout,*) ' MEDUSA pgrow_avg absent - setting to zero ...' 
     358         pgrow_avg(:,:) = 0.0 
     359         ploss_avg(:,:) = 0.0 
     360         phyt_avg(:,:)  = 0.0 
     361         mld_max(:,:)   = 0.0 
     362      ENDIF 
    331363# endif 
    332364 
     
    498530      call trc_rst_dia_stat( f2_ccd_arg(:,:),'CCD_ARG') 
    499531      !! 
     532# endif 
     533# if defined key_foam_medusa 
     534      !! Fields for assimilation and observation operator on first timestep 
     535      IF(lwp) WRITE(numout,*) ' MEDUSA OBS/ASM fields - writing out ...' 
     536#  if defined key_roam 
     537      CALL iom_rstput( kt, nitrst, numrtw, 'PCO2W',     f2_pco2w(:,:)  ) 
     538      CALL iom_rstput( kt, nitrst, numrtw, 'FCO2W',     f2_fco2w(:,:)  ) 
     539#  endif 
     540      CALL iom_rstput( kt, nitrst, numrtw, 'pgrow_avg', pgrow_avg(:,:) ) 
     541      CALL iom_rstput( kt, nitrst, numrtw, 'ploss_avg', ploss_avg(:,:) ) 
     542      CALL iom_rstput( kt, nitrst, numrtw, 'phyt_avg',  phyt_avg(:,:)  ) 
     543      CALL iom_rstput( kt, nitrst, numrtw, 'mld_max',   mld_max(:,:)   ) 
    500544# endif 
    501545!! 
Note: See TracChangeset for help on using the changeset viewer.