Changeset 15551
- Timestamp:
- 2021-11-28T21:19:36+01:00 (2 years ago)
- Location:
- NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/OCE/SBC
- Files:
-
- 6 edited
-
sbc_phy.F90 (modified) (3 diffs)
-
sbcblk.F90 (modified) (14 diffs)
-
sbcblk_algo_coare3p0.F90 (modified) (2 diffs)
-
sbcblk_algo_coare3p6.F90 (modified) (1 diff)
-
sbcblk_algo_ecmwf.F90 (modified) (2 diffs)
-
sbccpl.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/OCE/SBC/sbc_phy.F90
r14592 r15551 257 257 zmask = 1._wp 258 258 ztpot = ptpot 259 zta = 0._wp 259 260 ELSE 260 261 zmask = 0._wp 262 ztpot = 0._wp 261 263 zta = pta 262 264 ENDIF … … 585 587 REAL(wp) :: ztptv 586 588 !!------------------------------------------------------------------- 587 IF( PRESENT(pta_layer) .AND. PRESENT(pqa_layer) ) l_ptqa_l_prvd =.TRUE.589 IF( PRESENT(pta_layer) .AND. PRESENT(pqa_layer) ) l_ptqa_l_prvd = .TRUE. 588 590 ! 589 591 zsstv = virt_temp_sclr( psst, pssq ) ! virtual potential SST … … 610 612 INTEGER :: ji, jj 611 613 612 IF( PRESENT(pta_layer) .AND. PRESENT(pqa_layer) ) l_ptqa_l_prvd =.TRUE.613 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )614 IF( l_ptqa_l_prvd ) THEN !!GS: "IF" inside loop needs to be removed614 IF( PRESENT(pta_layer) .AND. PRESENT(pqa_layer) ) l_ptqa_l_prvd = .TRUE. 615 IF( l_ptqa_l_prvd ) THEN 616 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 615 617 Ri_bulk_vctr(ji,jj) = Ri_bulk_sclr( pz, psst(ji,jj), ptha(ji,jj), pssq(ji,jj), pqa(ji,jj), pub(ji,jj), & 616 618 & pta_layer=pta_layer(ji,jj ), pqa_layer=pqa_layer(ji,jj ) ) 617 ELSE 619 END_2D 620 ELSE 621 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 618 622 Ri_bulk_vctr(ji,jj) = Ri_bulk_sclr( pz, psst(ji,jj), ptha(ji,jj), pssq(ji,jj), pqa(ji,jj), pub(ji,jj) ) 619 END IF620 END _2D623 END_2D 624 END IF 621 625 622 626 END FUNCTION Ri_bulk_vctr -
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/OCE/SBC/sbcblk.F90
r15548 r15551 275 275 IF( ln_ANDREAS ) & 276 276 & CALL ctl_stop( 'sbc_blk_init: Cool-skin/warm-layer param. not compatible with ANDREAS algorithm' ) 277 IF( nn_fsbc /= 1 ) &278 & CALL ctl_stop( 'sbc_blk_init: Please set "nn_fsbc" to 1 when using cool-skin/warm-layer param.')277 !IF( nn_fsbc /= 1 ) & 278 ! & CALL ctl_stop( 'sbc_blk_init: Please set "nn_fsbc" to 1 when using cool-skin/warm-layer param.') 279 279 END IF 280 280 … … 555 555 ! Potential temperature of air at z=rn_zqt (most reanalysis products provide absolute temp., not potential temp.) 556 556 IF( ln_tair_pot ) THEN 557 theta_air_zt(:,:) = sf(jp_tair )%fnow(:,:,1) 557 ! temperature read into file is already potential temperature, do nothing... 558 theta_air_zt(:,:) = sf(jp_tair )%fnow(:,:,1) 558 559 ELSE 559 560 ! temperature read into file is ABSOLUTE temperature (that's the case for ECMWF products for example...) … … 584 585 qsr_ice(:,:,1) = sf(jp_qsr)%fnow(:,:,1) 585 586 ENDIF 586 tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1) !#LB: should it be POTENTIAL temperature instead ???? 587 !tatm_ice(:,:) = theta_air_zt(:,:) !#LB: THIS! ? 587 tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1) !#LB: should it be POTENTIAL temperature (theta_air_zt) instead ???? 588 588 qatm_ice(:,:) = q_air_zt(:,:) 589 589 tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac … … 649 649 REAL(wp), DIMENSION(jpi,jpj) :: zce_oce ! latent heat transfert coefficient over ocean 650 650 REAL(wp), DIMENSION(jpi,jpj) :: zsspt ! potential sea-surface temperature [K] 651 REAL(wp), DIMENSION(jpi,jpj) :: zpre, ztabs 651 REAL(wp), DIMENSION(jpi,jpj) :: zpre, ztabs ! air pressure [Pa] & absolute temperature [K] 652 652 REAL(wp), DIMENSION(jpi,jpj) :: zztmp1, zztmp2 653 653 !!--------------------------------------------------------------------- … … 762 762 763 763 IF( ln_skin_cs .OR. ln_skin_wl ) THEN 764 !! In the presence of sea-ice we forget about the cool-skin/warm-layer update of ptsk and pssq:764 !! In the presence of sea-ice we forget about the cool-skin/warm-layer update of zsspt, pssq & ptsk: 765 765 WHERE ( fr_i(:,:) > 0.001_wp ) 766 766 ! sea-ice present, we forget about the update, using what we backed up before call to turb_*() … … 768 768 pssq(:,:) = zztmp2(:,:) 769 769 END WHERE 770 ! ! ptsk and pssq have been updated!!!770 ! apply potential temperature increment to abolute SST 771 771 ptsk(:,:) = ptsk(:,:) + ( zsspt(:,:) - zztmp1(:,:) ) 772 772 END IF … … 789 789 ELSE !== BLK formulation ==! turbulent fluxes computation 790 790 791 zpre(:,:) = pres_temp( q_zu(:,:), pslp(:,:), rn_zu, ptpot=theta_zu(:,:), pta=ztabs(:,:) ) 792 rhoa(:,:) = rho_air( ztabs(:,:), q_zu(:,:), zpre(:,:) ) 793 !!GS: for debug, to be removed 794 CALL iom_put( "pres_zu", zpre(:,:)*tmask(:,:,1) ) 795 CALL iom_put( "slp", pslp(:,:)*tmask(:,:,1) ) 796 CALL iom_put( "tabs_zu", (ztabs(:,:)-rt0)*tmask(:,:,1) ) 791 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 792 zpre(ji,jj) = pres_temp( q_zu(ji,jj), pslp(ji,jj), rn_zu, ptpot=theta_zu(ji,jj), pta=ztabs(ji,jj) ) 793 rhoa(ji,jj) = rho_air( ztabs(ji,jj), q_zu(ji,jj), zpre(ji,jj) ) 794 END_2D 797 795 798 796 CALL BULK_FORMULA( rn_zu, zsspt(:,:), pssq(:,:), theta_zu(:,:), q_zu(:,:), & … … 808 806 809 807 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 810 IF( wndm(ji,jj) > 0._wp ) THEN811 zztmp = taum(ji,jj) / wndm(ji,jj)808 IF( wndm(ji,jj) > 0._wp ) THEN 809 zztmp = taum(ji,jj) / wndm(ji,jj) 812 810 #if defined key_cyclone 813 ztau_i(ji,jj) = zztmp * zwnd_i(ji,jj)814 ztau_j(ji,jj) = zztmp * zwnd_j(ji,jj)811 ztau_i(ji,jj) = zztmp * zwnd_i(ji,jj) 812 ztau_j(ji,jj) = zztmp * zwnd_j(ji,jj) 815 813 #else 816 ztau_i(ji,jj) = zztmp * pwndi(ji,jj)817 ztau_j(ji,jj) = zztmp * pwndj(ji,jj)814 ztau_i(ji,jj) = zztmp * pwndi(ji,jj) 815 ztau_j(ji,jj) = zztmp * pwndj(ji,jj) 818 816 #endif 819 ELSE820 ztau_i(ji,jj) = 0._wp821 ztau_j(ji,jj) = 0._wp822 ENDIF817 ELSE 818 ztau_i(ji,jj) = 0._wp 819 ztau_j(ji,jj) = 0._wp 820 ENDIF 823 821 END_2D 824 822 … … 867 865 ptsk(:,:) = ( ptsk(:,:) - rt0 ) * tmask(:,:,1) ! Back to Celsius 868 866 869 CALL iom_put( "sspt", zsspt(:,:)-rt0 )870 867 IF( ln_skin_cs .OR. ln_skin_wl ) THEN 871 868 CALL iom_put( "t_skin" , ptsk ) ! T_skin in Celsius 872 CALL iom_put( "dt_skin" , ptsk - pst ) ! T_skin - SST temperature difference ...869 CALL iom_put( "dt_skin" , ptsk - pst ) ! T_skin - SST temperature difference 873 870 ENDIF 874 871 ! … … 984 981 !! ** Method : compute momentum using bulk formulation 985 982 !! formulea, ice variables and read atmospheric fields. 983 !! NB: ice drag coefficient is assumed to be a constant 986 984 !!--------------------------------------------------------------------- 987 985 REAL(wp) , INTENT(in ), DIMENSION(:,: ) :: pslp ! sea-level pressure [Pa] … … 1016 1014 ! potential sea-ice surface temperature [K] 1017 1015 zsipt(:,:) = theta_exner( ptsui(:,:), pslp(:,:) ) 1018 1016 1019 1017 ! sea-ice <-> atmosphere bulk transfer coefficients 1020 1018 SELECT CASE( nblk_ice ) … … 1046 1044 END SELECT 1047 1045 1048 ztmp(:,:) = ( 1._wp - MAX(0._wp, SIGN( 1._wp, 1.E-6_wp - fr_i )) )*tmask(:,:,1) ! mask for presence of ice ! 1049 IF( iom_use('spt_ice')) CALL iom_put("spt_ice", (zsipt-rt0)*ztmp) 1046 IF( iom_use('Cd_ice').OR.iom_use('Ce_ice').OR.iom_use('Ch_ice').OR.iom_use('taum_ice').OR.iom_use('utau_ice').OR.iom_use('vtau_ice') ) & 1047 & ztmp(:,:) = ( 1._wp - MAX(0._wp, SIGN( 1._wp, 1.E-6_wp - fr_i )) )*tmask(:,:,1) ! mask for presence of ice ! 1048 1050 1049 IF( iom_use('Cd_ice') ) CALL iom_put("Cd_ice", Cd_ice*ztmp) 1051 1050 IF( iom_use('Ce_ice') ) CALL iom_put("Ce_ice", Ce_ice*ztmp) … … 1131 1130 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z_dqsb ! sensible heat sensitivity over ice 1132 1131 REAL(wp), DIMENSION(jpi,jpj) :: zevap, zsnw ! evaporation and snw distribution after wind blowing (SI3) 1132 REAL(wp), DIMENSION(jpi,jpj) :: ztmp, ztmp2 1133 1133 REAL(wp), DIMENSION(jpi,jpj) :: ztri 1134 1134 REAL(wp), DIMENSION(jpi,jpj) :: zcptrain, zcptsnw, zcptn ! Heat content per unit mass (J/kg) … … 1136 1136 ! 1137 1137 zcoef_dqlw = 4._wp * emiss_i * stefan ! local scalars 1138 !1139 1138 zztmp = 1. / ( 1. - albo ) 1140 1139 dqla_ice(:,:,:) = 0._wp 1140 1141 1141 ! Heat content per unit mass (J/kg) 1142 1142 zcptrain(:,:) = ( ptair - rt0 ) * rcp * tmask(:,:,1) -
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/OCE/SBC/sbcblk_algo_coare3p0.F90
r14592 r15551 189 189 REAL(wp), DIMENSION(jpi,jpj) :: zeta_u ! stability parameter at height zu 190 190 REAL(wp), DIMENSION(jpi,jpj) :: ztmp0, ztmp1, ztmp2 191 REAL(wp), DIMENSION(jpi,jpj) :: zpre, zrhoa, zta 191 REAL(wp), DIMENSION(jpi,jpj) :: zpre, zrhoa, zta ! air pressure [Pa], density [kg/m3] & absolute temperature [k] 192 192 ! 193 193 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zeta_t ! stability parameter at height zt … … 323 323 324 324 IF(( l_use_cs ).OR.( l_use_wl )) THEN 325 zpre(:,:) = pres_temp( q_zu(:,:), slp(:,:), zu, ptpot=t_zu(:,:), pta=zta(:,:) )325 zpre(:,:) = pres_temp( q_zu(:,:), slp(:,:), zu, ptpot=t_zu(:,:), pta=zta(:,:) ) 326 326 zrhoa(:,:) = rho_air( zta(:,:), q_zu(:,:), zpre(:,:) ) 327 327 ENDIF -
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/OCE/SBC/sbcblk_algo_coare3p6.F90
r14592 r15551 179 179 REAL(wp), DIMENSION(jpi,jpj) :: zeta_u ! stability parameter at height zu 180 180 REAL(wp), DIMENSION(jpi,jpj) :: ztmp0, ztmp1, ztmp2 181 REAL(wp), DIMENSION(jpi,jpj) :: zpre, zrhoa, zta 181 REAL(wp), DIMENSION(jpi,jpj) :: zpre, zrhoa, zta ! air pressure [Pa], density [kg/m3] & absolute temperature [k] 182 182 ! 183 183 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zeta_t ! stability parameter at height zt -
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/OCE/SBC/sbcblk_algo_ecmwf.F90
r15548 r15551 184 184 REAL(wp), DIMENSION(jpi,jpj) :: Linv !: 1/L (inverse of Monin Obukhov length... 185 185 REAL(wp), DIMENSION(jpi,jpj) :: z0, z0t, z0q 186 REAL(wp), DIMENSION(jpi,jpj) :: zrhoa, zpre, zta 186 REAL(wp), DIMENSION(jpi,jpj) :: zrhoa, zpre, zta ! air pressure [Pa], density [kg/m3] & absolute temperature [k] 187 187 ! 188 188 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zsst ! to back up the initial bulk SST … … 356 356 !! Cool-skin contribution 357 357 358 359 358 CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, Ubzu, slp, rad_lw, zrhoa, & 360 359 & ztmp1, ztmp0, Qlat=ztmp2) ! Qnsol -> ztmp1 / Tau -> ztmp0 -
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/OCE/SBC/sbccpl.F90
r15548 r15551 54 54 #endif 55 55 56 USE sbc_phy, ONLY : pp_cldf 56 USE sbc_phy, ONLY : pp_cldf, rpref 57 57 58 58 IMPLICIT NONE … … 220 220 #endif 221 221 222 REAL(wp) :: rpref = 101000._wp ! reference atmospheric pressure[N/m2]223 REAL(wp) :: r1_grau ! = 1.e0 / (grav * rho0)224 225 222 INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) :: nrcvinfo ! OASIS info argument 226 223 … … 1189 1186 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 1190 1187 REAL(wp) :: zzx, zzy ! temporary variables 1188 REAL(wp) :: r1_grau ! = 1.e0 / (grav * rho0) 1191 1189 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty, zmsk, zemp, zqns, zqsr, zcloud_fra 1192 1190 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
