Changeset 7083 for branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC
- Timestamp:
- 2016-10-25T12:12:41+02:00 (8 years ago)
- Location:
- branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 18 edited
-
DIA/diaar5.F90 (modified) (4 diffs)
-
DYN/dynzdf_imp.F90 (modified) (1 diff)
-
ICB/icbini.F90 (modified) (5 diffs)
-
LDF/ldfeiv.F90 (modified) (1 diff)
-
SBC/sbcblk_core.F90 (modified) (1 diff)
-
SBC/sbccpl.F90 (modified) (17 diffs)
-
TRA/eosbn2.F90 (modified) (2 diffs)
-
TRA/traadv.F90 (modified) (4 diffs)
-
TRA/traadv_eiv.F90 (modified) (5 diffs)
-
TRA/traadv_tvd.F90 (modified) (5 diffs)
-
TRA/traldf_iso.F90 (modified) (7 diffs)
-
TRA/tranxt.F90 (modified) (2 diffs)
-
TRA/trasbc.F90 (modified) (1 diff)
-
TRD/trd_oce.F90 (modified) (2 diffs)
-
TRD/trdini.F90 (modified) (1 diff)
-
TRD/trdtra.F90 (modified) (7 diffs)
-
ZDF/zdfevd.F90 (modified) (2 diffs)
-
oce.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r6731 r7083 212 212 REAL(wp) :: zztmp 213 213 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zsaldta ! Jan/Dec levitus salinity 214 ! reading initial file215 LOGICAL :: ln_tsd_init !: T & S data flag216 LOGICAL :: ln_tsd_tradmp !: internal damping toward input data flag217 CHARACTER(len=100) :: cn_dir218 TYPE(FLD_N) :: sn_tem,sn_sal219 INTEGER :: ios=0220 221 NAMELIST/namtsd/ ln_tsd_init,ln_tsd_tradmp,cn_dir,sn_tem,sn_sal222 !223 224 REWIND( numnam_ref ) ! Namelist namtsd in reference namelist :225 READ ( numnam_ref, namtsd, IOSTAT = ios, ERR = 901)226 901 IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtsd in reference namelist for dia_ar5', lwp )227 REWIND( numnam_cfg ) ! Namelist namtsd in configuration namelist : Parameters of the run228 READ ( numnam_cfg, namtsd, IOSTAT = ios, ERR = 902 )229 902 IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtsd in configuration namelist for dia_ar5', lwp )230 IF(lwm) WRITE ( numond, namtsd )231 214 ! 232 215 !!---------------------------------------------------------------------- … … 234 217 IF( nn_timing == 1 ) CALL timing_start('dia_ar5_init') 235 218 ! 236 CALL wrk_alloc( jpi , jpj , jpk, jpts, zsaldta )219 CALL wrk_alloc( jpi, jpj, jpk, 2, zsaldta ) 237 220 ! ! allocate dia_ar5 arrays 238 221 IF( dia_ar5_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) … … 250 233 IF( lk_mpp ) CALL mpp_sum( vol0 ) 251 234 252 CALL iom_open ( TRIM( cn_dir )//TRIM(sn_sal%clname), inum )253 CALL iom_get ( inum, jpdom_data, TRIM(sn_sal%clvar), zsaldta(:,:,:,1), 1 )254 CALL iom_get ( inum, jpdom_data, TRIM(sn_sal%clvar), zsaldta(:,:,:,2), 12 )235 CALL iom_open ( 'sali_ref_clim_monthly', inum ) 236 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1 ) 237 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,2), 12 ) 255 238 CALL iom_close( inum ) 239 256 240 sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) ) 257 241 sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) … … 268 252 ENDIF 269 253 ! 270 CALL wrk_dealloc( jpi , jpj , jpk, jpts, zsaldta )254 CALL wrk_dealloc( jpi, jpj, jpk, 2, zsaldta ) 271 255 ! 272 256 IF( nn_timing == 1 ) CALL timing_stop('dia_ar5_init') -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r6486 r7083 323 323 ze3va = ( 1._wp - r_vvl ) * fse3v_n(ji,jj,1) + r_vvl * fse3v_a(ji,jj,1) 324 324 va(ji,jj,1) = va(ji,jj,1) + p2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) & 325 & / ( ze3va * rau0 ) 325 & / ( ze3va * rau0 ) * vmask(ji,jj,1) 326 326 #else 327 327 va(ji,jj,1) = vb(ji,jj,1) & 328 328 & + p2dt *(va(ji,jj,1) + 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) & 329 & / ( fse3v(ji,jj,1) * rau0 ))329 & / ( fse3v(ji,jj,1) * rau0 ) * vmask(ji,jj,1) ) 330 330 #endif 331 331 END DO -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/ICB/icbini.F90
r6486 r7083 120 120 ! first entry with narea for this processor is left hand interior index 121 121 ! last entry is right hand interior index 122 jj = jpj/2122 jj = nlcj/2 123 123 nicbdi = -1 124 124 nicbei = -1 … … 136 136 ! 137 137 ! repeat for j direction 138 ji = jpi/2138 ji = nlci/2 139 139 nicbdj = -1 140 140 nicbej = -1 … … 153 153 ! special for east-west boundary exchange we save the destination index 154 154 i1 = MAX( nicbdi-1, 1) 155 i3 = INT( src_calving(i1, jpj/2) )155 i3 = INT( src_calving(i1,nlcj/2) ) 156 156 jj = INT( i3/nicbpack ) 157 157 ricb_left = REAL( i3 - nicbpack*jj, wp ) 158 158 i1 = MIN( nicbei+1, jpi ) 159 i3 = INT( src_calving(i1, jpj/2) )159 i3 = INT( src_calving(i1,nlcj/2) ) 160 160 jj = INT( i3/nicbpack ) 161 161 ricb_right = REAL( i3 - nicbpack*jj, wp ) … … 196 196 WRITE(numicb,*) 'berg left ', ricb_left 197 197 WRITE(numicb,*) 'berg right ', ricb_right 198 jj = jpj/2198 jj = nlcj/2 199 199 WRITE(numicb,*) "central j line:" 200 200 WRITE(numicb,*) "i processor" … … 202 202 WRITE(numicb,*) "i point" 203 203 WRITE(numicb,*) (INT(src_calving(ji,jj)), ji=1,jpi) 204 ji = jpi/2204 ji = nlci/2 205 205 WRITE(numicb,*) "central i line:" 206 206 WRITE(numicb,*) "j processor" -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv.F90
r6486 r7083 157 157 END DO 158 158 ENDIF 159 160 ! ORCA R1: Take the minimum between aeiw and aeiv0 161 IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN 162 DO jj = 2, jpjm1 163 DO ji = fs_2, fs_jpim1 ! vector opt. 164 aeiw(ji,jj) = MIN( aeiw(ji,jj), aeiv0 ) 165 END DO 166 END DO 167 ENDIF 168 159 169 CALL lbc_lnk( aeiw, 'W', 1. ) ! lateral boundary condition on aeiw 160 170 -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r6498 r7083 206 206 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 207 207 qlw_ice(:,:,1) = sf(jp_qlw)%fnow(:,:,1) 208 qsr_ice(:,:,1) = sf(jp_qsr)%fnow(:,:,1) 208 IF( ln_dm2dc ) THEN ; qsr_ice(:,:,1) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) 209 ELSE ; qsr_ice(:,:,1) = sf(jp_qsr)%fnow(:,:,1) 210 ENDIF 209 211 tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1) 210 212 qatm_ice(:,:) = sf(jp_humi)%fnow(:,:,1) -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r7033 r7083 1618 1618 !! *** ROUTINE sbc_cpl_ice_flx *** 1619 1619 !! 1620 !! ** Purpose : provide the heat and freshwater fluxes of the 1621 !! ocean-ice system. 1620 !! ** Purpose : provide the heat and freshwater fluxes of the ocean-ice system 1622 1621 !! 1623 1622 !! ** Method : transform the fields received from the atmosphere into 1624 1623 !! surface heat and fresh water boundary condition for the 1625 1624 !! ice-ocean system. The following fields are provided: 1626 !! * total non solar, solar and freshwater fluxes (qns_tot,1625 !! * total non solar, solar and freshwater fluxes (qns_tot, 1627 1626 !! qsr_tot and emp_tot) (total means weighted ice-ocean flux) 1628 1627 !! NB: emp_tot include runoffs and calving. 1629 !! * fluxes over ice (qns_ice, qsr_ice, emp_ice) where1628 !! * fluxes over ice (qns_ice, qsr_ice, emp_ice) where 1630 1629 !! emp_ice = sublimation - solid precipitation as liquid 1631 1630 !! precipitation are re-routed directly to the ocean and 1632 !! runoffs and calving directly enter the ocean.1633 !! * solid precipitation (sprecip), used to add to qns_tot1631 !! calving directly enter the ocean (runoffs are read but included in trasbc.F90) 1632 !! * solid precipitation (sprecip), used to add to qns_tot 1634 1633 !! the heat lost associated to melting solid precipitation 1635 1634 !! over the ocean fraction. 1636 !! ===>> CAUTION here this changes the net heat flux received from 1637 !! the atmosphere 1638 !! 1639 !! - the fluxes have been separated from the stress as 1640 !! (a) they are updated at each ice time step compare to 1641 !! an update at each coupled time step for the stress, and 1642 !! (b) the conservative computation of the fluxes over the 1643 !! sea-ice area requires the knowledge of the ice fraction 1644 !! after the ice advection and before the ice thermodynamics, 1645 !! so that the stress is updated before the ice dynamics 1646 !! while the fluxes are updated after it. 1635 !! * heat content of rain, snow and evap can also be provided, 1636 !! otherwise heat flux associated with these mass flux are 1637 !! guessed (qemp_oce, qemp_ice) 1638 !! 1639 !! - the fluxes have been separated from the stress as 1640 !! (a) they are updated at each ice time step compare to 1641 !! an update at each coupled time step for the stress, and 1642 !! (b) the conservative computation of the fluxes over the 1643 !! sea-ice area requires the knowledge of the ice fraction 1644 !! after the ice advection and before the ice thermodynamics, 1645 !! so that the stress is updated before the ice dynamics 1646 !! while the fluxes are updated after it. 1647 !! 1648 !! ** Details 1649 !! qns_tot = pfrld * qns_oce + ( 1 - pfrld ) * qns_ice => provided 1650 !! + qemp_oce + qemp_ice => recalculated and added up to qns 1651 !! 1652 !! qsr_tot = pfrld * qsr_oce + ( 1 - pfrld ) * qsr_ice => provided 1653 !! 1654 !! emp_tot = emp_oce + emp_ice => calving is provided and added to emp_tot (and emp_oce) 1655 !! river runoff (rnf) is provided but not included here 1647 1656 !! 1648 1657 !! ** Action : update at each nf_ice time step: 1649 1658 !! qns_tot, qsr_tot non-solar and solar total heat fluxes 1650 1659 !! qns_ice, qsr_ice non-solar and solar heat fluxes over the ice 1651 !! emp_tot total evaporation - precipitation(liquid and solid) (-runoff)(-calving)1652 !! emp_ice 1653 !! dqns_ice 1654 !! sprecip 1660 !! emp_tot total evaporation - precipitation(liquid and solid) (-calving) 1661 !! emp_ice ice sublimation - solid precipitation over the ice 1662 !! dqns_ice d(non-solar heat flux)/d(Temperature) over the ice 1663 !! sprecip solid precipitation over the ocean 1655 1664 !!---------------------------------------------------------------------- 1656 1665 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction [0 to 1] … … 1662 1671 INTEGER :: jl ! dummy loop index 1663 1672 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, ztmp, zicefr, zmsk, zsnw 1664 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap , zevap_ice, zdevap_ice1673 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice 1665 1674 REAL(wp), POINTER, DIMENSION(:,: ) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 1666 1675 REAL(wp), POINTER, DIMENSION(:,:,:) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice … … 1670 1679 ! 1671 1680 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zsnw ) 1672 CALL wrk_alloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap , zevap_ice, zdevap_ice )1681 CALL wrk_alloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 1673 1682 CALL wrk_alloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 1674 1683 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice ) … … 1679 1688 ! 1680 1689 ! ! ========================= ! 1681 ! ! freshwater budget ! (emp )1690 ! ! freshwater budget ! (emp_tot) 1682 1691 ! ! ========================= ! 1683 1692 ! 1684 ! ! total Precipitation - total Evaporation (emp_tot)1685 ! ! solid precipitation - sublimation (emp_ice)1686 ! ! solid Precipitation (sprecip)1687 ! ! liquid + solid Precipitation (tprecip)1693 ! ! solid Precipitation (sprecip) 1694 ! ! liquid + solid Precipitation (tprecip) 1695 ! ! total Evaporation - total Precipitation (emp_tot) 1696 ! ! sublimation - solid precipitation (cell average) (emp_ice) 1688 1697 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 1689 1698 CASE( 'conservative' ) ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp … … 1717 1726 ENDIF 1718 1727 #else 1719 zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1)1728 zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * zicefr(:,:) 1720 1729 #endif 1721 1730 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) * tmask(:,:,1) ) ! liquid precipitation … … 1733 1742 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1734 1743 zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 1735 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 1744 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * zicefr(:,:) 1736 1745 zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 1737 1746 ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) … … 1739 1748 1740 1749 #if defined key_lim3 1741 ! zsnw = snow percentage over ice after wind blowing 1742 zsnw(:,:) = 0._wp 1743 CALL lim_thd_snwblow( p_frld, zsnw ) 1750 ! zsnw = snow fraction over ice after wind blowing 1751 zsnw(:,:) = 0._wp ; CALL lim_thd_snwblow( p_frld, zsnw ) 1744 1752 1745 ! --- evaporation (kg/m2/s) --- ! 1753 ! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- ! 1754 zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( zicefr(:,:) - zsnw(:,:) ) ! emp_ice = A * sublimation - zsnw * sprecip 1755 zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:) ! emp_oce = emp_tot - emp_ice 1756 1757 ! --- evaporation over ocean (used later for qemp) --- ! 1758 zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 1759 1760 ! --- evaporation over ice (kg/m2/s) --- ! 1746 1761 zevap_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) 1747 1762 ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0 … … 1749 1764 zdevap_ice(:,:) = 0._wp 1750 1765 1751 ! --- evaporation minus precipitation corrected for the effect of wind blowing on snow --- ! 1752 zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:) - zsprecip * (1._wp - zsnw) 1753 zemp_ice(:,:) = zemp_ice(:,:) + zsprecip * (1._wp - zsnw) 1754 1755 ! Sublimation over sea-ice (cell average) 1756 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea', zevap_ice(:,:) * zicefr(:,:) ) 1757 ! runoffs and calving (put in emp_tot) 1766 ! --- runoffs (included in emp later on) --- ! 1758 1767 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1768 1769 ! --- calving (put in emp_tot and emp_oce) --- ! 1759 1770 IF( srcv(jpr_cal)%laction ) THEN 1760 1771 zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 1772 zemp_oce(:,:) = zemp_oce(:,:) - frcv(jpr_cal)%z3(:,:,1) 1761 1773 CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) ) 1762 1774 ENDIF … … 1784 1796 ENDIF 1785 1797 1786 CALL iom_put( 'snowpre' , sprecip ) ! Snow 1787 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea', sprecip(:,:) * ( 1._wp - zsnw ) ) ! Snow over ice-free ocean (cell average) 1788 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zsnw ) ! Snow over sea-ice (cell average) 1798 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea', zevap_ice(:,:) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1799 CALL iom_put( 'snowpre' , sprecip(:,:) ) ! Snow 1800 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea', sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average) 1801 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average) 1789 1802 #else 1790 ! Sublimation over sea-ice (cell average)1791 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )1792 1803 ! runoffs and calving (put in emp_tot) 1793 1804 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) … … 1821 1832 SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) ! non solar heat fluxes ! (qns) 1822 1833 ! ! ========================= ! 1823 CASE( 'oce only' ) 1824 zqns_tot(:,: 1825 CASE( 'conservative' ) 1826 zqns_tot(:,: 1834 CASE( 'oce only' ) ! the required field is directly provided 1835 zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 1836 CASE( 'conservative' ) ! the required fields are directly provided 1837 zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 1827 1838 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1828 1839 zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 1829 1840 ELSE 1830 ! Set all category values equal for the moment1831 1841 DO jl=1,jpl 1832 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1842 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) ! Set all category values equal 1833 1843 ENDDO 1834 1844 ENDIF 1835 CASE( 'oce and ice' ) 1836 zqns_tot(:,: 1845 CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes 1846 zqns_tot(:,:) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 1837 1847 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1838 1848 DO jl=1,jpl … … 1841 1851 ENDDO 1842 1852 ELSE 1843 qns_tot(:,: 1853 qns_tot(:,:) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1844 1854 DO jl=1,jpl 1845 1855 zqns_tot(:,: ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) … … 1847 1857 ENDDO 1848 1858 ENDIF 1849 CASE( 'mixed oce-ice' ) 1859 CASE( 'mixed oce-ice' ) ! the ice flux is cumputed from the total flux, the SST and ice informations 1850 1860 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1851 1861 zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1852 1862 zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) & 1853 1863 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:) & 1854 & + pist(:,:,1)* zicefr(:,:) ) )1864 & + pist(:,:,1) * zicefr(:,:) ) ) 1855 1865 END SELECT 1856 1866 !!gm … … 1862 1872 !! similar job should be done for snow and precipitation temperature 1863 1873 ! 1864 IF( srcv(jpr_cal)%laction ) THEN ! Iceberg melting 1865 ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting 1866 zqns_tot(:,:) = zqns_tot(:,:) - ztmp(:,:) 1867 IF( iom_use('hflx_cal_cea') ) & 1868 CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from calving 1869 ENDIF 1870 1871 ztmp(:,:) = p_frld(:,:) * zsprecip(:,:) * lfus 1872 IF( iom_use('hflx_snow_cea') ) CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average) 1874 IF( srcv(jpr_cal)%laction ) THEN ! Iceberg melting 1875 zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting 1876 ! we suppose it melts at 0deg, though it should be temp. of surrounding ocean 1877 IF( iom_use('hflx_cal_cea') ) CALL iom_put( 'hflx_cal_cea', - frcv(jpr_cal)%z3(:,:,1) * lfus ) ! heat flux from calving 1878 ENDIF 1873 1879 1874 1880 #if defined key_lim3 1875 ! --- evaporation --- !1876 zevap(:,:) = zemp_tot(:,:) + ztprecip(:,:) ! evaporation over ocean1877 1878 1881 ! --- non solar flux over ocean --- ! 1879 1882 ! note: p_frld cannot be = 0 since we limit the ice concentration to amax … … 1882 1885 1883 1886 ! --- heat flux associated with emp (W/m2) --- ! 1884 zqemp_oce(:,:) = - zevap(:,:) * p_frld(:,:) * zcptn(:,:) &! evap1885 & + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptn(:,:) & ! liquid precip1886 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean1887 zqemp_oce(:,:) = - zevap_oce(:,:) * zcptn(:,:) & ! evap 1888 & + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptn(:,:) & ! liquid precip 1889 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean + snow melting 1887 1890 ! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptn(:,:) & ! ice evap 1888 1891 ! & + zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice 1889 1892 zqemp_ice(:,:) = zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice (only) 1890 ! qevap_ice=0 since we consider Tice=0 °C1893 ! qevap_ice=0 since we consider Tice=0degC 1891 1894 1892 ! --- heat content ofprecip over ice in J/m3 (to be used in 1D-thermo) --- !1895 ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- ! 1893 1896 zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus ) 1894 1897 1895 1898 ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- ! 1896 1899 DO jl = 1, jpl 1897 zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * cpic ) but we do not have Tice, so we consider Tice=0 °C1900 zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * cpic ) but we do not have Tice, so we consider Tice=0degC 1898 1901 END DO 1899 1902 … … 1921 1924 qemp_ice (:,: ) = zqemp_ice (:,: ) 1922 1925 ENDIF 1926 1927 !! clem: we should output qemp_oce and qemp_ice (at least) 1928 IF( iom_use('hflx_snow_cea') ) CALL iom_put( 'hflx_snow_cea', sprecip(:,:) * ( zcptn(:,:) - Lfus ) ) ! heat flux from snow (cell average) 1929 !! these diags are not outputed yet 1930 !! IF( iom_use('hflx_rain_cea') ) CALL iom_put( 'hflx_rain_cea', ( tprecip(:,:) - sprecip(:,:) ) * zcptn(:,:) ) ! heat flux from rain (cell average) 1931 !! IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put( 'hflx_snow_ao_cea', sprecip(:,:) * ( zcptn(:,:) - Lfus ) * (1._wp - zsnw(:,:)) ) ! heat flux from snow (cell average) 1932 !! IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put( 'hflx_snow_ai_cea', sprecip(:,:) * ( zcptn(:,:) - Lfus ) * zsnw(:,:) ) ! heat flux from snow (cell average) 1933 1923 1934 #else 1924 1935 ! clem: this formulation is certainly wrong... but better than it was... … … 1927 1938 & - (p_frld(:,:) * zsprecip(:,:) * lfus) & ! remove the latent heat flux of solid precip. melting 1928 1939 & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 1929 & - zemp_ice(:,:) * zicefr(:,:)) * zcptn(:,:)1940 & - zemp_ice(:,:) ) * zcptn(:,:) 1930 1941 1931 1942 IF( ln_mixcpl ) THEN … … 2047 2058 2048 2059 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zsnw ) 2049 CALL wrk_dealloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap , zevap_ice, zdevap_ice )2060 CALL wrk_dealloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 2050 2061 CALL wrk_dealloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 2051 2062 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice ) -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
r6498 r7083 1018 1018 DO jj = 1, jpj 1019 1019 DO ji = 1, jpi 1020 zs= SQRT( ABS( psal(ji,jj) ) * r1_S0) ! square root salinity1020 zs= SQRT( ABS( psal(ji,jj) ) / 35.16504_wp ) ! square root salinity 1021 1021 ptf(ji,jj) = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs & 1022 1022 & - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp … … 1066 1066 CASE ( -1, 1 ) !== CT,SA (TEOS-10 formulation) ==! 1067 1067 ! 1068 zs = SQRT( ABS( psal ) * r1_S0) ! square root salinity1068 zs = SQRT( ABS( psal ) / 35.16504_wp ) ! square root salinity 1069 1069 ptf = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs & 1070 1070 & - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
r6486 r7083 26 26 USE cla ! cross land advection (cla_traadv routine) 27 27 USE ldftra_oce ! lateral diffusion coefficient on tracers 28 USE trd_oce ! trends: ocean variables 29 USE trdtra ! trends manager: tracers 28 30 ! 29 31 USE in_out_manager ! I/O manager … … 79 81 INTEGER :: jk ! dummy loop index 80 82 REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn 83 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds ! 3D workspace 81 84 !!---------------------------------------------------------------------- 82 85 ! … … 120 123 IF( ln_diaptr ) CALL dia_ptr( zvn ) ! diagnose the effective MSF 121 124 ! 122 125 IF( l_trdtra ) THEN !* Save ta and sa trends 126 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 127 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 128 ztrds(:,:,:) = tsa(:,:,:,jp_sal) 129 ENDIF 130 ! 123 131 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! 124 132 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, nit000, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! 2nd order centered … … 151 159 END SELECT 152 160 ! 161 IF( l_trdtra ) THEN ! save the advective trends for further diagnostics 162 DO jk = 1, jpkm1 163 ztrdt(:,:,jk) = tsa(:,:,jk,jp_tem) - ztrdt(:,:,jk) 164 ztrds(:,:,jk) = tsa(:,:,jk,jp_sal) - ztrds(:,:,jk) 165 END DO 166 CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrdt ) 167 CALL trd_tra( kt, 'TRA', jp_sal, jptra_totad, ztrds ) 168 CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 169 ENDIF 153 170 ! ! print mean trends (used for debugging) 154 171 IF(ln_ctl) CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv - Ta: ', mask1=tmask, & -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90
r6919 r7083 79 79 # endif 80 80 REAL(wp), POINTER, DIMENSION(:,:) :: zu_eiv, zv_eiv, zw_eiv, z2d 81 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d 81 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d, z3d_T 82 82 !!---------------------------------------------------------------------- 83 83 ! … … 86 86 # if defined key_diaeiv 87 87 CALL wrk_alloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv, z2d ) 88 IF( ln_diaptr ) CALL wrk_alloc( jpi, jpj, jpk, z3d)88 CALL wrk_alloc( jpi, jpj, jpk, z3d, z3d_T ) 89 89 # else 90 90 CALL wrk_alloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv ) … … 170 170 CALL iom_put( "weiv_masstr" , z3d ) 171 171 ENDIF 172 IF( iom_use("ueiv_masstr") .OR. iom_use("ueiv_heattr") ) THEN 172 IF( iom_use("ueiv_masstr") .OR. iom_use("ueiv_heattr") .OR. iom_use('ueiv_heattr3d') & 173 .OR. iom_use("ueiv_salttr") .OR. iom_use('ueiv_salttr3d') ) THEN 173 174 z3d(:,:,jpk) = 0.e0 174 z2d(:,:) = 0.e0175 175 DO jk = 1, jpkm1 176 176 z3d(:,:,jk) = rau0 * u_eiv(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk) 177 z2d(:,:) = z2d(:,:) + z3d(:,:,jk)178 177 END DO 179 178 CALL iom_put( "ueiv_masstr", z3d ) ! mass transport in i-direction 180 179 ENDIF 181 180 182 IF( iom_use('ueiv_heattr') ) THEN181 IF( iom_use('ueiv_heattr') .OR. iom_use('ueiv_heattr3d') ) THEN 183 182 zztmp = 0.5 * rcp 184 183 z2d(:,:) = 0.e0 185 DO jk = 1, jpkm1 186 DO jj = 2, jpjm1 187 DO ji = fs_2, fs_jpim1 ! vector opt. 188 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 189 END DO 190 END DO 191 END DO 192 CALL lbc_lnk( z2d, 'U', -1. ) 193 CALL iom_put( "ueiv_heattr", zztmp * z2d ) ! heat transport in i-direction 194 ENDIF 195 196 IF( iom_use("veiv_masstr") .OR. iom_use("veiv_heattr") ) THEN 184 z3d_T(:,:,:) = 0.e0 185 DO jk = 1, jpkm1 186 DO jj = 2, jpjm1 187 DO ji = fs_2, fs_jpim1 ! vector opt. 188 z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 189 z2d(ji,jj) = z2d(ji,jj) + z3d_T(ji,jj,jk) 190 END DO 191 END DO 192 END DO 193 IF (iom_use('ueiv_heattr') ) THEN 194 CALL lbc_lnk( z2d, 'U', -1. ) 195 CALL iom_put( "ueiv_heattr", zztmp * z2d ) ! 2D heat transport in i-direction 196 ENDIF 197 IF (iom_use('ueiv_heattr3d') ) THEN 198 CALL lbc_lnk( z3d_T, 'U', -1. ) 199 CALL iom_put( "ueiv_heattr3d", zztmp * z3d_T ) ! 3D heat transport in i-direction 200 ENDIF 201 ENDIF 202 203 IF( iom_use('ueiv_salttr') .OR. iom_use('ueiv_salttr3d') ) THEN 204 zztmp = 0.5 * 0.001 205 z2d(:,:) = 0.e0 206 z3d_T(:,:,:) = 0.e0 207 DO jk = 1, jpkm1 208 DO jj = 2, jpjm1 209 DO ji = fs_2, fs_jpim1 ! vector opt. 210 z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 211 z2d(ji,jj) = z2d(ji,jj) + z3d_T(ji,jj,jk) 212 END DO 213 END DO 214 END DO 215 IF (iom_use('ueiv_salttr') ) THEN 216 CALL lbc_lnk( z2d, 'U', -1. ) 217 CALL iom_put( "ueiv_salttr", zztmp * z2d ) ! 2D salt transport in i-direction 218 ENDIF 219 IF (iom_use('ueiv_salttr3d') ) THEN 220 CALL lbc_lnk( z3d_T, 'U', -1. ) 221 CALL iom_put( "ueiv_salttr3d", zztmp * z3d_T ) ! 3D salt transport in i-direction 222 ENDIF 223 ENDIF 224 225 IF( iom_use("veiv_masstr") .OR. iom_use("veiv_heattr") .OR. iom_use('veiv_heattr3d') & 226 .OR. iom_use("veiv_salttr") .OR. iom_use('veiv_salttr3d') ) THEN 197 227 z3d(:,:,jpk) = 0.e0 198 z2d(:,:) = 0.e0199 228 DO jk = 1, jpkm1 200 229 z3d(:,:,jk) = rau0 * v_eiv(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) * vmask(:,:,jk) … … 202 231 CALL iom_put( "veiv_masstr", z3d ) ! mass transport in j-direction 203 232 ENDIF 204 205 IF( iom_use('veiv_heattr') ) THEN 233 IF( iom_use('veiv_heattr') .OR. iom_use('veiv_heattr3d') ) THEN 206 234 zztmp = 0.5 * rcp 207 235 z2d(:,:) = 0.e0 208 DO jk = 1, jpkm1 209 DO jj = 2, jpjm1 210 DO ji = fs_2, fs_jpim1 ! vector opt. 211 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 212 END DO 213 END DO 214 END DO 215 CALL lbc_lnk( z2d, 'V', -1. ) 216 CALL iom_put( "veiv_heattr", zztmp * z2d ) ! heat transport in j-direction 217 ENDIF 236 z3d_T(:,:,:) = 0.e0 237 DO jk = 1, jpkm1 238 DO jj = 2, jpjm1 239 DO ji = fs_2, fs_jpim1 ! vector opt. 240 z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 241 z2d(ji,jj) = z2d(ji,jj) + z3d_T(ji,jj,jk) 242 END DO 243 END DO 244 END DO 245 IF (iom_use('veiv_heattr') ) THEN 246 CALL lbc_lnk( z2d, 'V', -1. ) 247 CALL iom_put( "veiv_heattr", zztmp * z2d ) ! 2D heat transport in j-direction 248 ENDIF 249 IF (iom_use('veiv_heattr3d') ) THEN 250 CALL lbc_lnk( z3d_T, 'V', -1. ) 251 CALL iom_put( "veiv_heattr3d", zztmp * z3d_T ) ! 3D heat transport in j-direction 252 ENDIF 253 ENDIF 254 255 IF( iom_use('veiv_salttr') .OR. iom_use('veiv_salttr3d') ) THEN 256 zztmp = 0.5 * 0.001 257 z2d(:,:) = 0.e0 258 z3d_T(:,:,:) = 0.e0 259 DO jk = 1, jpkm1 260 DO jj = 2, jpjm1 261 DO ji = fs_2, fs_jpim1 ! vector opt. 262 z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 263 z2d(ji,jj) = z2d(ji,jj) + z3d_T(ji,jj,jk) 264 END DO 265 END DO 266 END DO 267 IF (iom_use('veiv_salttr') ) THEN 268 CALL lbc_lnk( z2d, 'V', -1. ) 269 CALL iom_put( "veiv_salttr", zztmp * z2d ) ! 2D salt transport in i-direction 270 ENDIF 271 IF (iom_use('veiv_salttr3d') ) THEN 272 CALL lbc_lnk( z3d_T, 'V', -1. ) 273 CALL iom_put( "veiv_salttr3d", zztmp * z3d_T ) ! 3D salt transport in i-direction 274 ENDIF 275 ENDIF 276 277 IF( iom_use('weiv_masstr') .OR. iom_use('weiv_heattr3d') .OR. iom_use('weiv_salttr3d')) THEN ! vertical mass transport & its square value 278 z2d(:,:) = rau0 * e12t(:,:) 279 DO jk = 1, jpk 280 z3d(:,:,jk) = w_eiv(:,:,jk) * z2d(:,:) 281 END DO 282 CALL iom_put( "weiv_masstr" , z3d ) ! mass transport in k-direction 283 ENDIF 284 285 IF( iom_use('weiv_heattr3d') ) THEN 286 zztmp = 0.5 * rcp 287 DO jk = 1, jpkm1 288 DO jj = 2, jpjm1 289 DO ji = fs_2, fs_jpim1 ! vector opt. 290 z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj,jk+1,jp_tem) ) 291 END DO 292 END DO 293 END DO 294 CALL lbc_lnk( z3d_T, 'T', 1. ) 295 CALL iom_put( "weiv_heattr3d", zztmp * z3d_T ) ! 3D heat transport in k-direction 296 ENDIF 297 298 IF( iom_use('weiv_salttr3d') ) THEN 299 zztmp = 0.5 * 0.001 300 DO jk = 1, jpkm1 301 DO jj = 2, jpjm1 302 DO ji = fs_2, fs_jpim1 ! vector opt. 303 z3d_T(ji,jj,jk) = z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj,jk+1,jp_sal) ) 304 END DO 305 END DO 306 END DO 307 CALL lbc_lnk( z3d_T, 'T', 1. ) 308 CALL iom_put( "weiv_salttr3d", zztmp * z3d_T ) ! 3D salt transport in k-direction 309 ENDIF 310 218 311 END IF 219 312 ! … … 244 337 # if defined key_diaeiv 245 338 CALL wrk_dealloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv, z2d ) 246 IF( ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, z3d)339 CALL wrk_dealloc( jpi, jpj, jpk, z3d, z3d_T ) 247 340 # else 248 341 CALL wrk_dealloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv ) -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r6731 r7083 184 184 DO jj = 2, jpjm1 185 185 DO ji = fs_2, fs_jpim1 ! vector opt. 186 zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )187 186 ! total intermediate advective trends 188 ztra = - zbtr *( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) &189 & 190 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1))187 ztra = - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & 188 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) & 189 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) / e1e2t(ji,jj) 191 190 ! update and guess with monotonic sheme 192 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra* tmask(ji,jj,jk)193 zwi(ji,jj,jk) = ( ptb(ji,jj,jk,jn) + z2dtt * ztra) * tmask(ji,jj,jk)191 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra / fse3t_n(ji,jj,jk) * tmask(ji,jj,jk) 192 zwi(ji,jj,jk) = ( fse3t_b(ji,jj,jk) * ptb(ji,jj,jk,jn) + z2dtt * ztra ) / fse3t_a(ji,jj,jk) * tmask(ji,jj,jk) 194 193 END DO 195 194 END DO … … 454 453 DO jj = 2, jpjm1 455 454 DO ji = fs_2, fs_jpim1 ! vector opt. 456 zbtr = 1._wp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )457 455 ! total intermediate advective trends 458 ztra = - zbtr *( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) &459 & 460 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1))456 ztra = - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & 457 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) & 458 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) / e1e2t(ji,jj) 461 459 ! update and guess with monotonic sheme 462 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra463 zwi(ji,jj,jk) = ( ptb(ji,jj,jk,jn) + z2dtt * ztra) * tmask(ji,jj,jk)460 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra / fse3t_n(ji,jj,jk) * tmask(ji,jj,jk) 461 zwi(ji,jj,jk) = ( fse3t_b(ji,jj,jk) * ptb(ji,jj,jk,jn) + z2dtt * ztra ) / fse3t_a(ji,jj,jk) * tmask(ji,jj,jk) 464 462 END DO 465 463 END DO … … 479 477 ! -------------------------------------------------- 480 478 ! antidiffusive flux on i and j 481 482 479 ! 483 480 DO jk = 1, jpkm1 484 481 ! 485 482 DO jj = 1, jpjm1 486 483 DO ji = 1, fs_jpim1 ! vector opt. … … 513 510 ! 514 511 ztrs(:,:,:,1) = ptb(:,:,:,jn) 512 ztrs(:,:,1,2) = ptb(:,:,1,jn) 513 ztrs(:,:,1,3) = ptb(:,:,1,jn) 515 514 zwzts(:,:,:) = 0._wp 516 515 … … 614 613 END SUBROUTINE tra_adv_tvd_zts 615 614 615 616 616 SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, p2dt ) 617 617 !!--------------------------------------------------------------------- -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r6731 r7083 26 26 USE ldfslp ! iso-neutral slopes 27 27 USE diaptr ! poleward transport diagnostics 28 USE trd_oce ! trends: ocean variables 29 USE trdtra ! trends manager: tracers 28 30 USE in_out_manager ! I/O manager 29 31 USE iom ! I/O library … … 105 107 INTEGER :: ji, jj, jk, jn ! dummy loop indices 106 108 INTEGER :: ikt 107 REAL(wp) :: zmsku, zabe1, zcof1, zcoef3 ! local scalars108 REAL(wp) :: zmskv, zabe2, zcof2, zcoef4 ! - -109 REAL(wp) :: zcoef0, zbtr , ztra! - -109 REAL(wp) :: zmsku, zabe1, zcof1, zcoef3 ! local scalars 110 REAL(wp) :: zmskv, zabe2, zcof2, zcoef4 ! - - 111 REAL(wp) :: zcoef0, zbtr ! - - 110 112 REAL(wp), POINTER, DIMENSION(:,: ) :: z2d 111 113 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdkt, zdk1t, zdit, zdjt, ztfw 114 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: ztrax, ztray, ztraz 115 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: ztrax_T, ztray_T, ztraz_T 112 116 !!---------------------------------------------------------------------- 113 117 ! … … 115 119 ! 116 120 CALL wrk_alloc( jpi, jpj, z2d ) 117 CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt, ztfw, zdkt, zdk1t ) 121 CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt, ztfw, zdkt, zdk1t) 122 ALLOCATE( ztrax(jpi,jpj,jpk), ztray(jpi,jpj,jpk), ztraz(jpi,jpj,jpk) ) 123 IF( l_trdtra .and. cdtype == 'TRA' ) ALLOCATE( ztrax_T(jpi,jpj,jpk), ztray_T(jpi,jpj,jpk), ztraz_T(jpi,jpj,jpk) ) 118 124 ! 119 125 … … 127 133 DO jn = 1, kjpt ! tracer loop 128 134 ! ! =========== 135 ztrax(:,:,:) = 0._wp ; ztray(:,:,:) = 0._wp ; ztraz(:,:,:) = 0._wp ; 129 136 ! 130 137 !!---------------------------------------------------------------------- … … 226 233 DO ji = fs_2, fs_jpim1 ! vector opt. 227 234 zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) ) 228 ztra = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk))229 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra235 ztrax(ji,jj,jk) = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) ) 236 ztray(ji,jj,jk) = zbtr * ( zftv(ji,jj,jk) - zftv(ji,jj-1,jk) ) 230 237 END DO 231 238 END DO … … 233 240 END DO ! End of slab 234 241 ! ! =============== 242 ! 243 pta(:,:,:,jn) = pta(:,:,:,jn) + ztrax(:,:,:) + ztray(:,:,:) 235 244 ! 236 245 ! "Poleward" diffusive heat or salt transports (T-S case only) … … 311 320 DO ji = fs_2, fs_jpim1 ! vector opt. 312 321 zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) ) 313 ztra = ( ztfw(ji,jj,jk) - ztfw(ji,jj,jk+1) ) * zbtr 314 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 322 ztraz(ji,jj,jk) = ( ztfw(ji,jj,jk) - ztfw(ji,jj,jk+1) ) * zbtr 315 323 END DO 316 324 END DO 317 325 END DO 326 pta(:,:,:,jn) = pta(:,:,:,jn) + ztraz(:,:,:) 318 327 ! 328 IF( l_trdtra .AND. cdtype == "TRA" .AND. jn .eq. 1 ) THEN ! save the temperature trends 329 ztrax_T(:,:,:) = ztrax(:,:,:) 330 ztray_T(:,:,:) = ztray(:,:,:) 331 ztraz_T(:,:,:) = ztraz(:,:,:) 332 ENDIF 333 IF( l_trdtra .AND. cdtype == "TRC" ) THEN ! save the horizontal component of diffusive trends for further diagnostics 334 CALL trd_tra( kt, cdtype, jn, jptra_iso_x, ztrax ) 335 CALL trd_tra( kt, cdtype, jn, jptra_iso_y, ztray ) 336 CALL trd_tra( kt, cdtype, jn, jptra_iso_z1, ztraz ) ! This is the first part of the vertical component. 337 ENDIF 319 338 END DO 339 ! 340 IF( l_trdtra .AND. cdtype == "TRA" ) THEN ! save the horizontal component of diffusive trends for further diagnostics 341 CALL trd_tra( kt, cdtype, jp_tem, jptra_iso_x, ztrax_T ) 342 CALL trd_tra( kt, cdtype, jp_sal, jptra_iso_x, ztrax ) 343 CALL trd_tra( kt, cdtype, jp_tem, jptra_iso_y, ztray_T ) 344 CALL trd_tra( kt, cdtype, jp_sal, jptra_iso_y, ztray ) 345 CALL trd_tra( kt, cdtype, jp_tem, jptra_iso_z1, ztraz_T ) ! This is the first part of the vertical component 346 CALL trd_tra( kt, cdtype, jp_sal, jptra_iso_z1, ztraz ) ! 347 ENDIF 320 348 ! 321 349 CALL wrk_dealloc( jpi, jpj, z2d ) 322 350 CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt, ztfw, zdkt, zdk1t ) 351 DEALLOCATE( ztrax, ztray, ztraz ) 352 IF( l_trdtra ) DEALLOCATE( ztrax_T, ztray_T, ztraz_T ) 323 353 ! 324 354 IF( nn_timing == 1 ) CALL timing_stop('tra_ldf_iso') -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r6487 r7083 129 129 IF( l_trdtra ) THEN ! store now fields before applying the Asselin filter 130 130 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 131 ! Asselin filter trend 131 132 ztrdt(:,:,:) = tsn(:,:,:,jp_tem) 132 133 ztrds(:,:,:) = tsn(:,:,:,jp_sal) … … 135 136 CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdfp, ztrds ) 136 137 ENDIF 138 ! total trend (note slightly inaccurate because tsb is time-filtered and tsa isn't) 139 ztrdt(:,:,:) = 0._wp 140 ztrds(:,:,:) = 0._wp 141 DO jk = 1, jpkm1 142 ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / r2dtra(jk) 143 ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dtra(jk) 144 END DO 145 CALL trd_tra( kt, 'TRA', jp_tem, jptra_tot, ztrdt ) 146 CALL trd_tra( kt, 'TRA', jp_sal, jptra_tot, ztrds ) 137 147 ENDIF 138 148 -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r6487 r7083 158 158 ELSE ! No restart or restart not found: Euler forward time stepping 159 159 zfact = 1._wp 160 sbc_tsc(:,:,:) = 0._wp 160 161 sbc_tsc_b(:,:,:) = 0._wp 161 162 ENDIF -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/TRD/trd_oce.F90
r6486 r7083 33 33 # endif 34 34 ! !!!* Active tracers trends indexes 35 INTEGER, PUBLIC, PARAMETER :: jptot_tra = 14!: Total trend nb: change it when adding/removing one indice below35 INTEGER, PUBLIC, PARAMETER :: jptot_tra = 20 !: Total trend nb: change it when adding/removing one indice below 36 36 ! =============== ! 37 37 INTEGER, PUBLIC, PARAMETER :: jptra_xad = 1 !: x- horizontal advection … … 39 39 INTEGER, PUBLIC, PARAMETER :: jptra_zad = 3 !: z- vertical advection 40 40 INTEGER, PUBLIC, PARAMETER :: jptra_sad = 4 !: z- vertical advection 41 INTEGER, PUBLIC, PARAMETER :: jptra_ldf = 5 !: lateral diffusion 42 INTEGER, PUBLIC, PARAMETER :: jptra_zdf = 6 !: vertical diffusion 43 INTEGER, PUBLIC, PARAMETER :: jptra_zdfp = 7 !: "PURE" vert. diffusion (ln_traldf_iso=T) 44 INTEGER, PUBLIC, PARAMETER :: jptra_bbc = 8 !: Bottom Boundary Condition (geoth. heating) 45 INTEGER, PUBLIC, PARAMETER :: jptra_bbl = 9 !: Bottom Boundary Layer (diffusive and/or advective) 46 INTEGER, PUBLIC, PARAMETER :: jptra_npc = 10 !: non-penetrative convection treatment 47 INTEGER, PUBLIC, PARAMETER :: jptra_dmp = 11 !: internal restoring (damping) 48 INTEGER, PUBLIC, PARAMETER :: jptra_qsr = 12 !: penetrative solar radiation 49 INTEGER, PUBLIC, PARAMETER :: jptra_nsr = 13 !: non solar radiation / C/D on salinity (+runoff if ln_rnf=T) 50 INTEGER, PUBLIC, PARAMETER :: jptra_atf = 14 !: Asselin time filter 41 INTEGER, PUBLIC, PARAMETER :: jptra_totad = 5 !: total advection 42 INTEGER, PUBLIC, PARAMETER :: jptra_ldf = 6 !: lateral diffusion 43 INTEGER, PUBLIC, PARAMETER :: jptra_iso_x = 7 !: x-component of isopycnal diffusion 44 INTEGER, PUBLIC, PARAMETER :: jptra_iso_y = 8 !: y-component of isopycnal diffusion 45 INTEGER, PUBLIC, PARAMETER :: jptra_iso_z1 = 9 !: z-component of isopycnal diffusion 46 INTEGER, PUBLIC, PARAMETER :: jptra_zdf = 10 !: vertical diffusion 47 INTEGER, PUBLIC, PARAMETER :: jptra_zdfp = 11 !: "PURE" vert. diffusion (ln_traldf_iso=T) 48 INTEGER, PUBLIC, PARAMETER :: jptra_evd = 12 !: EVD term (convection) 49 INTEGER, PUBLIC, PARAMETER :: jptra_bbc = 13 !: Bottom Boundary Condition (geoth. heating) 50 INTEGER, PUBLIC, PARAMETER :: jptra_bbl = 14 !: Bottom Boundary Layer (diffusive and/or advective) 51 INTEGER, PUBLIC, PARAMETER :: jptra_npc = 15 !: non-penetrative convection treatment 52 INTEGER, PUBLIC, PARAMETER :: jptra_dmp = 16 !: internal restoring (damping) 53 INTEGER, PUBLIC, PARAMETER :: jptra_qsr = 17 !: penetrative solar radiation 54 INTEGER, PUBLIC, PARAMETER :: jptra_nsr = 18 !: non solar radiation / C/D on salinity (+runoff if ln_rnf=T) 55 INTEGER, PUBLIC, PARAMETER :: jptra_atf = 19 !: Asselin time filter 56 INTEGER, PUBLIC, PARAMETER :: jptra_tot = 20 !: Model total trend 51 57 ! 52 58 ! !!!* Passive tracers trends indices (use if "key_top" defined) 53 INTEGER, PUBLIC, PARAMETER :: jptra_sms = 1 5!: sources m. sinks54 INTEGER, PUBLIC, PARAMETER :: jptra_radn = 16!: corr. trn<0 in trcrad55 INTEGER, PUBLIC, PARAMETER :: jptra_radb = 17!: corr. trb<0 in trcrad (like atf)59 INTEGER, PUBLIC, PARAMETER :: jptra_sms = 19 !: sources m. sinks 60 INTEGER, PUBLIC, PARAMETER :: jptra_radn = 20 !: corr. trn<0 in trcrad 61 INTEGER, PUBLIC, PARAMETER :: jptra_radb = 21 !: corr. trb<0 in trcrad (like atf) 56 62 ! 57 63 ! !!!* Momentum trends indices -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/TRD/trdini.F90
r6486 r7083 91 91 !!gm end 92 92 ! 93 IF( lk_vvl .AND. ( l_trdtra .OR. l_trddyn ) ) CALL ctl_stop( 'trend diagnostics with variable volume not validated' )94 93 95 94 !!gm : Potential BUG : 3D output only for vector invariant form! add a ctl_stop or code the flux form case -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
r6486 r7083 38 38 REAL(wp) :: r2dt ! time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=0 39 39 40 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: trdtx, trdty, trdt ! use to store the temperature trends 40 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: trdtx, trdty, trdt ! use to store the temperature trends 41 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avt_evd ! store avt_evd to calculate EVD trend 41 42 42 43 !! * Substitutions … … 55 56 !! *** FUNCTION trd_tra_alloc *** 56 57 !!--------------------------------------------------------------------- 57 ALLOCATE( trdtx(jpi,jpj,jpk) , trdty(jpi,jpj,jpk) , trdt(jpi,jpj,jpk) , STAT= trd_tra_alloc )58 ALLOCATE( trdtx(jpi,jpj,jpk) , trdty(jpi,jpj,jpk) , trdt(jpi,jpj,jpk) , avt_evd(jpi,jpj,jpk), STAT= trd_tra_alloc ) 58 59 ! 59 60 IF( lk_mpp ) CALL mpp_sum ( trd_tra_alloc ) … … 104 105 ztrds(:,:,:) = 0._wp 105 106 CALL trd_tra_mng( trdt, ztrds, ktrd, kt ) 107 CASE( jptra_evd ) ; avt_evd(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 106 108 CASE DEFAULT ! other trends: masked trends 107 109 trdt(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) ! mask & store … … 138 140 END DO 139 141 CALL trd_tra_mng( ztrdt, ztrds, jptra_zdfp, kt ) 142 ! 143 ! ! Also calculate EVD trend at this point. 144 zwt(:,:,:) = 0._wp ; zws(:,:,:) = 0._wp ! vertical diffusive fluxes 145 DO jk = 2, jpk 146 zwt(:,:,jk) = avt_evd(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk) 147 zws(:,:,jk) = avt_evd(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / fse3w(:,:,jk) * tmask(:,:,jk) 148 END DO 149 ! 150 ztrdt(:,:,jpk) = 0._wp ; ztrds(:,:,jpk) = 0._wp 151 DO jk = 1, jpkm1 152 ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / fse3t(:,:,jk) 153 ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / fse3t(:,:,jk) 154 END DO 155 CALL trd_tra_mng( ztrdt, ztrds, jptra_evd, kt ) 140 156 ! 141 157 CALL wrk_dealloc( jpi, jpj, jpk, zwt, zws, ztrdt ) … … 312 328 CALL wrk_dealloc( jpi, jpj, z2dx, z2dy ) 313 329 ENDIF 330 CASE( jptra_totad ) ; CALL iom_put( "ttrd_totad" , ptrdx ) ! total advection 331 CALL iom_put( "strd_totad" , ptrdy ) 314 332 CASE( jptra_ldf ) ; CALL iom_put( "ttrd_ldf" , ptrdx ) ! lateral diffusion 315 333 CALL iom_put( "strd_ldf" , ptrdy ) … … 318 336 CASE( jptra_zdfp ) ; CALL iom_put( "ttrd_zdfp", ptrdx ) ! PURE vertical diffusion (no isoneutral contribution) 319 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 ) 320 346 CASE( jptra_dmp ) ; CALL iom_put( "ttrd_dmp" , ptrdx ) ! internal restoring (damping) 321 347 CALL iom_put( "strd_dmp" , ptrdy ) … … 330 356 CASE( jptra_atf ) ; CALL iom_put( "ttrd_atf" , ptrdx ) ! asselin time Filter 331 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 ) 332 360 END SELECT 333 361 ! -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90
r6486 r7083 19 19 USE zdf_oce ! ocean vertical physics variables 20 20 USE zdfkpp ! KPP vertical mixing 21 USE trd_oce ! trends: ocean variables 22 USE trdtra ! trends manager: tracers 21 23 USE in_out_manager ! I/O manager 22 24 USE iom ! for iom_put … … 122 124 zavt_evd(:,:,:) = avt(:,:,:) - zavt_evd(:,:,:) ! change in avt due to evd 123 125 CALL iom_put( "avt_evd", zavt_evd ) ! output this change 126 IF( l_trdtra ) CALL trd_tra( kt, 'TRA', jp_tem, jptra_evd, zavt_evd ) 124 127 ! 125 128 IF( nn_timing == 1 ) CALL timing_stop('zdf_evd') -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/OPA_SRC/oce.F90
r6698 r7083 140 140 PCO2a_in_cpl(jpi,jpj), Dust_in_cpl(jpi,jpj), STAT=ierr(5) ) 141 141 142 ! RSRH Temporarily initialise output coupling fields while we await clarification143 ! of exactly how these will be initialised at model startup!144 DMS_out_cpl(:,:) = 0.0145 CO2Flux_out_cpl(:,:) = 0.0146 142 ENDIF 147 143 #endif
Note: See TracChangeset
for help on using the changeset viewer.
