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

Changeset 8235


Ignore:
Timestamp:
2017-06-28T16:48:39+02:00 (7 years ago)
Author:
frrh
Message:

Update branch in line with current head of GO6 package branch at revision 8104.

Location:
branches/UKMO/dev_r5518_couple_chlorophyll/NEMOGCM
Files:
11 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_couple_chlorophyll/NEMOGCM/CONFIG/SHARED/field_def.xml

    r7993 r8235  
    2626         <field id="e3t_0"        long_name="Initial T-cell thickness"   standard_name="ref_cell_thickness"   unit="m"   grid_ref="grid_T_3D"/> 
    2727 
     28         <field id="tinsitu"      long_name="in situ temperature" standard_name="in_situ_temperature"   unit="degC"     grid_ref="grid_T_3D"/> 
     29         <field id="sinsitu"      long_name="in situ salinity" standard_name="in_situ_salinity"   unit="1e-3"     grid_ref="grid_T_3D"/> 
     30          
    2831         <field id="toce"         long_name="Sea Water Potential Temperature"         standard_name="sea_water_potential_temperature"   unit="degree_C"     grid_ref="grid_T_3D"/> 
    2932         <field id="toce_e3t"     long_name="temperature * e3t"                                                     unit="degree_C*m"   grid_ref="grid_T_3D" > toce * e3t </field > 
     
    781784    --> 
    782785 
    783     <field_group id="trendT" grid_ref="grid_T_3D"> 
    784786      <!-- variables available with ln_tra_trd --> 
    785       <field id="ttrd_xad"      long_name="temperature-trend: i-advection"                                                                                          unit="degC/s"                        /> 
     787  
     788     <!-- Asselin trends  calculated on odd time steps--> 
     789     <field_group id="trendT_odd"  grid_ref="grid_T_3D"> 
     790      <field id="ttrd_atf"      long_name="temperature-trend: asselin time filter"       unit="degree_C/s" /> 
     791      <field id="strd_atf"      long_name="salinity   -trend: asselin time filter"       unit="0.001/s" /> 
     792      <!-- Thickness weighted versions: --> 
     793     <field id="ttrd_atf_e3t"      unit="degC/s * m"  >  ttrd_atf * e3t </field> 
     794      <field id="strd_atf_e3t"      unit="1e-3/s * m"  >  strd_atf * e3t </field> 
     795      <!-- OMIP  layer-integrated trends --> 
     796      <field id="ttrd_atf_li"      long_name="layer integrated heat-trend: asselin time filter "       unit="W/m^2" > ttrd_atf_e3t * 1026.0 * 3991.86795711963  </field> 
     797       <field id="strd_atf_li"      long_name="layer integrated salt   -trend: asselin time filter "       unit="kg/(m^2 s)" > strd_atf_e3t * 1026.0 * 0.001 </field> 
     798      </field_group> 
     799 
     800    <!-- Other trends  calculated on even time steps--> 
     801  <field_group id="trendT_even" grid_ref="grid_T_3D"> 
     802       <field id="ttrd_xad"      long_name="temperature-trend: i-advection"                                                                                          unit="degC/s"                        /> 
    786803      <field id="strd_xad"      long_name="salinity   -trend: i-advection"                                                                                          unit="1e-3/s"                        /> 
    787804      <field id="ttrd_yad"      long_name="temperature-trend: j-advection"                                                                                          unit="degC/s"                        /> 
     
    827844      <field id="ttrd_qsr"      long_name="temperature-trend: solar penetr. heating"     unit="degree_C/s" /> 
    828845      <field id="ttrd_bbc"      long_name="temperature-trend: geothermal heating"        unit="degree_C/s" /> 
    829       <field id="ttrd_atf"      long_name="temperature-trend: asselin time filter"       unit="degree_C/s" /> 
    830       <field id="strd_atf"      long_name="salinity   -trend: asselin time filter"       unit="0.001/s" /> 
    831       <field id="ttrd_tot"      long_name="temperature-trend: total model trend"         unit="degC/s" /> 
    832       <field id="strd_tot"      long_name="salinity   -trend: total model trend"         unit="1e-3/s" /> 
    833  
     846  
    834847      <!-- Thickness weighted versions: --> 
    835848      <field id="ttrd_xad_e3t"      unit="degC/s * m" >  ttrd_xad * e3t </field> 
     
    850863      <field id="strd_evd_e3t"      unit="1e-3/s * m" >  strd_evd * e3t </field> 
    851864 
     865      <field id="strd_evd_e3t"      unit="1e-3/s * m" >  strd_evd * e3t </field> 
     866 
    852867      <!-- ln_traldf_iso=T only (iso-neutral diffusion) --> 
    853868      <field id="ttrd_iso_x_e3t"    unit="degC/s * m"  >  ttrd_iso_x * e3t </field> 
     
    873888      <field id="ttrd_qsr_e3t"      unit="degC/s * m"  >  ttrd_qsr * e3t </field> 
    874889      <field id="ttrd_bbc_e3t"      unit="degC/s * m"  >  ttrd_bbc * e3t </field> 
    875       <field id="ttrd_atf_e3t"      unit="degC/s * m"  >  ttrd_atf * e3t </field> 
    876       <field id="strd_atf_e3t"      unit="1e-3/s * m"  >  strd_atf * e3t </field> 
     890 
     891      <!-- OMIP  layer-integrated trends --> 
     892      <field id="ttrd_totad_li"    long_name="layer integrated heat-trend : total advection"       unit="W/m^2"     > ttrd_totad_e3t * 1026.0 * 3991.86795711963 </field> 
     893      <field id="strd_totad_li"    long_name="layer integrated salt   -trend : total advection"      unit="kg/(m^2 s)"    > strd_totad_e3t * 1026.0 * 0.001  </field> 
     894      <field id="ttrd_evd_li"      long_name="layer integrated heat-trend : EVD convection"         unit="W/m^2"    > ttrd_evd_e3t * 1026.0 * 3991.86795711963 </field> 
     895      <field id="strd_evd_li"      long_name="layer integrated salt   -trend : EVD convection"      unit="kg/(m^2 s)"  > strd_evd_e3t * 1026.0 * 0.001  </field> 
     896      <field id="ttrd_iso_li"      long_name="layer integrated heat-trend : isopycnal diffusion"    unit="W/m^2" > ttrd_iso_e3t * 1026.0 * 3991.86795711963 </field> 
     897      <field id="strd_iso_li"      long_name="layer integrated salt   -trend : isopycnal diffusion"   unit="kg/(m^2 s)" > strd_iso_e3t * 1026.0 * 0.001  </field> 
     898      <field id="ttrd_zdfp_li"     long_name="layer integrated heat-trend : pure vert. diffusion"   unit="W/m^2" > ttrd_zdfp_e3t * 1026.0 * 3991.86795711963 </field> 
     899      <field id="strd_zdfp_li"     long_name="layer integrated salt   -trend : pure vert. diffusion"   unit="kg/(m^2 s)" > strd_zdfp_e3t * 1026.0 * 0.001  </field> 
     900      <field id="ttrd_qns_li"      long_name="layer integrated heat-trend : non-solar flux + runoff"   unit="W/m^2" grid_ref="grid_T_2D"> ttrd_qns_e3t * 1026.0 * 3991.86795711963 </field> 
     901      <field id="ttrd_qsr_li"      long_name="layer integrated heat-trend : solar flux"   unit="W/m^2"  grid_ref="grid_T_3D"> ttrd_qsr_e3t * 1026.0 * 3991.86795711963 </field> 
     902      <field id="ttrd_bbl_li"      long_name="layer integrated heat-trend: bottom boundary layer "     unit="W/m^2" > ttrd_bbl_e3t * 1026.0 * 3991.86795711963 </field> 
     903      <field id="strd_bbl_li"      long_name="layer integrated salt   -trend: bottom boundary layer "     unit="kg/(m^2 s)" > strd_bbl_e3t * 1026.0 * 0.001  </field> 
     904      <field id="ttrd_evd_li"      long_name="layer integrated heat -trend: evd convection "       unit="W/m^2" >ttrd_evd_e3t * 1026.0 * 3991.86795711963  </field> 
     905      <field id="strd_evd_li"      long_name="layer integrated salt -trend: evd convection "       unit="kg/(m^2 s)" > strd_evd_e3t * 1026.0 * 0.001  </field> 
     906     </field_group> 
     907    
     908     <!--  Total trends calculated every time step--> 
     909     <field_group id="trendT" grid_ref="grid_T_3D"> 
     910      <field id="ttrd_tot"      long_name="temperature-trend: total model trend"         unit="degC/s" /> 
     911      <field id="strd_tot"      long_name="salinity   -trend: total model trend"         unit="1e-3/s" /> 
     912      <!-- Thickness weighted versions: --> 
    877913      <field id="ttrd_tot_e3t"      unit="degC/s * m"  >  ttrd_tot * e3t </field> 
    878914      <field id="strd_tot_e3t"      unit="1e-3/s * m"  >  strd_tot * e3t </field> 
    879  
     915      <!-- OMIP  layer-integrated total trends --> 
     916      <field id="ttrd_tot_li"      long_name="layer integrated heat-trend: total model trend :"         unit="W/m^2" > ttrd_tot_e3t * 1026.0 * 3991.86795711963 </field> 
     917      <field id="strd_tot_li"      long_name="layer integrated salt   -trend: total model trend :"         unit="kg/(m^2 s)" > strd_tot_e3t * 1026.0 * 0.001  </field> 
     918    
     919      <!-- **** these trends have not been apportioned to all/even/odd ts yet **** --> 
    880920      <!-- variables available with ln_KE_trd --> 
    881921      <field id="ketrd_hpg"     long_name="ke-trend: hydrostatic pressure gradient"          unit="W/s^3"                        /> 
     
    9751015    --> 
    9761016 
     1017     <field_group id="TRD" > 
     1018          <field field_ref="ttrd_totad_li"   name="opottempadvect"  /> 
     1019          <field field_ref="ttrd_iso_li"     name="opottemppmdiff"  /> 
     1020          <field field_ref="ttrd_zdfp_li"    name="opottempdiff"  /> 
     1021          <field field_ref="ttrd_evd_li"     name="opottempevd" /> 
     1022          <field field_ref="strd_evd_li"     name="osaltevd" /> 
     1023          <field field_ref="ttrd_qns_li"     name="opottempqns"  /> 
     1024          <field field_ref="ttrd_qsr_li"     name="rsdoabsorb" operation="accumulate" /> 
     1025          <field field_ref="strd_totad_li"   name="osaltadvect" /> 
     1026          <field field_ref="strd_iso_li"     name="osaltpmdiff"  /> 
     1027          <field field_ref="strd_zdfp_li"    name="osaltdiff" /> 
     1028    </field_group> 
     1029     
    9771030    <field_group id="mooring" > 
    9781031      <field field_ref="toce"         name="thetao"   long_name="sea_water_potential_temperature"      /> 
  • branches/UKMO/dev_r5518_couple_chlorophyll/NEMOGCM/CONFIG/SHARED/namelist_ref

    r8024 r8235  
    392392   ln_usecplmask = .false.   !  use a coupling mask file to merge data received from several models 
    393393                             !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
    394    ln_coupled_iceshelf_fluxes = .false. ! If true use rate of change of mass of Greenland and Antarctic icesheets to set the  
    395                                         ! combined magnitude of the iceberg calving and iceshelf melting freshwater fluxes. 
     394   nn_coupled_iceshelf_fluxes = 0 ! =0 : total freshwater input from iceberg calving and ice shelf basal melting  
     395                                  ! taken from climatologies used (no action in coupling routines). 
     396                                  ! =1 :  use rate of change of mass of Greenland and Antarctic icesheets to set the  
     397                                  ! combined magnitude of the iceberg calving and iceshelf melting freshwater fluxes. 
     398                                  ! =2 :  specify constant freshwater inputs in this namelist to set the combined 
     399                                  ! magnitude of iceberg calving and iceshelf melting freshwater fluxes. 
    396400   ln_iceshelf_init_atmos     = .true.  ! If true force ocean to initialise icesheet masses from atmospheric values rather than 
    397401                                        ! from values in ocean restart file.  
     402   rn_greenland_total_fw_flux   = 0.0  ! Constant total rate of freshwater input (kg/s) for Greenland (if nn_coupled_iceshelf_fluxes=2)  
    398403   rn_greenland_calving_fraction = 0.5  ! Set fraction of total freshwater flux for iceberg calving - remainder goes to iceshelf melting. 
     404   rn_antarctica_total_fw_flux  = 0.0  ! Constant total rate of freshwater input (kg/s) for Antarctica (if nn_coupled_iceshelf_fluxes=2) 
    399405   rn_antarctica_calving_fraction = 0.5 ! Set fraction of total freshwater flux for iceberg calving - remainder goes to iceshelf melting. 
    400406   rn_iceshelf_fluxes_tolerance = 1e-6  ! Fractional threshold for detecting differences in icesheet masses (must be positive definite). 
  • branches/UKMO/dev_r5518_couple_chlorophyll/NEMOGCM/NEMO/OPA_SRC/ICB/icbclv.F90

    r6488 r8235  
    6666 
    6767      IF( lk_oasis) THEN 
    68       ! ln_coupled_iceshelf_fluxes uninitialised unless lk_oasis=true 
    69       IF( ln_coupled_iceshelf_fluxes ) THEN 
     68      ! nn_coupled_iceshelf_fluxes uninitialised unless lk_oasis=true 
     69      IF( nn_coupled_iceshelf_fluxes .gt. 0 ) THEN 
    7070 
    7171        ! Adjust total calving rates so that sum of iceberg calving and iceshelf melting in the northern 
  • branches/UKMO/dev_r5518_couple_chlorophyll/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r7750 r8235  
    16271627#if ! defined key_xios2 
    16281628      WRITE(cl1,'(i1)')        1   ;   CALL iom_set_field_attr('field_definition', freq_op=cl1//'ts', freq_offset='0ts') 
     1629      WRITE(cl1,'(i1)')        2   ;   CALL iom_set_field_attr('trendT_even'      , freq_op=cl1//'ts', freq_offset='0ts') 
     1630      WRITE(cl1,'(i1)')        2   ;   CALL iom_set_field_attr('trendT_odd'       , freq_op=cl1//'ts', freq_offset='-1ts') 
    16291631      WRITE(cl1,'(i1)')  nn_fsbc   ;   CALL iom_set_field_attr('SBC'             , freq_op=cl1//'ts', freq_offset='0ts') 
    16301632      WRITE(cl1,'(i1)')  nn_fsbc   ;   CALL iom_set_field_attr('SBC_scalar'      , freq_op=cl1//'ts', freq_offset='0ts') 
     
    16331635#else 
    16341636      f_op%timestep = 1        ;  f_of%timestep = 0  ; CALL iom_set_field_attr('field_definition', freq_op=f_op, freq_offset=f_of) 
     1637      f_op%timestep = 2        ;  f_of%timestep = 0  ; CALL iom_set_field_attr('trendT_even'      , freq_op=f_op, freq_offset=f_of) 
     1638      f_op%timestep = 2        ;  f_of%timestep = -1 ; CALL iom_set_field_attr('trendT_odd'       , freq_op=f_op, freq_offset=f_of) 
    16351639      f_op%timestep = nn_fsbc  ;  f_of%timestep = 0  ; CALL iom_set_field_attr('SBC'             , freq_op=f_op, freq_offset=f_of) 
    16361640      f_op%timestep = nn_fsbc  ;  f_of%timestep = 0  ; CALL iom_set_field_attr('SBC_scalar'      , freq_op=f_op, freq_offset=f_of) 
  • branches/UKMO/dev_r5518_couple_chlorophyll/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90

    r6755 r8235  
    158158#endif 
    159159                     IF( lk_oasis) THEN 
    160                      ! ln_coupled_iceshelf_fluxes uninitialised unless lk_oasis=true 
    161                      IF( ln_coupled_iceshelf_fluxes ) THEN 
     160                     ! nn_coupled_iceshelf_fluxes uninitialised unless lk_oasis=true 
     161                     IF( nn_coupled_iceshelf_fluxes .eq. 1 ) THEN 
    162162                        CALL iom_rstput( kt, nitrst, numrow, 'greenland_icesheet_mass', greenland_icesheet_mass ) 
    163163                        CALL iom_rstput( kt, nitrst, numrow, 'greenland_icesheet_timelapsed', greenland_icesheet_timelapsed ) 
  • branches/UKMO/dev_r5518_couple_chlorophyll/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r7540 r8235  
    153153   ! sbccpl namelist parameters associated with icesheet freshwater input code. Included here rather than in sbccpl.F90 to  
    154154   ! avoid circular dependencies. 
    155    LOGICAL, PUBLIC     ::   ln_coupled_iceshelf_fluxes     ! If true use rate of change of mass of Greenland and Antarctic icesheets to set the  
     155   INTEGER, PUBLIC     ::   nn_coupled_iceshelf_fluxes     ! =0 : total freshwater input from iceberg calving and ice shelf basal melting  
     156                                                           ! taken from climatologies used (no action in coupling routines). 
     157                                                           ! =1 :  use rate of change of mass of Greenland and Antarctic icesheets to set the  
    156158                                                           ! combined magnitude of the iceberg calving and iceshelf melting freshwater fluxes. 
     159                                                           ! =2 :  specify constant freshwater inputs in this namelist to set the combined 
     160                                                           ! magnitude of iceberg calving and iceshelf melting freshwater fluxes. 
    157161   LOGICAL, PUBLIC     ::   ln_iceshelf_init_atmos         ! If true force ocean to initialise iceshelf masses from atmospheric values rather 
    158                                                            ! than values in ocean restart. 
     162                                                           ! than values in ocean restart (applicable if nn_coupled_iceshelf_fluxes=1). 
     163   REAL(wp), PUBLIC    ::   rn_greenland_total_fw_flux    ! Constant total rate of freshwater input (kg/s) for Greenland (if nn_coupled_iceshelf_fluxes=2)  
    159164   REAL(wp), PUBLIC    ::   rn_greenland_calving_fraction  ! Set fraction of total freshwater flux for iceberg calving - remainder goes to iceshelf melting. 
     165   REAL(wp), PUBLIC    ::   rn_antarctica_total_fw_flux   ! Constant total rate of freshwater input (kg/s) for Antarctica (if nn_coupled_iceshelf_fluxes=2)  
    160166   REAL(wp), PUBLIC    ::   rn_antarctica_calving_fraction ! Set fraction of total freshwater flux for iceberg calving - remainder goes to iceshelf melting. 
    161167   REAL(wp), PUBLIC    ::   rn_iceshelf_fluxes_tolerance   ! Absolute tolerance for detecting differences in icesheet masses.  
  • branches/UKMO/dev_r5518_couple_chlorophyll/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r8136 r8235  
    242242         &                  sn_rcv_qns , sn_rcv_emp   , sn_rcv_rnf   , sn_rcv_cal   , sn_rcv_iceflx,  & 
    243243         &                  sn_rcv_co2 , sn_rcv_grnm  , sn_rcv_antm  , sn_rcv_ts_ice, nn_cplmodel  ,  & 
    244          &                  ln_usecplmask, ln_coupled_iceshelf_fluxes, ln_iceshelf_init_atmos,        & 
    245          &                  rn_greenland_calving_fraction, & 
    246          &                  rn_antarctica_calving_fraction, rn_iceshelf_fluxes_tolerance 
     244         &                  ln_usecplmask, nn_coupled_iceshelf_fluxes, ln_iceshelf_init_atmos,        & 
     245         &                  rn_greenland_total_fw_flux, rn_greenland_calving_fraction, & 
     246         &                  rn_antarctica_total_fw_flux, rn_antarctica_calving_fraction, rn_iceshelf_fluxes_tolerance 
    247247      !!--------------------------------------------------------------------- 
    248248 
     
    314314         WRITE(numout,*)'  nn_cplmodel                         = ', nn_cplmodel 
    315315         WRITE(numout,*)'  ln_usecplmask                       = ', ln_usecplmask 
    316          WRITE(numout,*)'  ln_coupled_iceshelf_fluxes          = ', ln_coupled_iceshelf_fluxes 
     316         WRITE(numout,*)'  nn_coupled_iceshelf_fluxes          = ', nn_coupled_iceshelf_fluxes 
    317317         WRITE(numout,*)'  ln_iceshelf_init_atmos              = ', ln_iceshelf_init_atmos 
     318         WRITE(numout,*)'  rn_greenland_total_fw_flux         = ', rn_greenland_total_fw_flux 
     319         WRITE(numout,*)'  rn_antarctica_total_fw_flux        = ', rn_antarctica_total_fw_flux 
    318320         WRITE(numout,*)'  rn_greenland_calving_fraction       = ', rn_greenland_calving_fraction 
    319321         WRITE(numout,*)'  rn_antarctica_calving_fraction      = ', rn_antarctica_calving_fraction 
     
    957959      ncpl_qsr_freq = 86400 / ncpl_qsr_freq 
    958960 
    959       IF( ln_coupled_iceshelf_fluxes ) THEN 
     961      IF( nn_coupled_iceshelf_fluxes .gt. 0 ) THEN 
    960962          ! Crude masks to separate the Antarctic and Greenland icesheets. Obviously something 
    961963          ! more complicated could be done if required. 
     
    13451347      ENDIF 
    13461348 
    1347       IF( srcv(jpr_grnm)%laction ) THEN 
     1349      IF( srcv(jpr_grnm)%laction .AND. nn_coupled_iceshelf_fluxes == 1 ) THEN 
    13481350         greenland_icesheet_mass_array(:,:) = frcv(jpr_grnm)%z3(:,:,1) 
    13491351         ! take average over ocean points of input array to avoid cumulative error over time 
     
    13771379         IF(lwp) WRITE(numout,*) 'Greenland icesheet mass rate of change (kg/s) is ', greenland_icesheet_mass_rate_of_change 
    13781380         IF(lwp) WRITE(numout,*) 'Greenland icesheet seconds lapsed since last change is ', greenland_icesheet_timelapsed 
     1381      ELSE IF ( nn_coupled_iceshelf_fluxes == 2 ) THEN 
     1382         greenland_icesheet_mass_rate_of_change = rn_greenland_total_fw_flux 
    13791383      ENDIF 
    13801384 
    13811385      !                                                        ! land ice masses : Antarctica 
    1382       IF( srcv(jpr_antm)%laction ) THEN 
     1386      IF( srcv(jpr_antm)%laction .AND. nn_coupled_iceshelf_fluxes == 1 ) THEN 
    13831387         antarctica_icesheet_mass_array(:,:) = frcv(jpr_antm)%z3(:,:,1) 
    13841388         ! take average over ocean points of input array to avoid cumulative error from rounding errors over time 
     
    14121416         IF(lwp) WRITE(numout,*) 'Antarctica icesheet mass rate of change (kg/s) is ', antarctica_icesheet_mass_rate_of_change 
    14131417         IF(lwp) WRITE(numout,*) 'Antarctica icesheet seconds lapsed since last change is ', antarctica_icesheet_timelapsed 
     1418      ELSE IF ( nn_coupled_iceshelf_fluxes == 2 ) THEN 
     1419         antarctica_icesheet_mass_rate_of_change = rn_antarctica_total_fw_flux 
    14141420      ENDIF 
    14151421 
  • branches/UKMO/dev_r5518_couple_chlorophyll/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90

    r7179 r8235  
    255255 
    256256            IF( lk_oasis) THEN 
    257             ! ln_coupled_iceshelf_fluxes uninitialised unless lk_oasis=true 
    258             IF( ln_coupled_iceshelf_fluxes ) THEN 
     257            ! nn_coupled_iceshelf_fluxes uninitialised unless lk_oasis=true 
     258            IF( nn_coupled_iceshelf_fluxes .gt. 0 ) THEN 
    259259 
    260260              ! Adjust total iceshelf melt rates so that sum of iceberg calving and iceshelf melting in the northern 
     
    304304 
    305305            IF( lk_oasis) THEN 
    306             ! ln_coupled_iceshelf_fluxes uninitialised unless lk_oasis=true 
    307             IF( ln_coupled_iceshelf_fluxes ) THEN 
     306            ! nn_coupled_iceshelf_fluxes uninitialised unless lk_oasis=true 
     307            IF( nn_coupled_iceshelf_fluxes .gt. 0 ) THEN 
    308308 
    309309              ! Adjust total iceshelf melt rates so that sum of iceberg calving and iceshelf melting in the northern 
  • branches/UKMO/dev_r5518_couple_chlorophyll/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r7573 r8235  
    135135            CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdfp, ztrds ) 
    136136         ENDIF 
    137          ! total trend for the non-time-filtered variables.  
    138          DO jk = 1, jpkm1 
    139             zfact = 1.0 / rdttra(jk) 
    140             ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsn(:,:,jk,jp_tem) ) * zfact  
    141             ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsn(:,:,jk,jp_sal) ) * zfact  
    142          END DO 
     137         ! total trend for the non-time-filtered variables. 
     138         ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from tsn terms 
     139         IF( lk_vvl ) THEN 
     140            DO jk = 1, jpkm1 
     141               zfact = 1.0 / rdttra(jk) 
     142               ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem)*fse3t_a(:,:,jk) / fse3t_n(:,:,jk) - tsn(:,:,jk,jp_tem)) * zfact 
     143               ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal)*fse3t_a(:,:,jk) / fse3t_n(:,:,jk) - tsn(:,:,jk,jp_sal)) * zfact 
     144            END DO 
     145         ELSE 
     146            DO jk = 1, jpkm1 
     147               zfact = 1.0 / rdttra(jk) 
     148               ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsn(:,:,jk,jp_tem) ) * zfact  
     149               ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsn(:,:,jk,jp_sal) ) * zfact  
     150            END DO 
     151         END IF 
    143152         CALL trd_tra( kt, 'TRA', jp_tem, jptra_tot, ztrdt ) 
    144153         CALL trd_tra( kt, 'TRA', jp_sal, jptra_tot, ztrds ) 
    145          ! Store now fields before applying the Asselin filter  
    146          ! in order to calculate Asselin filter trend later. 
    147          ztrdt(:,:,:) = tsn(:,:,:,jp_tem)  
    148          ztrds(:,:,:) = tsn(:,:,:,jp_sal) 
     154         IF( .NOT.lk_vvl )  THEN 
     155            ! Store now fields before applying the Asselin filter  
     156            ! in order to calculate Asselin filter trend later. 
     157            ztrdt(:,:,:) = tsn(:,:,:,jp_tem)  
     158            ztrds(:,:,:) = tsn(:,:,:,jp_sal) 
     159         END IF 
    149160      ENDIF 
    150161 
     
    155166            END DO 
    156167         END DO 
     168         IF (l_trdtra.AND.lk_vvl) THEN      ! Zero Asselin filter contribution must be explicitly written out since for vvl 
     169                                            ! Asselin filter is output by tra_nxt_vvl that is not called on this time step 
     170            ztrdt(:,:,:) = 0._wp 
     171            ztrds(:,:,:) = 0._wp 
     172            CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt ) 
     173            CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds ) 
     174         END IF 
    157175      ELSE                                            ! Leap-Frog + Asselin filter time stepping 
    158176         ! 
     
    164182      ! 
    165183     ! trends computation 
    166       IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt      
     184      IF( l_trdtra.AND..NOT.lk_vvl) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt      
    167185         DO jk = 1, jpkm1 
    168186            zfact = 1._wp / r2dtra(jk)              
     
    172190         CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt ) 
    173191         CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds ) 
    174          CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
    175192      END IF 
     193      IF( l_trdtra) CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
    176194      ! 
    177195      !                        ! control print 
     
    289307      LOGICAL  ::   ll_tra_hpg, ll_traqsr, ll_rnf, ll_isf   ! local logical 
    290308      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices 
    291       REAL(wp) ::   zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar 
     309      REAL(wp) ::   zfact, zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar 
    292310      REAL(wp) ::   zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d   !   -      - 
     311      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrd_atf 
    293312      !!---------------------------------------------------------------------- 
    294313      ! 
     
    315334      ENDIF 
    316335      ! 
     336      IF( l_trdtra )   THEN 
     337         CALL wrk_alloc( jpi, jpj, jpk, kjpt, ztrd_atf ) 
     338         ztrd_atf(:,:,:,:) = 0.0_wp 
     339      ENDIF 
    317340      DO jn = 1, kjpt       
    318341         DO jk = 1, jpkm1 
     342            zfact = 1._wp / r2dtra(jk) 
    319343            zfact1 = atfp * p2dt(jk) 
    320344            zfact2 = zfact1 / rau0 
     
    371395                     pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n  + rbcp * ztc_d  )   ! ta <-- Brown & Campana average 
    372396                  ENDIF 
     397                  IF( l_trdtra ) THEN 
     398                     ztrd_atf(ji,jj,jk,jn) = (ztc_f - ztc_n) * zfact/ze3t_n 
     399                  ENDIF 
    373400               END DO 
    374401            END DO 
     
    377404      END DO 
    378405      ! 
     406      IF( l_trdtra ) THEN 
     407         CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrd_atf(:,:,:,jp_tem) ) 
     408         CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrd_atf(:,:,:,jp_sal) ) 
     409         CALL wrk_dealloc( jpi, jpj, jpk, kjpt, ztrd_atf ) 
     410      ENDIF 
     411 
    379412   END SUBROUTINE tra_nxt_vvl 
    380413 
  • branches/UKMO/dev_r5518_couple_chlorophyll/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90

    r6486 r8235  
    9494 
    9595      IF( l_trdtra )   THEN                      ! save the vertical diffusive trends for further diagnostics 
    96          DO jk = 1, jpkm1 
    97             ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / r2dtra(jk) ) - ztrdt(:,:,jk) 
    98             ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dtra(jk) ) - ztrds(:,:,jk) 
    99          END DO 
     96         ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn. 
     97         IF( lk_vvl ) THEN 
     98            DO jk = 1, jpkm1 
     99               ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem)*fse3t_a(:,:,jk) - tsb(:,:,jk,jp_tem)*fse3t_b(:,:,jk) ) & 
     100                    & / (fse3t_n(:,:,jk)*r2dtra(jk)) ) - ztrdt(:,:,jk) 
     101               ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal)*fse3t_a(:,:,jk) - tsb(:,:,jk,jp_sal)*fse3t_b(:,:,jk) ) & 
     102                    & / (fse3t_n(:,:,jk)*r2dtra(jk)) ) - ztrds(:,:,jk) 
     103            END DO 
     104         ELSE 
     105            DO jk = 1, jpkm1 
     106               ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / r2dtra(jk) ) - ztrdt(:,:,jk) 
     107               ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dtra(jk) ) - ztrds(:,:,jk) 
     108            END DO 
     109         END IF 
    100110         CALL lbc_lnk( ztrdt, 'T', 1. ) 
    101111         CALL lbc_lnk( ztrds, 'T', 1. ) 
  • branches/UKMO/dev_r5518_couple_chlorophyll/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90

    r7554 r8235  
    301301      !! ** Purpose :   output 3D tracer trends using IOM 
    302302      !!---------------------------------------------------------------------- 
    303       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdx   ! Temperature or U trend  
    304       REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdy   ! Salinity    or V trend 
    305       INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index 
    306       INTEGER                   , INTENT(in   ) ::   kt      ! time step 
    307       !! 
    308       INTEGER ::   ji, jj, jk   ! dummy loop indices 
    309       INTEGER ::   ikbu, ikbv   ! local integers 
    310       REAL(wp), POINTER, DIMENSION(:,:)   ::   z2dx, z2dy   ! 2D workspace  
    311       !!---------------------------------------------------------------------- 
    312       ! 
    313 !!gm Rq: mask the trends already masked in trd_tra, but lbc_lnk should probably be added 
    314       ! 
    315       SELECT CASE( ktrd ) 
    316       CASE( jptra_xad  )   ;   CALL iom_put( "ttrd_xad" , ptrdx )        ! x- horizontal advection 
    317                                CALL iom_put( "strd_xad" , ptrdy ) 
    318       CASE( jptra_yad  )   ;   CALL iom_put( "ttrd_yad" , ptrdx )        ! y- horizontal advection 
    319                                CALL iom_put( "strd_yad" , ptrdy ) 
    320       CASE( jptra_zad  )   ;   CALL iom_put( "ttrd_zad" , ptrdx )        ! z- vertical   advection 
    321                                CALL iom_put( "strd_zad" , ptrdy ) 
    322                                IF( .NOT. lk_vvl ) THEN                   ! cst volume : adv flux through z=0 surface 
    323                                   CALL wrk_alloc( jpi, jpj, z2dx, z2dy ) 
    324                                   z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / fse3t(:,:,1) 
    325                                   z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / fse3t(:,:,1) 
    326                                   CALL iom_put( "ttrd_sad", z2dx ) 
    327                                   CALL iom_put( "strd_sad", z2dy ) 
    328                                   CALL wrk_dealloc( jpi, jpj, z2dx, z2dy ) 
    329                                ENDIF 
    330       CASE( jptra_totad  ) ;   CALL iom_put( "ttrd_totad" , ptrdx )        ! total   advection 
    331                                CALL iom_put( "strd_totad" , ptrdy ) 
    332       CASE( jptra_ldf  )   ;   CALL iom_put( "ttrd_ldf" , ptrdx )        ! lateral diffusion 
    333                                CALL iom_put( "strd_ldf" , ptrdy ) 
    334       CASE( jptra_zdf  )   ;   CALL iom_put( "ttrd_zdf" , ptrdx )        ! vertical diffusion (including Kz contribution) 
    335                                CALL iom_put( "strd_zdf" , ptrdy ) 
    336       CASE( jptra_zdfp )   ;   CALL iom_put( "ttrd_zdfp", ptrdx )        ! PURE vertical diffusion (no isoneutral contribution) 
    337                                CALL iom_put( "strd_zdfp", ptrdy ) 
    338       CASE( jptra_evd )    ;   CALL iom_put( "ttrd_evd", ptrdx )         ! EVD trend (convection) 
    339                                CALL iom_put( "strd_evd", ptrdy ) 
    340       CASE( jptra_iso_x )  ;   CALL iom_put( "ttrd_iso_x", ptrdx )       ! x-component of isopycnal mixing 
    341                                CALL iom_put( "strd_iso_x", ptrdy ) 
    342       CASE( jptra_iso_y )  ;   CALL iom_put( "ttrd_iso_y", ptrdx )       ! y-component of isopycnal mixing 
    343                                CALL iom_put( "strd_iso_y", ptrdy ) 
    344       CASE( jptra_iso_z1 ) ;   CALL iom_put( "ttrd_iso_z1", ptrdx )      ! first part of z-component of isopycnal mixing 
    345                                CALL iom_put( "strd_iso_z1", ptrdy ) 
    346       CASE( jptra_dmp  )   ;   CALL iom_put( "ttrd_dmp" , ptrdx )        ! internal restoring (damping) 
    347                                CALL iom_put( "strd_dmp" , ptrdy ) 
    348       CASE( jptra_bbl  )   ;   CALL iom_put( "ttrd_bbl" , ptrdx )        ! bottom boundary layer 
    349                                CALL iom_put( "strd_bbl" , ptrdy ) 
    350       CASE( jptra_npc  )   ;   CALL iom_put( "ttrd_npc" , ptrdx )        ! static instability mixing 
    351                                CALL iom_put( "strd_npc" , ptrdy ) 
    352       CASE( jptra_nsr  )   ;   CALL iom_put( "ttrd_qns" , ptrdx(:,:,1) )        ! surface forcing + runoff (ln_rnf=T) 
    353                                CALL iom_put( "strd_cdt" , ptrdy(:,:,1) )        ! output as 2D surface fields 
    354       CASE( jptra_qsr  )   ;   CALL iom_put( "ttrd_qsr" , ptrdx )        ! penetrative solar radiat. (only on temperature) 
    355       CASE( jptra_bbc  )   ;   CALL iom_put( "ttrd_bbc" , ptrdx )        ! geothermal heating   (only on temperature) 
    356       CASE( jptra_atf  )   ;   CALL iom_put( "ttrd_atf" , ptrdx )        ! asselin time Filter 
    357                                CALL iom_put( "strd_atf" , ptrdy ) 
    358       CASE( jptra_tot  )   ;   CALL iom_put( "ttrd_tot" , ptrdx )        ! model total trend 
    359                                CALL iom_put( "strd_tot" , ptrdy ) 
    360       END SELECT 
    361       ! 
     303     REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdx   ! Temperature or U trend  
     304     REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdy   ! Salinity    or V trend 
     305     INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index 
     306     INTEGER                   , INTENT(in   ) ::   kt      ! time step 
     307     !! 
     308     INTEGER ::   ji, jj, jk   ! dummy loop indices 
     309     INTEGER ::   ikbu, ikbv   ! local integers 
     310     REAL(wp), POINTER, DIMENSION(:,:)   ::   z2dx, z2dy   ! 2D workspace  
     311     !!---------------------------------------------------------------------- 
     312     ! 
     313     !!gm Rq: mask the trends already masked in trd_tra, but lbc_lnk should probably be added 
     314     ! 
     315     ! Trends evaluated every time step that could go to the standard T file and can be output every ts into a 1ts file if 1ts output is selected 
     316     SELECT CASE( ktrd ) 
     317     ! This total trend is done every time step 
     318     CASE( jptra_tot  )   ;   CALL iom_put( "ttrd_tot" , ptrdx )           ! model total trend 
     319        CALL iom_put( "strd_tot" , ptrdy ) 
     320     END SELECT 
     321 
     322     ! These trends are done every second time step. When 1ts output is selected must go different (2ts) file from standard T-file 
     323     IF( MOD( kt, 2 ) == 0 ) THEN 
     324        SELECT CASE( ktrd ) 
     325        CASE( jptra_xad  )   ;   CALL iom_put( "ttrd_xad" , ptrdx )        ! x- horizontal advection 
     326           CALL iom_put( "strd_xad" , ptrdy ) 
     327        CASE( jptra_yad  )   ;   CALL iom_put( "ttrd_yad" , ptrdx )        ! y- horizontal advection 
     328           CALL iom_put( "strd_yad" , ptrdy ) 
     329        CASE( jptra_zad  )   ;   CALL iom_put( "ttrd_zad" , ptrdx )        ! z- vertical   advection 
     330           CALL iom_put( "strd_zad" , ptrdy ) 
     331           IF( .NOT. lk_vvl ) THEN                   ! cst volume : adv flux through z=0 surface 
     332              CALL wrk_alloc( jpi, jpj, z2dx, z2dy ) 
     333              z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / fse3t(:,:,1) 
     334              z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / fse3t(:,:,1) 
     335              CALL iom_put( "ttrd_sad", z2dx ) 
     336              CALL iom_put( "strd_sad", z2dy ) 
     337              CALL wrk_dealloc( jpi, jpj, z2dx, z2dy ) 
     338           ENDIF 
     339        CASE( jptra_totad  ) ;   CALL iom_put( "ttrd_totad" , ptrdx )      ! total   advection 
     340           CALL iom_put( "strd_totad" , ptrdy ) 
     341        CASE( jptra_ldf  )   ;   CALL iom_put( "ttrd_ldf" , ptrdx )        ! lateral diffusion 
     342           CALL iom_put( "strd_ldf" , ptrdy ) 
     343        CASE( jptra_zdf  )   ;   CALL iom_put( "ttrd_zdf" , ptrdx )        ! vertical diffusion (including Kz contribution) 
     344           CALL iom_put( "strd_zdf" , ptrdy ) 
     345        CASE( jptra_zdfp )   ;   CALL iom_put( "ttrd_zdfp", ptrdx )        ! PURE vertical diffusion (no isoneutral contribution) 
     346           CALL iom_put( "strd_zdfp", ptrdy ) 
     347        CASE( jptra_evd )    ;   CALL iom_put( "ttrd_evd", ptrdx )         ! EVD trend (convection) 
     348           CALL iom_put( "strd_evd", ptrdy ) 
     349        CASE( jptra_dmp  )   ;   CALL iom_put( "ttrd_dmp" , ptrdx )        ! internal restoring (damping) 
     350           CALL iom_put( "strd_dmp" , ptrdy ) 
     351        CASE( jptra_bbl  )   ;   CALL iom_put( "ttrd_bbl" , ptrdx )        ! bottom boundary layer 
     352           CALL iom_put( "strd_bbl" , ptrdy ) 
     353        CASE( jptra_npc  )   ;   CALL iom_put( "ttrd_npc" , ptrdx )        ! static instability mixing 
     354           CALL iom_put( "strd_npc" , ptrdy ) 
     355        CASE( jptra_bbc  )   ;   CALL iom_put( "ttrd_bbc" , ptrdx )        ! geothermal heating   (only on temperature) 
     356        CASE( jptra_nsr  )   ;   CALL iom_put( "ttrd_qns" , ptrdx(:,:,1) ) ! surface forcing + runoff (ln_rnf=T) 
     357           CALL iom_put( "strd_cdt" , ptrdy(:,:,1) )        ! output as 2D surface fields 
     358        CASE( jptra_qsr  )   ;   CALL iom_put( "ttrd_qsr" , ptrdx )        ! penetrative solar radiat. (only on temperature) 
     359        END SELECT 
     360        ! the Asselin filter trend  is also every other time step but needs to be lagged one time step 
     361        ! Even when 1ts output is selected can go to the same (2ts) file as the trends plotted every even time step. 
     362     ELSE IF( MOD( kt, 2 ) == 1 ) THEN 
     363        SELECT CASE( ktrd ) 
     364        CASE( jptra_atf  )   ;   CALL iom_put( "ttrd_atf" , ptrdx )        ! asselin time Filter 
     365           CALL iom_put( "strd_atf" , ptrdy ) 
     366        END SELECT 
     367     END IF 
     368     ! 
    362369   END SUBROUTINE trd_tra_iom 
    363370 
Note: See TracChangeset for help on using the changeset viewer.