Changeset 6727


Ignore:
Timestamp:
2016-06-21T16:25:51+02:00 (4 years ago)
Author:
gm
Message:

#1751 - branch SIMPLIF_6_aerobulk: minor correction

Location:
branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/SBC
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk.F90

    r6723 r6727  
    99   !!            2.0  !  2005-04  (L. Brodeau, A.M. Treguier) additions: 
    1010   !!                           -  new bulk routine for efficiency 
    11    !!                           -  WINDS ARE NOW ASSUMED TO BE AT T POINTS in input files !!!! 
     11   !!                           -  WINDS ARE NOW ASSUMED TO BE AT T POINTS in input files 
    1212   !!                           -  file names and file characteristics in namelist 
    1313   !!                           -  Implement reading of 6-hourly fields 
     
    1818   !!            3.4  !  2011-11  (C. Harris) Fill arrays required by CICE 
    1919   !!            3.7  !  2014-06  (L. Brodeau) simplification and optimization of CORE bulk 
    20    !! 
    21    !!            4.0  !  2016-06  (L. Brodeau) sbcblk_core becomes sbcblk and is not restricted to 
    22    !!                             the CORE algorithm anymore 
    23    !!                             => based on AeroBulk (http://aerobulk.sourceforge.net/) 
     20   !!            4.0  !  2016-06  (L. Brodeau) sbcblk_core becomes sbcblk and is not restricted to the CORE algorithm anymore 
     21   !!                                          ==> based on AeroBulk (http://aerobulk.sourceforge.net/) 
    2422   !!---------------------------------------------------------------------- 
    2523 
    2624   !!---------------------------------------------------------------------- 
    27    !!   sbc_blk         : bulk formulation as ocean surface boundary condition (forced mode, CORE bulk formulea) 
    28    !!   blk_oce         : computes momentum, heat and freshwater fluxes over ocean 
    29    !!   blk_ice         : computes momentum, heat and freshwater fluxes over ice 
    30    !!   rho_air         : density of (moist) air (depends on T_air, q_air and SLP 
    31    !!   cp_air          : specific heat of (moist) air (depends spec. hum. q_air) 
    32    !!    q_sat          : saturation humidity as a unction of SLP and temperature 
     25   !!   sbc_blk       : bulk formulation as ocean surface boundary condition (forced mode, CORE bulk formulea) 
     26   !!   blk_oce       : computes momentum, heat and freshwater fluxes over ocean 
     27   !!   blk_ice       : computes momentum, heat and freshwater fluxes over ice 
     28   !!   rho_air       : density of (moist) air (depends on T_air, q_air and SLP 
     29   !!   cp_air        : specific heat of (moist) air (depends spec. hum. q_air) 
     30   !!   q_sat         : saturation humidity as a function of SLP and temperature 
     31   !!   L_vap         : latent heat of vaporization of water as a function of temperature 
    3332   !!---------------------------------------------------------------------- 
    3433   USE oce            ! ocean dynamics and tracers 
     
    4948   USE par_ice_2      ! LIM-2 parameters 
    5049#endif 
    51  
    5250   USE sbcblk_algo_ncar     ! => turb_ncar     : NCAR - CORE (Large & Yeager, 2009)  
    5351   USE sbcblk_algo_coare    ! => turb_coare    : COAREv3.0 (Fairall et al. 2003)  
    5452   USE sbcblk_algo_coare3p5 ! => turb_coare3p5 : COAREv3.5 (Edson et al. 2013) 
    5553   USE sbcblk_algo_ecmwf    ! => turb_ecmwf    : ECMWF (IFS cycle 31)  
    56  
     54   ! 
    5755   USE iom            ! I/O manager library 
    5856   USE in_out_manager ! I/O manager 
     
    6664   PRIVATE 
    6765 
    68    PUBLIC   sbc_blk         ! routine called in sbcmod module 
     66   PUBLIC   sbc_blk       ! routine called in sbcmod module 
    6967#if defined key_lim2 || defined key_lim3 
    70    PUBLIC   blk_ice_tau     ! routine called in sbc_ice_lim module 
    71    PUBLIC   blk_ice_flx     ! routine called in sbc_ice_lim module 
     68   PUBLIC   blk_ice_tau   ! routine called in sbc_ice_lim module 
     69   PUBLIC   blk_ice_flx   ! routine called in sbc_ice_lim module 
    7270#endif 
    7371 
    74    !!Lolo: should ultimately be moved in the module with all physical constants ? 
     72!!Lolo: should ultimately be moved in the module with all physical constants ? 
     73!!gm  : In principle, yes. 
    7574   REAL(wp), PARAMETER ::   Cp_dry = 1005.0       !: Specic heat of dry air, constant pressure      [J/K/kg] 
    7675   REAL(wp), PARAMETER ::   Cp_vap = 1860.0       !: Specic heat of water vapor, constant pressure  [J/K/kg] 
     
    381380 
    382381      ! ... specific humidity at SST and IST tmask( 
    383       zsq(:,:) = 0.98 * q_sat(zst(:,:), sf(jp_slp)%fnow(:,:,1)) 
     382      zsq(:,:) = 0.98 * q_sat( zst(:,:), sf(jp_slp)%fnow(:,:,1) ) 
    384383      !! 
    385384      !! Estimate of potential temperature at z=rn_zqt, based on adiabatic lapse-rate 
    386385      !!    (see Josey, Gulev & Yu, 2013) / doi=10.1016/B978-0-12-391851-2.00005-2 
    387386      !!    (since reanalysis products provide T at z, not theta !) 
    388       ztpot =  sf(jp_tair)%fnow(:,:,1) + gamma_moist(sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1)) * rn_zqt 
    389  
    390             SELECT CASE ( nblk ) 
    391             CASE( np_NCAR      )   ;   WRITE(numout,*) '         "NCAR" algorithm        (Large and Yeager 2008)' 
    392             CASE( np_COARE_3p0 )   ;   WRITE(numout,*) '         "COARE 3.0" algorithm   (Fairall et al. 2003)' 
    393             CASE( np_COARE_3p5 )   ;   WRITE(numout,*) '         "COARE 3.5" algorithm   (Edson et al. 2013)' 
    394             CASE( np_ECMWF     )   ;   WRITE(numout,*) '         "ECMWF" algorithm       (IFS cycle 31)' 
    395             END SELECT 
     387      ztpot = sf(jp_tair)%fnow(:,:,1) + gamma_moist( sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1) ) * rn_zqt 
    396388 
    397389      SELECT CASE( nblk )        !==  transfer coefficients  ==!   Cd, Ch, Ce at T-point 
    398          ! 
    399       CASE( np_NCAR      )   ;   CALL turb_ncar    ( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   & 
    400             &                                            Cd, Ch, Ce, zt_zu, zq_zu, zU_zu ) 
    401       CASE( np_COARE_3p0 )   ;   CALL turb_coare   ( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   & 
    402             &                                            Cd, Ch, Ce, zt_zu, zq_zu, zU_zu ) 
    403       CASE( np_COARE_3p5 )   ;   CALL turb_coare3p5( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   & 
    404             &                                            Cd, Ch, Ce, zt_zu, zq_zu, zU_zu ) 
    405       CASE( np_ECMWF     )   ;   CALL turb_ecmwf   ( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   & 
    406             &                                            Cd, Ch, Ce, zt_zu, zq_zu, zU_zu ) 
     390      ! 
     391      CASE( np_NCAR      )   ;   CALL turb_ncar    ( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! NCAR-COREv2 
     392         &                                               Cd, Ch, Ce, zt_zu, zq_zu, zU_zu ) 
     393      CASE( np_COARE_3p0 )   ;   CALL turb_coare   ( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! COARE v3.0 
     394         &                                               Cd, Ch, Ce, zt_zu, zq_zu, zU_zu ) 
     395      CASE( np_COARE_3p5 )   ;   CALL turb_coare3p5( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! COARE v3.5 
     396         &                                               Cd, Ch, Ce, zt_zu, zq_zu, zU_zu ) 
     397      CASE( np_ECMWF     )   ;   CALL turb_ecmwf   ( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm,   &  ! ECMWF 
     398         &                                               Cd, Ch, Ce, zt_zu, zq_zu, zU_zu ) 
    407399      CASE DEFAULT 
    408400         CALL ctl_stop( 'STOP', 'sbc_blk: non-existing bulk formula selected' ) 
    409401      END SELECT 
    410402 
    411       ! Computing true air density : 
    412       IF( ABS(rn_zu - rn_zqt) > 0.01 ) THEN 
    413          !! At zu: (probably useless to remove zrho*grav*rn_zu from SLP...) 
    414          zrhoa = rho_air(zt_zu(:,:), zq_zu(:,:), sf(jp_slp)%fnow(:,:,1)) 
    415       ELSE 
    416          !! At zt: 
    417          zrhoa = rho_air(sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1)) 
     403      !                          ! Compute true air density : 
     404      IF( ABS(rn_zu - rn_zqt) > 0.01 ) THEN     ! At zu: (probably useless to remove zrho*grav*rn_zu from SLP...) 
     405         zrhoa(:,:) = rho_air( zt_zu(:,:)             , zq_zu(:,:)             , sf(jp_slp)%fnow(:,:,1) ) 
     406      ELSE                                      ! At zt: 
     407         zrhoa(:,:) = rho_air( sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1) ) 
    418408      END IF 
    419409 
    420       ! ... tau module, i and j component 
    421       DO jj = 1, jpj 
     410      DO jj = 1, jpj             ! tau module, i and j component 
    422411         DO ji = 1, jpi 
    423             zztmp = zrhoa(ji,jj)  * zU_zu(ji,jj) * Cd(ji,jj) ! using bulk wind speed 
     412            zztmp = zrhoa(ji,jj)  * zU_zu(ji,jj) * Cd(ji,jj)   ! using bulk wind speed 
    424413            taum  (ji,jj) = zztmp * wndm  (ji,jj) 
    425414            zwnd_i(ji,jj) = zztmp * zwnd_i(ji,jj) 
     
    428417      END DO 
    429418 
    430       ! ... add the HF tau contribution to the wind stress module? 
    431       IF( lhftau ) THEN 
    432          taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:,1) 
    433       ENDIF 
     419      !                          ! add the HF tau contribution to the wind stress module 
     420      IF( lhftau )   taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:,1) 
     421 
    434422      CALL iom_put( "taum_oce", taum )   ! output wind stress module 
    435423 
     
    466454      ENDIF 
    467455 
    468       zqla(:,:) = Lvap(zst(:,:)) * zevap(:,:)     ! Latent Heat flux 
     456      zqla(:,:) = L_vap(zst(:,:)) * zevap(:,:)     ! Latent Heat flux 
    469457 
    470458 
     
    641629      !! caution : the net upward water flux has with mm/day unit 
    642630      !!--------------------------------------------------------------------- 
    643       REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   ptsu          ! sea ice surface temperature 
    644       REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   palb          ! ice albedo (all skies) 
    645       !! 
    646       INTEGER  ::   ji, jj, jl    ! dummy loop indices 
    647       REAL(wp) ::   zst2, zst3 
    648       REAL(wp) ::   zcoef_dqlw, zcoef_dqla 
    649       REAL(wp) ::   zztmp, z1_lsub                               ! temporary variable 
    650       !! 
    651       REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw             ! long wave heat flux over ice 
    652       REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qsb             ! sensible  heat flux over ice 
    653       REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqlw            ! long wave heat sensitivity over ice 
    654       REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqsb            ! sensible  heat sensitivity over ice 
    655       REAL(wp), DIMENSION(:,:)  , POINTER ::   zevap, zsnw       ! evaporation and snw distribution after wind blowing (LIM3) 
     631      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   ptsu   ! sea ice surface temperature 
     632      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   palb   ! ice albedo (all skies) 
     633      !! 
     634      INTEGER  ::   ji, jj, jl               ! dummy loop indices 
     635      REAL(wp) ::   zst2, zst3               ! local variable 
     636      REAL(wp) ::   zcoef_dqlw, zcoef_dqla   !   -      - 
     637      REAL(wp) ::   zztmp, z1_lsub           !   -      - 
     638      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw         ! long wave heat flux over ice 
     639      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qsb         ! sensible  heat flux over ice 
     640      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqlw        ! long wave heat sensitivity over ice 
     641      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqsb        ! sensible  heat sensitivity over ice 
     642      REAL(wp), DIMENSION(:,:)  , POINTER ::   zevap, zsnw   ! evaporation and snw distribution after wind blowing (LIM3) 
    656643      REAL(wp), DIMENSION(:,:)  , POINTER ::   zrhoa 
    657644      !!--------------------------------------------------------------------- 
     
    666653      zcoef_dqla   = -Ls * Cice * 11637800. * (-5897.8) 
    667654      ! 
    668       zrhoa(:,:) = rho_air(sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1)) 
     655      zrhoa(:,:) = rho_air( sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1) ) 
    669656      ! 
    670657      zztmp = 1. / ( 1. - albo ) 
     
    782769 
    783770   END SUBROUTINE blk_ice_flx 
     771    
    784772#endif 
    785  
    786773 
    787774   FUNCTION rho_air( ptak, pqa, pslp ) 
    788775      !!------------------------------------------------------------------------------- 
    789       !! ** Purpose : compute density of (moist) air with eq. of state 
     776      !!                           ***  FUNCTION rho_air  *** 
     777      !! 
     778      !! ** Purpose : compute density of (moist) air using the eq. of state of the atmosphere 
    790779      !! 
    791780      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk)  
    792781      !!------------------------------------------------------------------------------- 
    793       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptak, &  !: air temperature   [K] 
    794          &                                        pqa, &  !: air spec. hum.    [kg/kg] 
    795          &                                        pslp    !: pressure in       [Pa] 
    796       REAL(wp), DIMENSION(jpi,jpj)             ::   rho_air   !:              [kg/m^3] 
     782      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak      ! air temperature             [K] 
     783      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqa       ! air specific humidity   [kg/kg] 
     784      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pslp      ! pressure in                [Pa] 
     785      REAL(wp), DIMENSION(jpi,jpj)             ::   rho_air   ! density of moist air   [kg/m^3] 
    797786      !!------------------------------------------------------------------------------- 
    798787      ! 
    799       rho_air = pslp/(R_dry*ptak*(1._wp + rctv0*pqa)) 
     788      rho_air = pslp / (  R_dry*ptak * ( 1._wp + rctv0*pqa )  ) 
    800789      ! 
    801790   END FUNCTION rho_air 
     
    804793   FUNCTION cp_air( pqa ) 
    805794      !!------------------------------------------------------------------------------- 
     795      !!                           ***  FUNCTION cp_air  *** 
     796      !! 
    806797      !! ** Purpose : Compute specific heat (Cp) of moist air 
    807798      !! 
    808799      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
    809800      !!------------------------------------------------------------------------------- 
    810       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqa     !: air spec. hum. [kg/kg] 
    811       REAL(wp), DIMENSION(jpi,jpj)             :: cp_air  !: [J/K/kg] 
     801      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqa      ! air specific humidity        [kg/kg] 
     802      REAL(wp), DIMENSION(jpi,jpj)             ::   cp_air   ! specific heat of moist air  [J/K/kg] 
    812803      !!------------------------------------------------------------------------------- 
    813804      ! 
    814       Cp_air = Cp_dry + Cp_vap*pqa 
     805      Cp_air = Cp_dry + Cp_vap * pqa 
    815806      ! 
    816807   END FUNCTION cp_air 
     
    819810   FUNCTION q_sat( ptak, pslp ) 
    820811      !!---------------------------------------------------------------------------------- 
     812      !!                           ***  FUNCTION q_sat  *** 
     813      !! 
    821814      !! ** Purpose : Specific humidity at saturation in [kg/kg] 
    822815      !!              Based on accurate estimate of "e_sat" 
     
    825818      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
    826819      !!---------------------------------------------------------------------------------- 
    827       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: & 
    828          &                            ptak,       &  !: air temperature [K] 
    829          &                            pslp           !: sea level atmospheric pressure  [Pa] 
    830       REAL(wp), DIMENSION(jpi,jpj) :: q_sat 
     820      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak    ! air temperature                       [K] 
     821      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pslp    ! sea level atmospheric pressure       [Pa] 
     822      REAL(wp), DIMENSION(jpi,jpj)             ::   q_sat   ! Specific humidity at saturation   [kg/kg] 
    831823      ! 
    832824      INTEGER  ::   ji, jj         ! dummy loop indices 
    833       REAL(wp) :: ze_sat, ztmp     ! local scalar 
     825      REAL(wp) ::   ze_sat, ztmp   ! local scalar 
    834826      !!---------------------------------------------------------------------------------- 
    835827      ! 
     
    837829         DO ji = 1, jpi 
    838830            ! 
    839             ztmp = rt0/ptak(ji,jj) 
     831            ztmp = rt0 / ptak(ji,jj) 
    840832            ! 
    841             ! Vapour pressure at saturation [hPa] : 
    842             !   WMO, (Goff, 1957) 
    843             ze_sat = 10.**( 10.79574*(1. - ztmp) - 5.028*LOG10(ptak(ji,jj)/rt0)       & 
    844                &    + 1.50475*10.**(-4)*(1. - 10.**(-8.2969*(ptak(ji,jj)/rt0 - 1.)) ) & 
     833            ! Vapour pressure at saturation [hPa] : WMO, (Goff, 1957) 
     834            ze_sat = 10.**( 10.79574*(1. - ztmp) - 5.028*LOG10(ptak(ji,jj)/rt0)        & 
     835               &    + 1.50475*10.**(-4)*(1. - 10.**(-8.2969*(ptak(ji,jj)/rt0 - 1.)) )  & 
    845836               &    + 0.42873*10.**(-3)*(10.**(4.76955*(1. - ztmp)) - 1.) + 0.78614  ) 
    846             ! 
    847             q_sat(ji,jj) = reps0 * ze_sat/( 0.01_wp*pslp(ji,jj) - (1._wp - reps0)*ze_sat )     ! 0.01 because SLP is in [Pa] 
     837               ! 
     838            q_sat(ji,jj) = reps0 * ze_sat/( 0.01_wp*pslp(ji,jj) - (1._wp - reps0)*ze_sat )   ! 0.01 because SLP is in [Pa] 
    848839            ! 
    849840         END DO 
     
    855846   FUNCTION gamma_moist( ptak, pqa ) 
    856847      !!---------------------------------------------------------------------------------- 
     848      !!                           ***  FUNCTION gamma_moist  *** 
     849      !! 
    857850      !! ** Purpose : Compute the moist adiabatic lapse-rate. 
    858851      !!     => http://glossary.ametsoc.org/wiki/Moist-adiabatic_lapse_rate 
     
    861854      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
    862855      !!---------------------------------------------------------------------------------- 
    863       REAL(wp), DIMENSION(jpi,jpj)             :: gamma_moist 
    864       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: ptak, pqa ! air temperature (K) and specific humidity (kg/kg) 
     856      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   ptak          ! air temperature       [K] 
     857      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqa           ! specific humidity [kg/kg] 
     858      REAL(wp), DIMENSION(jpi,jpj)             ::   gamma_moist   ! moist adiabatic lapse-rate 
    865859      ! 
    866860      INTEGER  ::   ji, jj         ! dummy loop indices 
     
    871865         DO ji = 1, jpi 
    872866            zrv = pqa(ji,jj) / (1. - pqa(ji,jj)) 
    873             ziRT = 1./(R_dry*ptak(ji,jj))    ! 1/RT 
     867            ziRT = 1. / (R_dry*ptak(ji,jj))    ! 1/RT 
    874868            gamma_moist(ji,jj) = grav * ( 1. + cevap*zrv*ziRT ) / ( Cp_dry + cevap*cevap*zrv*reps0*ziRT/ptak(ji,jj) ) 
    875869         END DO 
     
    879873 
    880874 
    881    FUNCTION Lvap( psst ) 
     875   FUNCTION L_vap( psst ) 
    882876      !!--------------------------------------------------------------------------------- 
     877      !!                           ***  FUNCTION L_vap  *** 
     878      !! 
    883879      !! ** Purpose : Compute the latent heat of vaporization of water from temperature 
    884880      !! 
    885881      !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
    886882      !!---------------------------------------------------------------------------------- 
    887       REAL(wp), DIMENSION(jpi,jpj)             :: Lvap   !: [J/kg] 
    888       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: psst   !: water temperature [K] 
     883      REAL(wp), DIMENSION(jpi,jpj)             ::   L_vap   ! latent heat of vaporization  [J/kg] 
     884      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   psst   ! water temperature                [K] 
    889885      !!---------------------------------------------------------------------------------- 
    890886      ! 
    891       Lvap = (2.501 - 0.00237*(psst(:,:) - rt0))*1.E6 
    892       ! 
    893    END FUNCTION Lvap 
     887      L_vap = (  2.501 - 0.00237 * ( psst(:,:) - rt0)  ) * 1.e6 
     888      ! 
     889   END FUNCTION L_vap 
    894890 
    895891   !!====================================================================== 
  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_coare.F90

    r6723 r6727  
    1818   !!            Author: Laurent Brodeau, 2016, brodeau@gmail.com 
    1919   !! 
    20    !!==================================================================================== 
    21  
    22    !! History :  3.6  !  2016-02  (L.Brodeau) Original code 
     20   !!====================================================================== 
     21   !! History :  3.6  !  2016-02  (L.Brodeau)   Original code 
     22   !!---------------------------------------------------------------------- 
    2323 
    2424   !!---------------------------------------------------------------------- 
     
    2727   !!                   returns the effective bulk wind speed at 10m 
    2828   !!---------------------------------------------------------------------- 
    29  
    30    USE oce             ! ocean dynamics and tracers 
    31    USE dom_oce         ! ocean space and time domain 
    32    USE phycst          ! physical constants 
    33    USE iom             ! I/O manager library 
    34    USE lib_mpp         ! distribued memory computing library 
    35    USE wrk_nemo        ! work arrays 
    36    USE timing          ! Timing 
    37    USE in_out_manager  ! I/O manager 
    38    USE prtctl          ! Print control 
    39    USE sbcwave, ONLY   :  cdn_wave ! wave module 
     29   USE oce            ! ocean dynamics and tracers 
     30   USE dom_oce        ! ocean space and time domain 
     31   USE phycst         ! physical constants 
     32   USE sbc_oce        ! Surface boundary condition: ocean fields 
     33   USE sbcwave, ONLY  :  cdn_wave ! wave module 
    4034#if defined key_lim3 || defined key_cice 
    41    USE sbc_ice         ! Surface boundary condition: ice fields 
     35   USE sbc_ice        ! Surface boundary condition: ice fields 
    4236#endif 
    43    USE lib_fortran     ! to use key_nosignedzero 
    44  
    45    USE sbc_oce         ! Surface boundary condition: ocean fields 
     37   ! 
     38   USE in_out_manager ! I/O manager 
     39   USE iom            ! I/O manager library 
     40   USE lib_mpp        ! distribued memory computing library 
     41   USE wrk_nemo       ! work arrays 
     42   USE timing         ! Timing 
     43   USE prtctl         ! Print control 
     44   USE lib_fortran    ! to use key_nosignedzero 
     45 
    4646 
    4747   IMPLICIT NONE 
    4848   PRIVATE 
    4949 
    50    PUBLIC :: TURB_COARE 
     50   PUBLIC ::   TURB_COARE   ! called by sbcblk.F90 
    5151 
    5252   !! COARE own values for given constants: 
     
    7171      !! 
    7272      !! ** Method : Monin Obukhov Similarity Theory 
    73       !!====================================================================================== 
     73      !!---------------------------------------------------------------------- 
    7474      !! 
    7575      !! INPUT : 
     
    9292      !!    *  q_zu   : specific humidity of air        //                    [kg/kg] 
    9393      !!    *  U_blk  : bulk wind at 10m                                      [m/s] 
    94       !! 
    95       !! 
    96       !!============================================================================ 
    97  
    98  
    99       REAL(wp), INTENT(in   )                     ::   zt       ! height for t_zt and q_zt                   [m] 
    100       REAL(wp), INTENT(in   )                     ::   zu       ! height for U_zu                              [m] 
    101       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   sst      ! sea surface temperature              [Kelvin] 
    102       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   t_zt     ! potential air temperature            [Kelvin] 
    103       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   ssq      ! sea surface specific humidity         [kg/kg] 
    104       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity                 [kg/kg] 
    105       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   U_zu     ! relative wind module at zu            [m/s] 
     94      !!---------------------------------------------------------------------- 
     95      REAL(wp), INTENT(in   )                     ::   zt       ! height for t_zt and q_zt                    [m] 
     96      REAL(wp), INTENT(in   )                     ::   zu       ! height for U_zu                             [m] 
     97      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   sst      ! sea surface temperature                [Kelvin] 
     98      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   t_zt     ! potential air temperature              [Kelvin] 
     99      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   ssq      ! sea surface specific humidity           [kg/kg] 
     100      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   q_zt     ! specific air humidity at zt             [kg/kg] 
     101      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   U_zu     ! relative wind module at zu                [m/s] 
    106102      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Cd       ! transfer coefficient for momentum         (tau) 
    107103      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ch       ! transfer coefficient for sensible heat (Q_sens) 
    108104      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   Ce       ! transfert coefficient for evaporation   (Q_lat) 
    109       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   t_zu     ! pot. air temp. adjusted at zu             [K] 
    110       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu             [kg/kg] 
     105      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   t_zu     ! pot. air temp. adjusted at zu               [K] 
     106      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. humidity adjusted at zu           [kg/kg] 
    111107      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   U_blk    ! bulk wind at 10m                          [m/s] 
    112  
     108      ! 
    113109      INTEGER :: j_itt 
    114110      LOGICAL ::   l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U 
     
    123119      REAL(wp), DIMENSION(:,:), POINTER ::   zeta_t        ! stability parameter at height zt 
    124120      REAL(wp), DIMENSION(:,:), POINTER ::   ztmp0, ztmp1, ztmp2 
    125  
     121      !!---------------------------------------------------------------------- 
     122      ! 
    126123      IF( nn_timing == 1 )  CALL timing_start('turb_coare') 
    127124 
    128       CALL wrk_alloc( jpi,jpj, u_star, t_star, q_star, zeta_u, dt_zu, dq_zu) 
    129       CALL wrk_alloc( jpi,jpj, znu_a, z0, z0t, ztmp0, ztmp1, ztmp2 ) 
     125      CALL wrk_alloc( jpi,jpj,   u_star, t_star, q_star, zeta_u, dt_zu, dq_zu) 
     126      CALL wrk_alloc( jpi,jpj,   znu_a, z0, z0t, ztmp0, ztmp1, ztmp2 ) 
    130127 
    131128      l_zt_equal_zu = .FALSE. 
     
    136133      !! First guess of temperature and humidity at height zu: 
    137134      t_zu = MAX(t_zt , 0.0)    ! who knows what's given on masked-continental regions... 
    138       q_zu = MAX(q_zt , 1.E-6)  !               " 
     135      q_zu = MAX(q_zt , 1.e-6)  !               " 
    139136 
    140137      !! Pot. temp. difference (and we don't want it to be 0!) 
     
    258255 
    259256 
    260  
    261  
    262257   FUNCTION alfa_charn( pwnd ) 
    263258      !!------------------------------------------------------------------- 
     
    270265      !! Wind greater than 18 m/s :  alfa = 0.018 
    271266      !! 
    272       !! Author: L. Brodeau, june 2016 / AeroBulk 
    273       !!         (https://sourceforge.net/p/aerobulk) 
     267      !! Author: L. Brodeau, june 2016 / AeroBulk  (https://sourceforge.net/p/aerobulk) 
    274268      !!------------------------------------------------------------------- 
    275269      REAL(wp), DIMENSION(jpi,jpj) :: alfa_charn 
     
    278272      INTEGER  ::   ji, jj         ! dummy loop indices 
    279273      REAL(wp) :: zw, zgt10, zgt18 
     274      !!------------------------------------------------------------------- 
    280275      ! 
    281276      DO jj = 1, jpj 
     
    296291      ! 
    297292   END FUNCTION alfa_charn 
    298  
    299293 
    300294 
     
    315309      INTEGER  ::   ji, jj         ! dummy loop indices 
    316310      REAL(wp) ::     zqa          ! local scalar 
     311      !!------------------------------------------------------------------- 
    317312      ! 
    318313      DO jj = 1, jpj 
  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_coare3p5.F90

    r6723 r6727  
    4747   PRIVATE 
    4848 
    49    PUBLIC ::   TURB_COARE3P5 
     49   PUBLIC ::   TURB_COARE3P5   ! called by sbcblk.F90 
    5050 
    5151   !                                   ! COARE own values for given constants: 
  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_ecmwf.F90

    r6723 r6727  
    1919   !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://sourceforge.net/p/aerobulk) 
    2020   !!---------------------------------------------------------------------- 
    21    !! 
    22    !! History :  4.0  !  2016-06  (L.Brodeau) Original code 
    23    !! 
     21   !! History :  4.0  !  2016-02  (L.Brodeau)   Original code 
     22   !!---------------------------------------------------------------------- 
     23 
    2424   !!---------------------------------------------------------------------- 
    2525   !!   turb_ecmwf  : computes the bulk turbulent transfer coefficients 
     
    4747   PRIVATE 
    4848 
    49    PUBLIC :: TURB_ECMWF 
     49   PUBLIC ::   TURB_ECMWF   ! called by sbcblk.F90 
    5050 
    5151   !                   !! ECMWF own values for given constants, taken form IFS documentation... 
  • branches/2016/dev_r6711_SIMPLIF_6_aerobulk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_ncar.F90

    r6723 r6727  
    1515   !!                         L. Brodeau, 2015 
    1616   !!===================================================================== 
    17    !! History :  3.6  !  2016-02  (L.Brodeau) successor of old turb_ncar 
    18    !!                                         of old sbcblk_core.F90 
     17   !! History :  3.6  !  2016-02  (L.Brodeau) successor of old turb_ncar of former sbcblk_core.F90 
    1918   !!---------------------------------------------------------------------- 
    2019 
     
    4544   PRIVATE 
    4645 
    47    PUBLIC :: TURB_NCAR 
    48  
    49    !! NCAR own values for given constants: 
     46   PUBLIC ::   TURB_NCAR   ! called by sbcblk.F90 
     47 
     48   !                              ! NCAR own values for given constants: 
    5049   REAL(wp), PARAMETER ::   rctv0 = 0.608   ! constant to obtain virtual temperature... 
    5150    
Note: See TracChangeset for help on using the changeset viewer.