Changeset 13677


Ignore:
Timestamp:
2020-10-26T18:37:31+01:00 (6 months ago)
Author:
dford
Message:

Add option for MEDUSA to use RGB light scheme.

Location:
branches/UKMO/dev_r5518_GO6_package_FOAMv14_biophys/NEMOGCM
Files:
7 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14_biophys/NEMOGCM/CONFIG/SHARED/field_def_bgc.xml

    r10302 r13677  
    522522       <field id= "PH3"        long_name="Ocean pH 3D"                               unit="-"             grid_ref="grid_T_3D"  /> 
    523523       <field id= "OM_CAL3"    long_name="Omega calcite 3D"                          unit="-"             grid_ref="grid_T_3D"  /> 
     524       <field id= "MED_XPAR3"  long_name="Radiation 3D"                              unit="W/m2"          grid_ref="grid_T_3D"  /> 
    524525 
    525526       <!-- AXY (08/11/16): add new 3D CMIP6 diagnostics --> 
     
    23912392      <field field_ref= "PH3"        name="PH3"        /> 
    23922393      <field field_ref= "OM_CAL3"    name="OM_CAL3"    />  
     2394      <field field_ref= "MED_XPAR3"  name="MED_XPAR3"  /> 
    23932395    </field_group> 
    23942396 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14_biophys/NEMOGCM/CONFIG/SHARED/namelist_medusa_ref

    r10302 r13677  
    343343!  xlr   : red chl exposant 
    344344!  rpig  : chla / (chla+phea) ratio 
     345!  ln_rgb : use RGB scheme rather than 2-band scheme 
    345346! 
    346347&natopt 
     
    352353   xlr  = 0.674 
    353354   rpig = 0.7 
     355   ln_rgb = .false. 
    354356/ 
    355357!''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14_biophys/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_fin.F90

    r10302 r13677  
    5454                                   zn_sed_c, zn_sed_ca, zn_sed_fe,      & 
    5555                                   zn_sed_n, zn_sed_si, zn_chl_srf,     & 
    56                                    scl_chl, chl_out 
     56                                   scl_chl,  chl_out,   xpar 
    5757      USE trc,               ONLY: med_diag, nittrc000, trn  
    5858      USE trcnam_trp,        ONLY: ln_trcadv_cen2, ln_trcadv_tvd 
     
    749749             DEALLOCATE( remin3dn ) 
    750750          ENDIF 
     751          IF( med_diag%MED_XPAR3%dgsave ) THEN 
     752             CALL iom_put( "MED_XPAR3" , xpar ) 
     753          ENDIF   
    751754# if defined key_roam           
    752755          IF( med_diag%PH3%dgsave ) THEN 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14_biophys/NEMOGCM/NEMO/TOP_SRC/MEDUSA/sms_medusa.F90

    r13316 r13677  
    317317   REAL(wp) ::   xlg        !: exposant for pigment absorption in green (NAMELIST) 
    318318   REAL(wp) ::   rpig       !: chla/chla+phea ratio                     (NAMELIST) 
     319   LOGICAL  ::   ln_rgb     !: use RGB light scheme rather than 2-band  (NAMELIST) 
    319320                                                         
    320321   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   neln    !: number of levels in the euphotic layer 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14_biophys/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcnam_medusa.F90

    r10302 r13677  
    9494      &    xthetarem,xo2min  
    9595#endif 
    96       NAMELIST/natopt/xkg0,xkr0,xkgp,xkrp,xlg,xlr,rpig 
     96      NAMELIST/natopt/xkg0,xkr0,xkgp,xkrp,xlg,xlr,rpig,ln_rgb 
    9797      INTEGER :: jl, jn 
    9898      INTEGER :: ios                 ! Local integer output status for namelist read 
     
    10971097      xlr   = 0. 
    10981098      rpig  = 0. 
     1099      ln_rgb = .false. 
    10991100 
    11001101      !READ(numnatm,natopt) 
     
    11201121         WRITE(numout,*) ' red   chl exposant              xlr   = ',xlr 
    11211122         WRITE(numout,*) ' chla/chla+phea ratio            rpig  = ',rpig 
     1123         WRITE(numout,*) ' use RGB scheme                ln_rgb  = ',ln_rgb 
    11221124         WRITE(numout,*) ' ' 
    11231125 
     
    15331535          med_diag%MED_XPAR%dgsave = .FALSE. 
    15341536      ENDIF 
     1537      IF  (iom_use("MED_XPAR3")) THEN  
     1538          med_diag%MED_XPAR3%dgsave = .TRUE. 
     1539      ELSE  
     1540          med_diag%MED_XPAR3%dgsave = .FALSE. 
     1541      ENDIF 
    15351542      IF  (iom_use("INTFLX_N")) THEN  
    15361543          med_diag%INTFLX_N%dgsave = .TRUE. 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14_biophys/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcopt_medusa.F90

    r8074 r13677  
    2828 
    2929   PUBLIC   trc_opt_medusa   ! called in trcprg.F90 
     30 
     31   REAL(wp), DIMENSION(3,61) :: okrgb   !: tabulated attenuation coefficients for RGB absorption 
    3032 
    3133   !!* Substitution 
     
    5052      !!--------------------------------------------------------------------- 
    5153      INTEGER, INTENT( in ) ::   kt   ! index of the time stepping 
    52       INTEGER  ::   ji, jj, jk 
     54      INTEGER  ::   ji, jj, jk, irgb 
    5355      REAL(wp) ::   zpig                                    ! total pigment 
    5456      REAL(wp) ::   zkr                                     ! total absorption coefficient in red 
     
    5860      REAL(wp), DIMENSION(jpi,jpj)     ::   zpar0m          ! irradiance just below the surface 
    5961      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zparr, zparg    ! red and green compound of par 
     62      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zekb, zekg, zekr 
     63      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze1, ze2, ze3 
    6064 
    6165      CHARACTER (len=25) :: charout 
     
    113117      ! --------------------- 
    114118 
    115       DO jk = 2, jpk                     ! determination of local par in w levels 
    116          DO jj = 1, jpj 
    117             DO ji = 1, jpi 
    118                totchl =trn(ji,jj,jk-1,jpchn)+trn(ji,jj,jk-1,jpchd) 
    119                zpig = MAX( TINY(0.), totchl/rpig)  
    120                zkr  = xkr0 + xkrp * EXP( xlr * LOG( zpig ) ) 
    121                zkg  = xkg0 + xkgp * EXP( xlg * LOG( zpig ) ) 
    122                zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * fse3t(ji,jj,jk-1) ) 
    123                zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * fse3t(ji,jj,jk-1) ) 
     119      IF ( ln_rgb ) THEN 
     120         ! Mean PAR in T levels using RGB scheme 
     121         ! Should be same as in traqsr, but T rather than W levels 
     122         IF( kt == nittrc000 ) THEN 
     123            CALL trc_oce_rgb( okrgb ) 
     124         ENDIF 
     125         DO jk = 1, jpkm1 
     126            DO jj = 1, jpj 
     127               DO ji = 1, jpi 
     128                  totchl = trn(ji,jj,jk,jpchn) + trn(ji,jj,jk,jpchd) 
     129                  totchl = MIN( 10. , MAX( 0.05, totchl ) ) 
     130                  irgb = NINT( 41 + 20.* LOG10( totchl ) + 1.e-15 ) 
     131                  !                                                          
     132                  zekb(ji,jj,jk) = okrgb(1,irgb) * fse3t(ji,jj,jk) 
     133                  zekg(ji,jj,jk) = okrgb(2,irgb) * fse3t(ji,jj,jk) 
     134                  zekr(ji,jj,jk) = okrgb(3,irgb) * fse3t(ji,jj,jk) 
     135               END DO 
    124136            END DO 
    125         END DO 
    126       END DO 
    127  
    128       DO jk = 1, jpkm1                   ! mean par in t levels 
    129          DO jj = 1, jpj 
    130             DO ji = 1, jpi 
    131                totchl =trn(ji,jj,jk  ,jpchn)+trn(ji,jj,jk  ,jpchd) 
    132                zpig = MAX( TINY(0.), totchl/rpig)  
    133                zkr  = xkr0 + xkrp * EXP( xlr * LOG( zpig ) ) 
    134                zkg  = xkg0 + xkgp * EXP( xlg * LOG( zpig ) ) 
    135                zparr(ji,jj,jk)    = zparr(ji,jj,jk) / zkr / fse3t(ji,jj,jk) * ( 1 - EXP( -zkr*fse3t(ji,jj,jk) ) ) 
    136                zparg(ji,jj,jk)    = zparg(ji,jj,jk) / zkg / fse3t(ji,jj,jk) * ( 1 - EXP( -zkg*fse3t(ji,jj,jk) ) ) 
    137                xpar (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 ) 
     137         END DO 
     138         ze1(:,:,1) = zpar0m(:,:) * EXP( -0.5 * zekb(:,:,1) ) / 3.0 
     139         ze2(:,:,1) = zpar0m(:,:) * EXP( -0.5 * zekg(:,:,1) ) / 3.0 
     140         ze3(:,:,1) = zpar0m(:,:) * EXP( -0.5 * zekr(:,:,1) ) / 3.0 
     141         ! 
     142         DO jk = 2, jpk 
     143            DO jj = 1, jpj 
     144               DO ji = 1, jpi 
     145                  ze1(ji,jj,jk) = ze1(ji,jj,jk-1) * EXP( -0.5 * ( zekb(ji,jj,jk-1) + zekb(ji,jj,jk) ) ) 
     146                  ze2(ji,jj,jk) = ze2(ji,jj,jk-1) * EXP( -0.5 * ( zekg(ji,jj,jk-1) + zekg(ji,jj,jk) ) ) 
     147                  ze3(ji,jj,jk) = ze3(ji,jj,jk-1) * EXP( -0.5 * ( zekr(ji,jj,jk-1) + zekr(ji,jj,jk) ) ) 
     148                  xpar(ji,jj,jk) = MAX( ze1(ji,jj,jk) + ze2(ji,jj,jk) + ze3(ji,jj,jk), 1.e-15 ) 
     149               END DO 
    138150            END DO 
    139151         END DO 
    140       END DO 
     152      ELSE 
     153         DO jk = 2, jpk                     ! determination of local par in w levels 
     154            DO jj = 1, jpj 
     155               DO ji = 1, jpi 
     156                  totchl =trn(ji,jj,jk-1,jpchn)+trn(ji,jj,jk-1,jpchd) 
     157                  zpig = MAX( TINY(0.), totchl/rpig)  
     158                  zkr  = xkr0 + xkrp * EXP( xlr * LOG( zpig ) ) 
     159                  zkg  = xkg0 + xkgp * EXP( xlg * LOG( zpig ) ) 
     160                  zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * fse3t(ji,jj,jk-1) ) 
     161                  zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * fse3t(ji,jj,jk-1) ) 
     162               END DO 
     163           END DO 
     164         END DO 
     165 
     166         DO jk = 1, jpkm1                   ! mean par in t levels 
     167            DO jj = 1, jpj 
     168               DO ji = 1, jpi 
     169                  totchl =trn(ji,jj,jk  ,jpchn)+trn(ji,jj,jk  ,jpchd) 
     170                  zpig = MAX( TINY(0.), totchl/rpig)  
     171                  zkr  = xkr0 + xkrp * EXP( xlr * LOG( zpig ) ) 
     172                  zkg  = xkg0 + xkgp * EXP( xlg * LOG( zpig ) ) 
     173                  zparr(ji,jj,jk)    = zparr(ji,jj,jk) / zkr / fse3t(ji,jj,jk) * ( 1 - EXP( -zkr*fse3t(ji,jj,jk) ) ) 
     174                  zparg(ji,jj,jk)    = zparg(ji,jj,jk) / zkg / fse3t(ji,jj,jk) * ( 1 - EXP( -zkg*fse3t(ji,jj,jk) ) ) 
     175                  xpar (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 ) 
     176               END DO 
     177            END DO 
     178         END DO 
     179      ENDIF 
    141180 
    142181      ! 3. Determination of euphotic layer depth 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14_biophys/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r10302 r13677  
    154154                  MIGRAZP3, MIGRAZD3, MEGRAZP3, MEGRAZD3, MEGRAZZ3,                                  & 
    155155                  O2SAT3, PBSI3, PCAL3, REMOC3,                                                      & 
    156                   PNLIMJ3, PNLIMN3, PNLIMFE3, PDLIMJ3, PDLIMN3, PDLIMFE3, PDLIMSI3        
     156                  PNLIMJ3, PNLIMN3, PNLIMFE3, PDLIMJ3, PDLIMN3, PDLIMFE3, PDLIMSI3,                  & 
     157! DAF (22/10/20): some more diagnostics 
     158                  MED_XPAR3 
    157159                  !! 
    158160                  !! list of all MEDUSA diagnostics that could be called by iom_use 
Note: See TracChangeset for help on using the changeset viewer.