New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 11962 for NEMO/branches/2019/dev_r11085_ASINTER-05_Brodeau_Advanced_Bulk/src/OCE – NEMO

Ignore:
Timestamp:
2019-11-25T23:31:07+01:00 (4 years ago)
Author:
laurent
Message:

Syntax improvements and minor bug fixes...

Location:
NEMO/branches/2019/dev_r11085_ASINTER-05_Brodeau_Advanced_Bulk/src/OCE/SBC
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11085_ASINTER-05_Brodeau_Advanced_Bulk/src/OCE/SBC/sbcblk.F90

    r11841 r11962  
    142142      !!------------------------------------------------------------------- 
    143143      ALLOCATE( Cd_atm (jpi,jpj), Ch_atm (jpi,jpj), Ce_atm (jpi,jpj), t_zu(jpi,jpj), q_zu(jpi,jpj), & 
    144          &      cdn_oce(jpi,jpj), chn_oce(jpi,jpj), cen_oce(jpi,jpj), STAT=sbc_blk_alloc ) 
     144         &      cdn_oce(jpi,jpj), chn_oce(jpi,jpj), cen_oce(jpi,jpj), tsk(jpi,jpj), STAT=sbc_blk_alloc ) 
    145145      ! 
    146146      CALL mpp_sum ( 'sbcblk', sbc_blk_alloc ) 
    147147      IF( sbc_blk_alloc /= 0 )   CALL ctl_stop( 'STOP', 'sbc_blk_alloc: failed to allocate arrays' ) 
    148148   END FUNCTION sbc_blk_alloc 
    149  
    150    !LB: 
    151    INTEGER FUNCTION sbc_blk_cswl_alloc() 
    152       !!------------------------------------------------------------------- 
    153       !!             ***  ROUTINE sbc_blk_cswl_alloc *** 
    154       !!------------------------------------------------------------------- 
    155       !WRITE(numout,*) '*** LB: allocating tsk!' 
    156       ALLOCATE( tsk(jpi,jpj), STAT=sbc_blk_cswl_alloc ) 
    157       !WRITE(numout,*) '*** LB: done!' 
    158       CALL mpp_sum ( 'sbcblk', sbc_blk_cswl_alloc ) 
    159       IF( sbc_blk_cswl_alloc /= 0 )   CALL ctl_stop( 'STOP', 'sbc_blk_cswl_alloc: failed to allocate arrays' ) 
    160    END FUNCTION sbc_blk_cswl_alloc 
    161    !LB. 
    162149 
    163150 
     
    222209      !LB: 
    223210      !                             !** initialization of the cool-skin / warm-layer parametrization 
    224       IF( ln_skin_cs .OR. ln_skin_wl ) THEN 
    225          IF ( ln_NCAR ) CALL ctl_stop( 'sbc_blk_init: Cool-skin/warm-layer param. not compatible with NCAR algorithm!' ) 
    226          !                       ! allocate array(s) for cool-skin/warm-layer param. 
    227          IF( sbc_blk_cswl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_blk : unable to allocate standard arrays' ) 
    228       END IF 
     211      IF( ln_NCAR .AND. (ln_skin_cs .OR. ln_skin_wl) ) & 
     212         & CALL ctl_stop( 'sbc_blk_init: Cool-skin/warm-layer param. not compatible with NCAR algorithm!' ) 
    229213      ! 
    230214      ioptio = 0 
     
    322306         ! 
    323307         WRITE(numout,*) 
    324          WRITE(numout,*) '      use cool-skin  parameterization (SSST)  ln_skin_cs  = ', ln_skin_cs !LB 
    325          WRITE(numout,*) '      use warm-layer parameterization (SSST)  ln_skin_wl  = ', ln_skin_wl !LB 
     308         WRITE(numout,*) '      use cool-skin  parameterization (SSST)  ln_skin_cs  = ', ln_skin_cs 
     309         WRITE(numout,*) '      use warm-layer parameterization (SSST)  ln_skin_wl  = ', ln_skin_wl 
    326310         ! 
    327          !LB: 
    328311         WRITE(numout,*) 
    329312         SELECT CASE( nhumi )              !* Print the choice of air humidity 
     
    332315         CASE( np_humi_rlh )   ;   WRITE(numout,*) '   ==>>>   air humidity is RELATIVE HUMIDITY     [%]' 
    333316         END SELECT 
    334          !LB. 
    335317         ! 
    336318      ENDIF 
     
    390372         ENDIF 
    391373         tatm_ice(:,:)    = sf(jp_tair)%fnow(:,:,1) 
    392          !LB: 
     374 
    393375         SELECT CASE( nhumi ) 
    394376         CASE( np_humi_sph ) 
     
    399381            qatm_ice(:,:) = q_air_rh( 0.01_wp*sf(jp_humi)%fnow(:,:,1), sf(jp_tair)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1)) !LB: 0.01 => RH is % percent in file 
    400382         END SELECT 
    401          !LB. 
     383 
    402384         tprecip(:,:)     = sf(jp_prec)%fnow(:,:,1) * rn_pfac 
    403385         sprecip(:,:)     = sf(jp_snow)%fnow(:,:,1) * rn_pfac 
     
    445427      REAL(wp), DIMENSION(jpi,jpj) ::   zU_zu             ! bulk wind speed at height zu  [m/s] 
    446428      REAL(wp), DIMENSION(jpi,jpj) ::   ztpot             ! potential temperature of air at z=rn_zqt [K] 
    447       REAL(wp), DIMENSION(jpi,jpj) ::   zqair             ! specific humidity     of air at z=rn_zqt [kg/kg] !LB 
     429      REAL(wp), DIMENSION(jpi,jpj) ::   zqair             ! specific humidity     of air at z=rn_zqt [kg/kg] 
    448430      !!--------------------------------------------------------------------- 
    449431      ! 
     
    510492         zqair(:,:) =        sf(jp_humi)%fnow(:,:,1)      ! what we read in file is already a spec. humidity! 
    511493      CASE( np_humi_dpt ) 
    512          IF (lwp) WRITE(numout,*) ' *** blk_oce => computing q_air out of d_air and slp !' !LBrm 
     494         !IF (lwp) WRITE(numout,*) ' *** blk_oce => computing q_air out of d_air and slp !' !LBrm 
    513495         zqair(:,:) = q_sat( sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1) ) 
    514496      CASE( np_humi_rlh ) 
    515          IF (lwp) WRITE(numout,*) ' *** blk_oce => computing q_air out of RH, t_air and slp !' !LBrm 
     497         !IF (lwp) WRITE(numout,*) ' *** blk_oce => computing q_air out of RH, t_air and slp !' !LBrm 
    516498         zqair(:,:) = q_air_rh( 0.01_wp*sf(jp_humi)%fnow(:,:,1), sf(jp_tair)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1) ) !LB: 0.01 => RH is % percent in file 
    517499      END SELECT 
     
    529511 
    530512         CASE( np_COARE_3p0 ) 
    531             IF (lwp) WRITE(numout,*) ' *** blk_oce => calling "turb_coare3p0" WITH CSWL options!!!, gdept_1d(1)=', gdept_1d(1) !LBrm 
    532             CALL turb_coare3p0 ( kt, rn_zqt, rn_zu, zst, ztpot, zsq, zqair, wndm, ln_skin_cs, ln_skin_wl,&  ! COARE v3.0 
    533                &                Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,    & 
     513            CALL turb_coare3p0 ( kt, rn_zqt, rn_zu, zst, ztpot, zsq, zqair, wndm, ln_skin_cs, ln_skin_wl, & 
     514               &                Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,     & 
    534515               &                Qsw=qsr(:,:), rad_lw=sf(jp_qlw)%fnow(:,:,1), slp=sf(jp_slp)%fnow(:,:,1) ) 
    535516 
    536517         CASE( np_COARE_3p6 ) 
    537             IF (lwp) WRITE(numout,*) ' *** blk_oce => calling "turb_coare3p6" WITH CSWL options!!!, gdept_1d(1)=', gdept_1d(1) !LBrm 
    538             CALL turb_coare3p6 ( kt, rn_zqt, rn_zu, zst, ztpot, zsq, zqair, wndm, ln_skin_cs, ln_skin_wl,&  ! COARE v3.6 
    539                &                Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,    & 
     518            CALL turb_coare3p6 ( kt, rn_zqt, rn_zu, zst, ztpot, zsq, zqair, wndm, ln_skin_cs, ln_skin_wl, & 
     519               &                Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,     & 
    540520               &                Qsw=qsr(:,:), rad_lw=sf(jp_qlw)%fnow(:,:,1), slp=sf(jp_slp)%fnow(:,:,1) ) 
    541521 
    542522         CASE( np_ECMWF     ) 
    543             IF (lwp) WRITE(numout,*) ' *** blk_oce => calling "turb_ecmwf" WITH CSWL options!!!, gdept_1d(1)=', gdept_1d(1) !LBrm 
    544             CALL turb_ecmwf   ( kt, rn_zqt, rn_zu, zst, ztpot, zsq, zqair, wndm, ln_skin_cs, ln_skin_wl,    &  ! ECMWF 
    545                &                Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,   & 
     523            CALL turb_ecmwf   ( kt, rn_zqt, rn_zu, zst, ztpot, zsq, zqair, wndm, ln_skin_cs, ln_skin_wl,  & 
     524               &                Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce,     & 
    546525               &                Qsw=qsr(:,:), rad_lw=sf(jp_qlw)%fnow(:,:,1), slp=sf(jp_slp)%fnow(:,:,1) ) 
    547526 
     
    566545      ELSE !IF ( ln_skin_cs .OR. ln_skin_wl ) 
    567546 
    568  
    569547         SELECT CASE( nblk )        !==  transfer coefficients  ==!   Cd, Ch, Ce at T-point 
    570548            ! 
    571549         CASE( np_NCAR      ) 
    572             CALL turb_ncar    ( rn_zqt, rn_zu, zst, ztpot, zsq, zqair, wndm,   &  ! NCAR-COREv2 
     550            CALL turb_ncar    (      rn_zqt, rn_zu, zst, ztpot, zsq, zqair, wndm,                         & 
    573551               &                Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce ) 
    574552 
    575553         CASE( np_COARE_3p0 ) 
    576             IF (lwp) WRITE(numout,*) ' *** blk_oce => calling "turb_coare3p0" WITHOUT CSWL optional arrays!!!' !LBrm 
    577             CALL turb_coare3p0 ( kt, rn_zqt, rn_zu, zst, ztpot, zsq, zqair, wndm, ln_skin_cs, ln_skin_wl,&  ! COARE v3.0 
     554            CALL turb_coare3p0 ( kt, rn_zqt, rn_zu, zst, ztpot, zsq, zqair, wndm, ln_skin_cs, ln_skin_wl, & 
    578555               &                Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce ) 
    579556 
    580557         CASE( np_COARE_3p6 ) 
    581             IF (lwp) WRITE(numout,*) ' *** blk_oce => calling "turb_coare3p6" WITHOUT CSWL optional arrays!!!' !LBrm 
    582             CALL turb_coare3p6 ( kt, rn_zqt, rn_zu, zst, ztpot, zsq, zqair, wndm, ln_skin_cs, ln_skin_wl,&  ! COARE v3.6 
     558            CALL turb_coare3p6 ( kt, rn_zqt, rn_zu, zst, ztpot, zsq, zqair, wndm, ln_skin_cs, ln_skin_wl, & 
    583559               &                Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce ) 
    584560 
    585561         CASE( np_ECMWF     ) 
    586             IF (lwp) WRITE(numout,*) ' *** blk_oce => calling "turb_ecmwf" WITHOUT CSWL optional arrays!!!' !LBrm 
    587             CALL turb_ecmwf   ( kt, rn_zqt, rn_zu, zst, ztpot, zsq, zqair, wndm, ln_skin_cs, ln_skin_wl,    &  ! ECMWF 
     562            CALL turb_ecmwf   ( kt, rn_zqt, rn_zu, zst, ztpot, zsq, zqair, wndm, ln_skin_cs, ln_skin_wl,  & 
    588563               &                Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce ) 
    589564 
     
    596571      !!      CALL iom_put( "Cd_oce", Cd_atm)  ! output value of pure ocean-atm. transfer coef. 
    597572      !!      CALL iom_put( "Ch_oce", Ch_atm)  ! output value of pure ocean-atm. transfer coef. 
    598        
     573 
    599574      IF( ABS(rn_zu - rn_zqt) < 0.1_wp ) THEN 
    600575         !! If zu == zt, then ensuring once for all that: 
     
    602577         q_zu(:,:) = zqair(:,:) 
    603578      END IF 
    604        
     579 
    605580 
    606581      !  Turbulent fluxes over ocean  => BULK_FORMULA @ sbcblk_phy.F90 
    607582      ! ------------------------------------------------------------- 
    608        
    609       CALL BULK_FORMULA( rn_zu, zst(:,:), zsq(:,:), t_zu(:,:), q_zu(:,:), Cd_atm(:,:), Ch_atm(:,:), Ce_atm(:,:), & 
    610          &                 wndm(:,:), zU_zu(:,:), sf(jp_slp)%fnow(:,:,1), & 
    611          &                 taum(:,:), zqsb(:,:), zqla(:,:),               & 
    612          &                 pEvap=zevap(:,:), prhoa=rhoa(:,:) ) 
    613        
     583 
     584      CALL BULK_FORMULA( rn_zu, zst(:,:), zsq(:,:), t_zu(:,:), q_zu(:,:), & 
     585         &               Cd_atm(:,:), Ch_atm(:,:), Ce_atm(:,:),           & 
     586         &               wndm(:,:), zU_zu(:,:), sf(jp_slp)%fnow(:,:,1),   & 
     587         &               taum(:,:), zqsb(:,:), zqla(:,:),                 & 
     588         &               pEvap=zevap(:,:), prhoa=rhoa(:,:) ) 
     589 
    614590      zqla(:,:)  =  zqla(:,:) * tmask(:,:,1) 
    615591      zqsb(:,:)  =  zqsb(:,:) * tmask(:,:,1) 
    616592      taum(:,:)  =  taum(:,:) * tmask(:,:,1) 
    617593      zevap(:,:) = zevap(:,:) * tmask(:,:,1) 
    618        
     594 
    619595      ! Tau i and j component on T-grid points, using array "Cd_atm" as a temporary array... 
    620596      Cd_atm = 0._wp 
    621597      WHERE ( wndm > 0._wp ) Cd_atm = taum / wndm 
    622598      zwnd_i = Cd_atm * zwnd_i 
    623       zwnd_j = Cd_atm * zwnd_j       
    624       !DO jj = 1, jpj             ! tau i and j component on T-grid points 
    625       !   DO ji = 1, jpi 
    626       !      zztmp = taum(ji,jj) / MAX( wndm(ji,jj) , 0.01_wp ) 
    627       !      zwnd_i(ji,jj) = zztmp * zwnd_i(ji,jj) 
    628       !      zwnd_j(ji,jj) = zztmp * zwnd_j(ji,jj) 
    629       !   END DO 
    630       !END DO 
     599      zwnd_j = Cd_atm * zwnd_j 
     600 
    631601      !                          ! add the HF tau contribution to the wind stress module 
    632602      IF( lhftau )   taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:,1) 
     
    652622      ! ----------------------------------------------------------------------------- ! 
    653623 
    654       !! LB: now moved after Turbulent fluxes because must use the skin temperature rather that the SST ! (zst is skin temperature if ln_skin_cs==.TRUE. .OR. ln_skin_wl==.TRUE.) 
     624      !! LB: now moved after Turbulent fluxes because must use the skin temperature rather that the SST 
     625      !! (zst is skin temperature if ln_skin_cs==.TRUE. .OR. ln_skin_wl==.TRUE.) 
    655626      zqlw(:,:) = emiss_w * ( sf(jp_qlw)%fnow(:,:,1) - stefan*zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:) ) * tmask(:,:,1)   ! Net radiative longwave flux 
    656627 
     
    848819         zqair(:,:) =        sf(jp_humi)%fnow(:,:,1)      ! what we read in file is already a spec. humidity! 
    849820      CASE( np_humi_dpt ) 
    850          IF (lwp) WRITE(numout,*) ' *** blk_ice_flx => computing q_air out of d_air and slp !' !LBrm 
     821         !IF (lwp) WRITE(numout,*) ' *** blk_ice_flx => computing q_air out of d_air and slp !' !LBrm 
    851822         zqair(:,:) = q_sat( sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1) ) 
    852823      CASE( np_humi_rlh ) 
    853          IF (lwp) WRITE(numout,*) ' *** blk_ice_flx => computing q_air out of RH, t_air and slp !' !LBrm 
     824         !IF (lwp) WRITE(numout,*) ' *** blk_ice_flx => computing q_air out of RH, t_air and slp !' !LBrm 
    854825         zqair(:,:) = q_air_rh( 0.01_wp*sf(jp_humi)%fnow(:,:,1), sf(jp_tair)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1) ) !LB: 0.01 => RH is % percent in file 
    855826      END SELECT 
  • NEMO/branches/2019/dev_r11085_ASINTER-05_Brodeau_Advanced_Bulk/src/OCE/SBC/sbcblk_algo_coare3p0.F90

    r11851 r11962  
    4343   PRIVATE 
    4444 
    45    PUBLIC :: COARE3P0_INIT, TURB_COARE3P0 
     45   PUBLIC :: SBCBLK_ALGO_COARE3P0_INIT, TURB_COARE3P0 
    4646 
    4747   !! COARE own values for given constants: 
     
    5555 
    5656 
    57    SUBROUTINE coare3p0_init(l_use_cs, l_use_wl) 
     57   SUBROUTINE sbcblk_algo_coare3p0_init(l_use_cs, l_use_wl) 
    5858      !!--------------------------------------------------------------------- 
    59       !!                  ***  FUNCTION coare3p0_init  *** 
     59      !!                  ***  FUNCTION sbcblk_algo_coare3p0_init  *** 
    6060      !! 
    6161      !! INPUT : 
     
    7171         ierr = 0 
    7272         ALLOCATE ( Tau_ac(jpi,jpj) , Qnt_ac(jpi,jpj), dT_wl(jpi,jpj), Hz_wl(jpi,jpj), STAT=ierr ) 
    73          IF( ierr > 0 ) CALL ctl_stop( ' COARE3P0_INIT => allocation of Tau_ac, Qnt_ac, dT_wl & Hz_wl failed!' ) 
     73         IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_COARE3P0_INIT => allocation of Tau_ac, Qnt_ac, dT_wl & Hz_wl failed!' ) 
    7474         Tau_ac(:,:) = 0._wp 
    7575         Qnt_ac(:,:) = 0._wp 
     
    8080         ierr = 0 
    8181         ALLOCATE ( dT_cs(jpi,jpj), STAT=ierr ) 
    82          IF( ierr > 0 ) CALL ctl_stop( ' COARE3P0_INIT => allocation of dT_cs failed!' ) 
     82         IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_COARE3P0_INIT => allocation of dT_cs failed!' ) 
    8383         dT_cs(:,:) = -0.25_wp  ! First guess of skin correction 
    8484      END IF 
    85    END SUBROUTINE coare3p0_init 
     85   END SUBROUTINE sbcblk_algo_coare3p0_init 
    8686 
    8787 
     
    185185      REAL(wp), DIMENSION(jpi,jpj) :: ztmp0, ztmp1, ztmp2 
    186186      ! 
    187       REAL(wp), DIMENSION(:,:), ALLOCATABLE :: & 
    188          &              zeta_t,   &  ! stability parameter at height zt 
    189          &                zsst,   &  ! to back up the initial bulk SST 
    190          &                pdTc,   &  ! SST increment "dT" for cool-skin correction           [K] 
    191          &                pdTw,   &  ! SST increment "dT" for warm layer correction          [K] 
    192          &                zHwl       ! depth of warm-layer [m] 
     187      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zeta_t  ! stability parameter at height zt 
     188      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zsst    ! to back up the initial bulk SST 
     189      ! 
    193190      CHARACTER(len=40), PARAMETER :: crtnm = 'turb_coare3p0@sbcblk_algo_coare3p0' 
    194191      !!---------------------------------------------------------------------------------- 
    195       IF ( kt == nit000 ) CALL COARE3P0_INIT(l_use_cs, l_use_wl) 
     192      IF ( kt == nit000 ) CALL SBCBLK_ALGO_COARE3P0_INIT(l_use_cs, l_use_wl) 
    196193 
    197194      l_zt_equal_zu = .FALSE. 
  • NEMO/branches/2019/dev_r11085_ASINTER-05_Brodeau_Advanced_Bulk/src/OCE/SBC/sbcblk_algo_coare3p6.F90

    r11851 r11962  
    4343   PRIVATE 
    4444 
    45    PUBLIC :: COARE3P6_INIT, TURB_COARE3P6 
     45   PUBLIC :: SBCBLK_ALGO_COARE3P6_INIT, TURB_COARE3P6 
    4646 
    4747   !! COARE own values for given constants: 
     
    5555 
    5656 
    57    SUBROUTINE coare3p6_init(l_use_cs, l_use_wl) 
     57   SUBROUTINE sbcblk_algo_coare3p6_init(l_use_cs, l_use_wl) 
    5858      !!--------------------------------------------------------------------- 
    59       !!                  ***  FUNCTION coare3p6_init  *** 
     59      !!                  ***  FUNCTION sbcblk_algo_coare3p6_init  *** 
    6060      !! 
    6161      !! INPUT : 
     
    7171         ierr = 0 
    7272         ALLOCATE ( Tau_ac(jpi,jpj) , Qnt_ac(jpi,jpj), dT_wl(jpi,jpj), Hz_wl(jpi,jpj), STAT=ierr ) 
    73          IF( ierr > 0 ) CALL ctl_stop( ' COARE3P6_INIT => allocation of Tau_ac, Qnt_ac, dT_wl & Hz_wl failed!' ) 
     73         IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_COARE3P6_INIT => allocation of Tau_ac, Qnt_ac, dT_wl & Hz_wl failed!' ) 
    7474         Tau_ac(:,:) = 0._wp 
    7575         Qnt_ac(:,:) = 0._wp 
     
    8080         ierr = 0 
    8181         ALLOCATE ( dT_cs(jpi,jpj), STAT=ierr ) 
    82          IF( ierr > 0 ) CALL ctl_stop( ' COARE3P6_INIT => allocation of dT_cs failed!' ) 
     82         IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_COARE3P6_INIT => allocation of dT_cs failed!' ) 
    8383         dT_cs(:,:) = -0.25_wp  ! First guess of skin correction 
    8484      END IF 
    85    END SUBROUTINE coare3p6_init 
     85   END SUBROUTINE sbcblk_algo_coare3p6_init 
    8686 
    8787 
     
    185185      REAL(wp), DIMENSION(jpi,jpj) :: ztmp0, ztmp1, ztmp2 
    186186      ! 
    187       REAL(wp), DIMENSION(:,:), ALLOCATABLE :: & 
    188          &              zeta_t,   &  ! stability parameter at height zt 
    189          &                zsst,   &  ! to back up the initial bulk SST 
    190          &                pdTc,   &  ! SST increment "dT" for cool-skin correction           [K] 
    191          &                pdTw,   &  ! SST increment "dT" for warm layer correction          [K] 
    192          &                zHwl       ! depth of warm-layer [m] 
     187      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zeta_t  ! stability parameter at height zt 
     188      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zsst    ! to back up the initial bulk SST 
     189      ! 
    193190      CHARACTER(len=40), PARAMETER :: crtnm = 'turb_coare3p6@sbcblk_algo_coare3p6' 
    194191      !!---------------------------------------------------------------------------------- 
    195       IF ( kt == nit000 ) CALL COARE3P6_INIT(l_use_cs, l_use_wl) 
     192      IF ( kt == nit000 ) CALL SBCBLK_ALGO_COARE3P6_INIT(l_use_cs, l_use_wl) 
    196193 
    197194      l_zt_equal_zu = .FALSE. 
  • NEMO/branches/2019/dev_r11085_ASINTER-05_Brodeau_Advanced_Bulk/src/OCE/SBC/sbcblk_algo_ecmwf.F90

    r11845 r11962  
    4444   PRIVATE 
    4545 
    46    PUBLIC :: ECMWF_INIT, TURB_ECMWF 
     46   PUBLIC :: SBCBLK_ALGO_ECMWF_INIT, TURB_ECMWF 
    4747 
    4848   !! ECMWF own values for given constants, taken form IFS documentation... 
     
    6161 
    6262 
    63    SUBROUTINE ecmwf_init(l_use_cs, l_use_wl) 
     63   SUBROUTINE sbcblk_algo_ecmwf_init(l_use_cs, l_use_wl) 
    6464      !!--------------------------------------------------------------------- 
    65       !!                  ***  FUNCTION ecmwf_init  *** 
     65      !!                  ***  FUNCTION sbcblk_algo_ecmwf_init  *** 
    6666      !! 
    6767      !! INPUT : 
     
    7777         ierr = 0 
    7878         ALLOCATE ( dT_wl(jpi,jpj), Hz_wl(jpi,jpj), STAT=ierr ) 
    79          IF( ierr > 0 ) CALL ctl_stop( ' ECMWF_INIT => allocation of dT_wl & Hz_wl failed!' ) 
     79         IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_ECMWF_INIT => allocation of dT_wl & Hz_wl failed!' ) 
    8080         dT_wl(:,:)  = 0._wp 
    8181         Hz_wl(:,:)  = rd0 ! (rd0, constant, = 3m is default for Zeng & Beljaars) 
     
    8484         ierr = 0 
    8585         ALLOCATE ( dT_cs(jpi,jpj), STAT=ierr ) 
    86          IF( ierr > 0 ) CALL ctl_stop( ' ECMWF_INIT => allocation of dT_cs failed!' ) 
     86         IF( ierr > 0 ) CALL ctl_stop( ' SBCBLK_ALGO_ECMWF_INIT => allocation of dT_cs failed!' ) 
    8787         dT_cs(:,:) = -0.25_wp  ! First guess of skin correction 
    8888      END IF 
    89    END SUBROUTINE ecmwf_init 
     89   END SUBROUTINE sbcblk_algo_ecmwf_init 
    9090 
    9191 
     
    182182      LOGICAL :: l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U 
    183183      ! 
    184       REAL(wp), DIMENSION(jpi,jpj) ::  & 
    185          &  u_star, t_star, q_star, & 
    186          &  dt_zu, dq_zu,    & 
    187          &  znu_a,           & !: Nu_air, Viscosity of air 
    188          &  Linv,            & !: 1/L (inverse of Monin Obukhov length... 
    189          &  z0, z0t, z0q 
    190       ! 
    191       REAL(wp), DIMENSION(:,:), ALLOCATABLE :: & 
    192          &                zsst,   &  ! to back up the initial bulk SST 
    193          &                pdTc,   &  ! SST increment "dT" for cool-skin correction           [K] 
    194          &                pdTw       ! SST increment "dT" for warm layer correction          [K] 
    195       ! 
    196       REAL(wp), DIMENSION(jpi,jpj) ::   func_m, func_h 
    197       REAL(wp), DIMENSION(jpi,jpj) ::   ztmp0, ztmp1, ztmp2 
     184      REAL(wp), DIMENSION(jpi,jpj) ::  u_star, t_star, q_star 
     185      REAL(wp), DIMENSION(jpi,jpj) :: dt_zu, dq_zu      
     186      REAL(wp), DIMENSION(jpi,jpj) :: znu_a !: Nu_air, Viscosity of air 
     187      REAL(wp), DIMENSION(jpi,jpj) :: Linv  !: 1/L (inverse of Monin Obukhov length... 
     188      REAL(wp), DIMENSION(jpi,jpj) :: z0, z0t, z0q 
     189      ! 
     190      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zsst  ! to back up the initial bulk SST 
     191      ! 
     192      REAL(wp), DIMENSION(jpi,jpj) :: func_m, func_h 
     193      REAL(wp), DIMENSION(jpi,jpj) :: ztmp0, ztmp1, ztmp2 
    198194      CHARACTER(len=40), PARAMETER :: crtnm = 'turb_ecmwf@sbcblk_algo_ecmwf.F90' 
    199195      !!---------------------------------------------------------------------------------- 
    200196 
    201       IF ( kt == nit000 ) CALL ECMWF_INIT(l_use_cs, l_use_wl) 
     197      IF ( kt == nit000 ) CALL SBCBLK_ALGO_ECMWF_INIT(l_use_cs, l_use_wl) 
    202198 
    203199      l_zt_equal_zu = .FALSE. 
     
    367363            CALL WL_ECMWF( Qsw, ztmp1, u_star, zsst ) 
    368364            !! Updating T_s and q_s !!! 
    369             T_s(:,:) = zsst(:,:) + dT_wl(:,:)*tmask(:,:,1) 
     365            T_s(:,:) = zsst(:,:) + dT_wl(:,:)*tmask(:,:,1) ! 
    370366            IF( l_use_cs ) T_s(:,:) = T_s(:,:) + dT_cs(:,:)*tmask(:,:,1) 
    371367            q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:)) 
  • NEMO/branches/2019/dev_r11085_ASINTER-05_Brodeau_Advanced_Bulk/src/OCE/SBC/sbcblk_phy.F90

    r11845 r11962  
    531531            zCe = zz0*pqst(ji,jj)/zdq 
    532532 
    533             CALL BULK_FORMULA( pzu, pTs(ji,jj), pqs(ji,jj), pTa(ji,jj), pqa(ji,jj), zCd, zCh, zCe, & 
    534                &              pwnd(ji,jj), pUb(ji,jj), pslp(ji,jj), & 
     533            CALL BULK_FORMULA( pzu, pTs(ji,jj), pqs(ji,jj), pTa(ji,jj), pqa(ji,jj), & 
     534               &              zCd, zCh, zCe,                                        & 
     535               &              pwnd(ji,jj), pUb(ji,jj), pslp(ji,jj),                 & 
    535536               &              pTau(ji,jj), zQsen, zQlat ) 
    536  
     537             
    537538            zTs2  = pTs(ji,jj)*pTs(ji,jj) 
    538539            zQlw  = emiss_w*(prlw(ji,jj) - stefan*zTs2*zTs2) ! Net longwave flux 
     
    545546   END SUBROUTINE UPDATE_QNSOL_TAU 
    546547 
    547  
    548    SUBROUTINE BULK_FORMULA_VCTR( pzu, pTs, pqs, pTa, pqa, pCd, pCh, pCe, pwnd, pUb, pslp, & 
    549       &                                 pTau, pQsen, pQlat,  pEvap, prhoa ) 
     548    
     549   SUBROUTINE BULK_FORMULA_VCTR( pzu, pTs, pqs, pTa, pqa,  & 
     550      &                          pCd, pCh, pCe,            & 
     551      &                          pwnd, pUb, pslp,          & 
     552      &                          pTau, pQsen, pQlat,  pEvap, prhoa ) 
    550553      !!---------------------------------------------------------------------------------- 
    551554      REAL(wp),                     INTENT(in)  :: pzu  ! height above the sea-level where all this takes place (normally 10m) 
     
    598601   END SUBROUTINE BULK_FORMULA_VCTR 
    599602 
    600  
    601    SUBROUTINE BULK_FORMULA_SCLR( pzu, pTs, pqs, pTa, pqa, pCd, pCh, pCe, pwnd, pUb, pslp, & 
    602       &                                 pTau, pQsen, pQlat,  pEvap, prhoa ) 
     603    
     604   SUBROUTINE BULK_FORMULA_SCLR( pzu, pTs, pqs, pTa, pqa, & 
     605      &                          pCd, pCh, pCe,           & 
     606      &                          pwnd, pUb, pslp,         & 
     607      &                          pTau, pQsen, pQlat,  pEvap, prhoa ) 
    603608      !!---------------------------------------------------------------------------------- 
    604609      REAL(wp),                     INTENT(in)  :: pzu  ! height above the sea-level where all this takes place (normally 10m) 
  • NEMO/branches/2019/dev_r11085_ASINTER-05_Brodeau_Advanced_Bulk/src/OCE/SBC/sbcblk_skin_coare.F90

    r11826 r11962  
    6161      !!--------------------------------------------------------------------- 
    6262      !! 
    63       !! Cool-skin parameterization, based on Fairall et al., 1996, revisited for COARE 3.6 (Fairall et al., 2019) 
     63      !! Cool-skin parameterization, based on Fairall et al., 1996, 
     64      !! revisited for COARE 3.6 (Fairall et al., 2019) 
    6465      !! 
    6566      !! Fairall, C. W., Bradley, E. F., Godfrey, J. S., Wick, G. A., 
Note: See TracChangeset for help on using the changeset viewer.