Changeset 11309


Ignore:
Timestamp:
2019-07-19T15:53:01+02:00 (13 months ago)
Author:
smasson
Message:

dev_r11265_ABL : Gurvan's cosmetic, see #2131

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/SBC/sbcblk.F90

    r11304 r11309  
    7777#endif  
    7878 
    79   INTERFACE cp_air 
    80     MODULE PROCEDURE cp_air_0d, cp_air_2d 
    81   END INTERFACE 
    82  
    83   !!Lolo: should ultimately be moved in the module with all physical constants ? 
    84 !!gm  : In principle, yes. 
    85    REAL(wp)        , PARAMETER ::   Cp_dry = 1005.0       !: Specic heat of dry air, constant pressure      [J/K/kg] 
    86    REAL(wp)        , PARAMETER ::   Cp_vap = 1860.0       !: Specic heat of water vapor, constant pressure  [J/K/kg] 
    87    REAL(wp), PUBLIC, PARAMETER ::   R_dry = 287.05_wp     !: Specific gas constant for dry air              [J/K/kg] 
    88    REAL(wp)        , PARAMETER ::   R_vap = 461.495_wp    !: Specific gas constant for water vapor          [J/K/kg] 
    89    REAL(wp)        , PARAMETER ::   reps0 = R_dry/R_vap   !: ratio of gas constant for dry air and water vapor => ~ 0.622 
    90    REAL(wp), PUBLIC, PARAMETER ::   rctv0 = R_vap/R_dry   !: for virtual temperature (== (1-eps)/eps) => ~ 0.608 
     79   INTERFACE cp_air 
     80      MODULE PROCEDURE cp_air_0d, cp_air_2d 
     81   END INTERFACE 
     82 
     83   !                                   !!* Namelist namsbc_blk : bulk parameters 
     84   LOGICAL          ::   ln_NCAR        ! "NCAR"      algorithm   (Large and Yeager 2008) 
     85   LOGICAL          ::   ln_COARE_3p0   ! "COARE 3.0" algorithm   (Fairall et al. 2003) 
     86   LOGICAL          ::   ln_COARE_3p5   ! "COARE 3.5" algorithm   (Edson et al. 2013) 
     87   LOGICAL          ::   ln_ECMWF       ! "ECMWF"     algorithm   (IFS cycle 31) 
     88   !                                    ! 
     89   REAL(wp)         ::   rn_pfac        !  multiplication factor for precipitation 
     90   REAL(wp), PUBLIC ::   rn_efac        !: multiplication factor for evaporation 
     91   REAL(wp), PUBLIC ::   rn_vfac        !: multiplication factor for ice/ocean velocity in the calculation of wind stress 
     92   REAL(wp)         ::   rn_zqt         !  z(q,t) : height of humidity and temperature measurements 
     93   REAL(wp)         ::   rn_zu          !  z(u)   : height of wind measurements 
     94   !                                    ! 
     95   LOGICAL          ::   ln_Cd_L12      ! ice-atm drag = F( ice concentration )                        (Lupkes et al. JGR2012) 
     96   LOGICAL          ::   ln_Cd_L15      ! ice-atm drag = F( ice concentration, atmospheric stability ) (Lupkes et al. JGR2015) 
     97 
     98   INTEGER  ::   nblk                   ! choice of the bulk algorithm 
     99   !                                       ! associated indices: 
     100   INTEGER, PARAMETER ::   np_NCAR      = 1   ! "NCAR" algorithm        (Large and Yeager 2008) 
     101   INTEGER, PARAMETER ::   np_COARE_3p0 = 2   ! "COARE 3.0" algorithm   (Fairall et al. 2003) 
     102   INTEGER, PARAMETER ::   np_COARE_3p5 = 3   ! "COARE 3.5" algorithm   (Edson et al. 2013) 
     103   INTEGER, PARAMETER ::   np_ECMWF     = 4   ! "ECMWF" algorithm       (IFS cycle 31) 
     104 
     105   !                                                      !!! air parameters 
     106   REAL(wp)        , PARAMETER ::   Cp_dry = 1005.0        !  Specic heat of dry air, constant pressure      [J/K/kg] 
     107   REAL(wp)        , PARAMETER ::   Cp_vap = 1860.0        !  Specic heat of water vapor, constant pressure  [J/K/kg] 
     108   REAL(wp), PUBLIC, PARAMETER ::   R_dry  = 287.05_wp     !: Specific gas constant for dry air              [J/K/kg] 
     109   REAL(wp)        , PARAMETER ::   R_vap  = 461.495_wp    !  Specific gas constant for water vapor          [J/K/kg] 
     110   REAL(wp)        , PARAMETER ::   reps0  = R_dry/R_vap   !  ratio of gas constant for dry air and water vapor => ~ 0.622 
     111   REAL(wp), PUBLIC, PARAMETER ::   rctv0  = R_vap/R_dry   !: for virtual temperature (== (1-eps)/eps) => ~ 0.608 
     112   !                                                      !!! Bulk parameters 
     113   REAL(wp)        , PARAMETER ::   cpa    = 1000.5        ! specific heat of air (only used for ice fluxes now...) 
     114   REAL(wp)        , PARAMETER ::   Ls     =    2.839e6    ! latent heat of sublimation 
     115   REAL(wp)        , PARAMETER ::   Stef   =    5.67e-8    ! Stefan Boltzmann constant 
     116   REAL(wp)        , PARAMETER ::   Cd_ice =    1.4e-3     ! transfer coefficient over ice 
     117   REAL(wp)        , PARAMETER ::   albo   =    0.066      ! ocean albedo assumed to be constant 
     118   ! 
     119   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Cd_atm , Ch_atm , Ce_atm   ! transfer coeffs. for momentum, sensible heat, and evaporation 
     120   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Cdn_oce, Chn_oce, Cen_oce  ! neutral  coeffs (needed for Lupkes et al. 2015 bulk scheme) 
     121   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_zu, q_zu                 ! air temp. and spec. hum. at wind speed height (needed for Lupkes 2015 bulk scheme) 
    91122 
    92123   INTEGER , PUBLIC, PARAMETER ::   jpfld   =11   !: maximum number of files to read 
     
    103134   INTEGER , PUBLIC, PARAMETER ::   jp_hpgj =11   !: index of ABL geostrophic wind or hpg (j-component) (m/s) at T-point 
    104135 
    105    TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   sf   !  structure of input fields (file informations, fields read) 
    106  
    107    !                                             !!! Bulk parameters 
    108    REAL(wp), PARAMETER ::   cpa    = 1000.5         ! specific heat of air (only used for ice fluxes now...) 
    109    REAL(wp), PARAMETER ::   Ls     =    2.839e6     ! latent heat of sublimation 
    110    REAL(wp), PARAMETER ::   Stef   =    5.67e-8     ! Stefan Boltzmann constant 
    111    REAL(wp), PARAMETER ::   Cd_ice =    1.4e-3      ! transfer coefficient over ice 
    112    REAL(wp), PARAMETER ::   albo   =    0.066       ! ocean albedo assumed to be constant 
    113    ! 
    114    !                           !!* Namelist namsbc_blk : bulk parameters 
    115    LOGICAL  ::   ln_NCAR        ! "NCAR"      algorithm   (Large and Yeager 2008) 
    116    LOGICAL  ::   ln_COARE_3p0   ! "COARE 3.0" algorithm   (Fairall et al. 2003) 
    117    LOGICAL  ::   ln_COARE_3p5   ! "COARE 3.5" algorithm   (Edson et al. 2013) 
    118    LOGICAL  ::   ln_ECMWF       ! "ECMWF"     algorithm   (IFS cycle 31) 
    119    ! 
    120    REAL(wp)         ::   rn_pfac        ! multiplication factor for precipitation 
    121    REAL(wp), PUBLIC ::   rn_efac        !: multiplication factor for evaporation 
    122    REAL(wp), PUBLIC ::   rn_vfac        !: multiplication factor for ice/ocean velocity in the calculation of wind stress 
    123    REAL(wp) ::   rn_zqt         ! z(q,t) : height of humidity and temperature measurements 
    124    REAL(wp) ::   rn_zu          ! z(u)   : height of wind measurements 
    125 !!gm ref namelist initialize it so remove the setting to false below 
    126    LOGICAL  ::   ln_Cd_L12 = .FALSE. !  Modify the drag ice-atm depending on ice concentration (from Lupkes et al. JGR2012) 
    127    LOGICAL  ::   ln_Cd_L15 = .FALSE. !  Modify the drag ice-atm depending on ice concentration (from Lupkes et al. JGR2015) 
    128    ! 
    129    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Cd_atm                    ! transfer coefficient for momentum      (tau) 
    130    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Ch_atm                    ! transfer coefficient for sensible heat (Q_sens) 
    131    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   Ce_atm                    ! tansfert coefficient for evaporation   (Q_lat) 
    132    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_zu                      ! air temperature at wind speed height (needed by Lupkes 2015 bulk scheme) 
    133    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_zu                      ! air spec. hum.  at wind speed height (needed by Lupkes 2015 bulk scheme) 
    134    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   cdn_oce, chn_oce, cen_oce ! needed by Lupkes 2015 bulk scheme 
    135  
    136    INTEGER  ::   nblk           ! choice of the bulk algorithm 
    137    !                            ! associated indices: 
    138    INTEGER, PARAMETER ::   np_NCAR      = 1   ! "NCAR" algorithm        (Large and Yeager 2008) 
    139    INTEGER, PARAMETER ::   np_COARE_3p0 = 2   ! "COARE 3.0" algorithm   (Fairall et al. 2003) 
    140    INTEGER, PARAMETER ::   np_COARE_3p5 = 3   ! "COARE 3.5" algorithm   (Edson et al. 2013) 
    141    INTEGER, PARAMETER ::   np_ECMWF     = 4   ! "ECMWF" algorithm       (IFS cycle 31) 
     136   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   sf   !  structure of input atmospheric fields (file informations, fields read) 
    142137 
    143138   !! * Substitutions 
     
    155150      !!------------------------------------------------------------------- 
    156151      ALLOCATE( Cd_atm (jpi,jpj), Ch_atm (jpi,jpj), Ce_atm (jpi,jpj), t_zu(jpi,jpj), q_zu(jpi,jpj), & 
    157          &      cdn_oce(jpi,jpj), chn_oce(jpi,jpj), cen_oce(jpi,jpj), STAT=sbc_blk_alloc ) 
     152         &      Cdn_oce(jpi,jpj), Chn_oce(jpi,jpj), Cen_oce(jpi,jpj), STAT=sbc_blk_alloc ) 
    158153      ! 
    159154      CALL mpp_sum ( 'sbcblk', sbc_blk_alloc ) 
     
    171166      !! 
    172167      !!---------------------------------------------------------------------- 
    173       INTEGER  ::   ifpr                  ! dummy loop indice and argument 
     168      INTEGER  ::   jfpr                  ! dummy loop indice and argument 
    174169      INTEGER  ::   ios, ierror, ioptio   ! Local integer 
    175170      !! 
     
    233228      CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_init', 'surface boundary condition -- bulk formulae', 'namsbc_blk' ) 
    234229      ! 
    235       DO ifpr= 1, jpfld 
     230      DO jfpr= 1, jpfld 
    236231         ! 
    237          IF( TRIM(sf(ifpr)%clrootname) /= 'NOT USED' ) THEN 
    238             IF( ln_abl .AND. (     ifpr == jp_wndi .OR. ifpr == jp_wndj .OR. ifpr == jp_humi   & 
    239                &              .OR. ifpr == jp_hpgi .OR. ifpr == jp_hpgj .OR. ifpr == jp_tair ) ) THEN 
    240                ALLOCATE( sf(ifpr)%fnow(jpi,jpj,jpka) ) 
    241                IF( slf_i(ifpr)%ln_tint )   ALLOCATE( sf(ifpr)%fdta(jpi,jpj,jpka,2) ) 
    242             ELSE 
    243                ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 
    244                IF( slf_i(ifpr)%ln_tint )   ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 
     232         IF( TRIM(sf(jfpr)%clrootname) == 'NOT USED' ) THEN    !--  not used field  --!   (only now allocated and set to zero)  
     233            ALLOCATE( sf(jfpr)%fnow(jpi,jpj,1) ) 
     234            sf(jfpr)%fnow(:,:,1) = 0._wp                  
     235         ELSE                                                  !-- used field  --! 
     236            IF(   ln_abl    .AND.                                                      & 
     237               &    ( jfpr == jp_wndi .OR. jfpr == jp_wndj .OR. jfpr == jp_humi .OR.   & 
     238               &      jfpr == jp_hpgi .OR. jfpr == jp_hpgj .OR. jfpr == jp_tair     )  ) THEN   ! ABL: some fields are 3D input 
     239               ALLOCATE( sf(jfpr)%fnow(jpi,jpj,jpka) ) 
     240               IF( slf_i(jfpr)%ln_tint )   ALLOCATE( sf(jfpr)%fdta(jpi,jpj,jpka,2) ) 
     241            ELSE                                                                                ! others or Bulk fields are 2D fiels 
     242               ALLOCATE( sf(jfpr)%fnow(jpi,jpj,1) ) 
     243               IF( slf_i(jfpr)%ln_tint )   ALLOCATE( sf(jfpr)%fdta(jpi,jpj,1,2) ) 
    245244            ENDIF 
    246245            ! 
    247             IF( slf_i(ifpr)%freqh > 0. .AND. MOD( NINT(3600. * slf_i(ifpr)%freqh), nn_fsbc * NINT(rdt) ) /= 0 )   & 
     246            IF( slf_i(jfpr)%freqh > 0. .AND. MOD( NINT(3600. * slf_i(jfpr)%freqh), nn_fsbc * NINT(rdt) ) /= 0 )   & 
    248247               &  CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rdt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.',   & 
    249248               &                 '               This is not ideal. You should consider changing either rdt or nn_fsbc value...' ) 
     
    251250      END DO 
    252251      ! 
    253       IF ( ln_wave ) THEN 
    254       !Activated wave module but neither drag nor stokes drift activated 
    255          IF ( .NOT.(ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor ) )   THEN 
    256             CALL ctl_stop( 'STOP',  'Ask for wave coupling but ln_cdgw=F, ln_sdw=F, ln_tauwoc=F, ln_stcor=F' ) 
    257       !drag coefficient read from wave model definable only with mfs bulk formulae and core  
    258          ELSEIF (ln_cdgw .AND. .NOT. ln_NCAR )       THEN        
    259              CALL ctl_stop( 'drag coefficient read from wave model definable only with NCAR and CORE bulk formulae') 
    260          ELSEIF (ln_stcor .AND. .NOT. ln_sdw)                             THEN 
    261              CALL ctl_stop( 'Stokes-Coriolis term calculated only if activated Stokes Drift ln_sdw=T') 
     252      IF( ln_wave ) THEN      ! surface waves 
     253         IF( .NOT.(ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor ) )   &   ! Activated wave module but neither drag nor stokes drift activated 
     254            &   CALL ctl_stop( 'sbc_blk_init: Ask for wave coupling but ln_cdgw=ln_sdw=ln_tauwoc=ln_stcor=F' ) 
     255         IF( ln_cdgw .AND. .NOT.ln_NCAR )                                 &   ! drag coefficient read from wave model only with NCAR bulk formulae  
     256            &   CALL ctl_stop( 'sbc_blk_init: drag coefficient read from wave model need NCAR bulk formulae') 
     257         IF( ln_stcor .AND. .NOT.ln_sdw )                                 & 
     258            CALL ctl_stop( 'sbc_blk_init: Stokes-Coriolis term calculated only if activated Stokes Drift ln_sdw=T') 
     259      ELSE 
     260         IF( ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor ) THEN 
     261            CALL ctl_warn( 'sbc_blk_init: ln_wave=F, set all wave-related namelist parameter to FALSE') 
     262            ln_cdgw =.FALSE.   ;   ln_sdw =.FALSE.   ;   ln_tauwoc =.FALSE.   ;   ln_stcor =.FALSE.    
    262263         ENDIF 
    263       ELSE 
    264       IF ( ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor )                &  
    265          &   CALL ctl_stop( 'Not Activated Wave Module (ln_wave=F) but asked coupling ',    & 
    266          &                  'with drag coefficient (ln_cdgw =T) '  ,                        & 
    267          &                  'or Stokes Drift (ln_sdw=T) ' ,                                 & 
    268          &                  'or ocean stress modification due to waves (ln_tauwoc=T) ',      &   
    269          &                  'or Stokes-Coriolis term (ln_stcori=T)'  ) 
    270264      ENDIF  
    271265      ! 
    272       IF( ln_abl ) THEN      ! ABL: read 3D fields for wind, temperature and humidity      
     266      IF( ln_abl ) THEN       ! ABL: read 3D fields for wind, temperature, humidity and pressure gradient     
    273267         rn_zqt = ght_abl(2)          ! set the bulk altitude to ABL first level 
    274268         rn_zu  = ght_abl(2) 
    275269         IF(lwp) WRITE(numout,*) 
    276          IF(lwp) WRITE(numout,*) '   ABL formulation: overwrite rn_zqt & rn_zu with ABL first level altitude' 
     270         IF(lwp) WRITE(numout,*) '  ABL formulation:  overwrite rn_zqt & rn_zu with ABL first level altitude' 
    277271      ENDIF 
    278272      !            
     
    348342      ! 
    349343      !                                            ! compute the surface ocean fluxes using bulk formulea 
    350       IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 
     344      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 
    351345         ! 
    352346         CALL blk_oce_1( kt, sf(jp_wndi)%fnow(:,:,1), sf(jp_wndj)%fnow(:,:,1),   &   !   <<= in 
     
    359353            &                sf(jp_snow)%fnow(:,:,1), sst_m,                     &   !   <<= in 
    360354            &                zsen, zevp )                                            !   <=> in out 
    361           
    362355      ENDIF 
    363356          
    364357#if defined key_cice 
    365       IF( MOD( kt - 1, nn_fsbc ) == 0 )   THEN 
     358      IF( MOD( kt-1, nn_fsbc ) == 0 )   THEN 
    366359         qlw_ice(:,:,1)   = sf(jp_qlw )%fnow(:,:,1) 
    367360         IF( ln_dm2dc ) THEN ; qsr_ice(:,:,1) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) 
     
    468461      ! 
    469462      CASE( np_NCAR      )   ;   CALL turb_ncar    ( rn_zqt, rn_zu, zst, ztpot, pssq, phumi, wndm,   &  ! NCAR-COREv2 
    470          &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce ) 
     463         &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, Cdn_oce, Chn_oce, Cen_oce ) 
    471464      CASE( np_COARE_3p0 )   ;   CALL turb_coare   ( rn_zqt, rn_zu, zst, ztpot, pssq, phumi, wndm,   &  ! COARE v3.0 
    472          &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce ) 
     465         &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, Cdn_oce, Chn_oce, Cen_oce ) 
    473466      CASE( np_COARE_3p5 )   ;   CALL turb_coare3p5( rn_zqt, rn_zu, zst, ztpot, pssq, phumi, wndm,   &  ! COARE v3.5 
    474          &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce ) 
     467         &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, Cdn_oce, Chn_oce, Cen_oce ) 
    475468      CASE( np_ECMWF     )   ;   CALL turb_ecmwf   ( rn_zqt, rn_zu, zst, ztpot, pssq, phumi, wndm,   &  ! ECMWF 
    476          &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce ) 
     469         &                                           Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, Cdn_oce, Chn_oce, Cen_oce ) 
    477470      CASE DEFAULT 
    478471         CALL ctl_stop( 'STOP', 'sbc_oce: non-existing bulk formula selected' ) 
Note: See TracChangeset for help on using the changeset viewer.