Ignore:
Timestamp:
2019-04-16T14:58:06+02:00 (2 years ago)
Author:
anaguiar
Message:

Changes to reinstate heat fluxes, see https://code.metoffice.gov.uk/trac/gmed/ticket/454

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_FOAMv14_output_heat_fluxes/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r9288 r10879  
    253253      REAL(wp), DIMENSION(:,:), POINTER ::   zwnd_i, zwnd_j    ! wind speed components at T-point 
    254254      REAL(wp), DIMENSION(:,:), POINTER ::   zqsatw            ! specific humidity at pst 
    255       REAL(wp), DIMENSION(:,:), POINTER ::   zqlw, zqsb        ! long wave and sensible heat fluxes 
    256       REAL(wp), DIMENSION(:,:), POINTER ::   zqla, zevap       ! latent heat fluxes and evaporation 
     255      REAL(wp), DIMENSION(:,:), POINTER ::   zevap             ! evaporation 
    257256      REAL(wp), DIMENSION(:,:), POINTER ::   Cd                ! transfer coefficient for momentum      (tau) 
    258257      REAL(wp), DIMENSION(:,:), POINTER ::   Ch                ! transfer coefficient for sensible heat (Q_sens) 
     
    265264      IF( nn_timing == 1 )  CALL timing_start('blk_oce_core') 
    266265      ! 
    267       CALL wrk_alloc( jpi,jpj, zwnd_i, zwnd_j, zqsatw, zqlw, zqsb, zqla, zevap ) 
     266      CALL wrk_alloc( jpi,jpj, zwnd_i, zwnd_j, zqsatw, zevap ) 
    268267      CALL wrk_alloc( jpi,jpj, Cd, Ch, Ce, zst, zt_zu, zq_zu ) 
    269268      ! 
     
    311310      ENDIF 
    312311 
    313       zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave 
     312      qlw(:,:) = (  sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave 
    314313      ! ----------------------------------------------------------------------------- ! 
    315314      !     II    Turbulent FLUXES                                                    ! 
     
    359358         !! q_air and t_air are (or "are almost") given at 10m (wind reference height) 
    360359         zevap(:,:) = rn_efac*MAX( 0._wp,     rhoa*Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,:,1) )*wndm(:,:) ) ! Evaporation 
    361          zqsb (:,:) =                     cpa*rhoa*Ch(:,:)*( zst   (:,:) - sf(jp_tair)%fnow(:,:,1) )*wndm(:,:)   ! Sensible Heat 
     360         qsb (:,:) =                     cpa*rhoa*Ch(:,:)*( zst   (:,:) - sf(jp_tair)%fnow(:,:,1) )*wndm(:,:)   ! Sensible Heat 
    362361      ELSE 
    363362         !! q_air and t_air are not given at 10m (wind reference height) 
    364363         ! Values of temp. and hum. adjusted to height of wind during bulk algorithm iteration must be used!!! 
    365364         zevap(:,:) = rn_efac*MAX( 0._wp,     rhoa*Ce(:,:)*( zqsatw(:,:) - zq_zu(:,:) )*wndm(:,:) )   ! Evaporation 
    366          zqsb (:,:) =                     cpa*rhoa*Ch(:,:)*( zst   (:,:) - zt_zu(:,:) )*wndm(:,:)     ! Sensible Heat 
    367       ENDIF 
    368       zqla (:,:) = Lv * zevap(:,:)                                                              ! Latent Heat 
     365         qsb (:,:) =                     cpa*rhoa*Ch(:,:)*( zst   (:,:) - zt_zu(:,:) )*wndm(:,:)     ! Sensible Heat 
     366      ENDIF 
     367      qla (:,:) = Lv * zevap(:,:)                                                              ! Latent Heat 
    369368 
    370369      IF(ln_ctl) THEN 
    371          CALL prt_ctl( tab2d_1=zqla  , clinfo1=' blk_oce_core: zqla   : ', tab2d_2=Ce , clinfo2=' Ce  : ' ) 
    372          CALL prt_ctl( tab2d_1=zqsb  , clinfo1=' blk_oce_core: zqsb   : ', tab2d_2=Ch , clinfo2=' Ch  : ' ) 
    373          CALL prt_ctl( tab2d_1=zqlw  , clinfo1=' blk_oce_core: zqlw   : ', tab2d_2=qsr, clinfo2=' qsr : ' ) 
     370         CALL prt_ctl( tab2d_1=qla  , clinfo1=' blk_oce_core: qla   : ', tab2d_2=Ce , clinfo2=' Ce  : ' ) 
     371         CALL prt_ctl( tab2d_1=qsb  , clinfo1=' blk_oce_core: qsb   : ', tab2d_2=Ch , clinfo2=' Ch  : ' ) 
     372         CALL prt_ctl( tab2d_1=qlw  , clinfo1=' blk_oce_core: qlw   : ', tab2d_2=qsr, clinfo2=' qsr : ' ) 
    374373         CALL prt_ctl( tab2d_1=zqsatw, clinfo1=' blk_oce_core: zqsatw : ', tab2d_2=zst, clinfo2=' zst : ' ) 
    375374         CALL prt_ctl( tab2d_1=utau  , clinfo1=' blk_oce_core: utau   : ', mask1=umask,   & 
     
    386385         &         - sf(jp_prec)%fnow(:,:,1) * rn_pfac  ) * tmask(:,:,1) 
    387386      ! 
    388       qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                &   ! Downward Non Solar  
     387      qns(:,:) = qlw(:,:) - qsb(:,:) - qla(:,:)                                   &   ! Downward Non Solar  
    389388         &     - sf(jp_snow)%fnow(:,:,1) * rn_pfac * lfus                         &   ! remove latent melting heat for solid precip 
    390389         &     - zevap(:,:) * pst(:,:) * rcp                                      &   ! remove evap heat content at SST 
     
    395394      ! 
    396395#if defined key_lim3 
    397       qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                ! non solar without emp (only needed by LIM3) 
     396      qns_oce(:,:) = qlw(:,:) - qsb(:,:) - qla(:,:)                                ! non solar without emp (only needed by LIM3) 
    398397      qsr_oce(:,:) = qsr(:,:) 
    399398#endif 
    400399      ! 
    401400      IF ( nn_ice == 0 ) THEN 
    402          CALL iom_put( "qlw_oce" ,   zqlw )                 ! output downward longwave heat over the ocean 
    403          CALL iom_put( "qsb_oce" , - zqsb )                 ! output downward sensible heat over the ocean 
    404          CALL iom_put( "qla_oce" , - zqla )                 ! output downward latent   heat over the ocean 
    405          CALL iom_put( "qemp_oce",   qns-zqlw+zqsb+zqla )   ! output downward heat content of E-P over the ocean 
    406          CALL iom_put( "qns_oce" ,   qns  )                 ! output downward non solar heat over the ocean 
    407          CALL iom_put( "qsr_oce" ,   qsr  )                 ! output downward solar heat over the ocean 
    408          CALL iom_put( "qt_oce"  ,   qns+qsr )              ! output total downward heat over the ocean 
    409          tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac   ! output total precipitation [kg/m2/s] 
    410          sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac   ! output solid precipitation [kg/m2/s] 
    411          CALL iom_put( 'snowpre', sprecip * 86400. )        ! Snow 
    412          CALL iom_put( 'precip' , tprecip * 86400. )        ! Total precipitation 
     401          CALL iom_put( "qlw_oce" ,   qlw )                  ! output downward longwave heat over the ocean 
     402          CALL iom_put( "qsb_oce" , - qsb )                  ! output downward sensible heat over the ocean 
     403          CALL iom_put( "qla_oce" , - qla )                  ! output downward latent   heat over the ocean 
     404          CALL iom_put( "qemp_oce",   qns-qlw+qsb+qla )      ! output downward heat content of E-P over the ocean 
     405          CALL iom_put( "qns_oce" ,   qns  )                 ! output downward non solar heat over the ocean 
     406          CALL iom_put( "qsr_oce" ,   qsr  )                 ! output downward solar heat over the ocean 
     407          CALL iom_put( "qt_oce"  ,   qns+qsr )              ! output total downward heat over the ocean 
     408          tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac   ! output total precipitation [kg/m2/s] 
     409          sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac   ! output solid precipitation [kg/m2/s] 
     410          CALL iom_put( 'snowpre', sprecip * 86400. )        ! Snow 
     411          CALL iom_put( 'precip' , tprecip * 86400. )        ! Total precipitation 
    413412      ENDIF 
    414413      ! 
    415414      IF(ln_ctl) THEN 
    416          CALL prt_ctl(tab2d_1=zqsb , clinfo1=' blk_oce_core: zqsb   : ', tab2d_2=zqlw , clinfo2=' zqlw  : ') 
    417          CALL prt_ctl(tab2d_1=zqla , clinfo1=' blk_oce_core: zqla   : ', tab2d_2=qsr  , clinfo2=' qsr   : ') 
     415         CALL prt_ctl(tab2d_1=qsb , clinfo1=' blk_oce_core: qsb   : ', tab2d_2=qlw , clinfo2=' qlw  : ') 
     416         CALL prt_ctl(tab2d_1=qla , clinfo1=' blk_oce_core: qla   : ', tab2d_2=qsr  , clinfo2=' qsr   : ') 
    418417         CALL prt_ctl(tab2d_1=pst  , clinfo1=' blk_oce_core: pst    : ', tab2d_2=emp  , clinfo2=' emp   : ') 
    419418         CALL prt_ctl(tab2d_1=utau , clinfo1=' blk_oce_core: utau   : ', mask1=umask,   & 
     
    421420      ENDIF 
    422421      ! 
    423       CALL wrk_dealloc( jpi,jpj, zwnd_i, zwnd_j, zqsatw, zqlw, zqsb, zqla, zevap ) 
     422      CALL wrk_dealloc( jpi,jpj, zwnd_i, zwnd_j, zqsatw, zevap ) 
    424423      CALL wrk_dealloc( jpi,jpj, Cd, Ch, Ce, zst, zt_zu, zq_zu ) 
    425424      ! 
Note: See TracChangeset for help on using the changeset viewer.