Changeset 11772 for NEMO/branches/2019/dev_r11085_ASINTER-05_Brodeau_Advanced_Bulk/src/OCE/SBC/sbcblk_algo_ecmwf.F90
- Timestamp:
- 2019-10-23T16:04:12+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11085_ASINTER-05_Brodeau_Advanced_Bulk/src/OCE/SBC/sbcblk_algo_ecmwf.F90
r11631 r11772 44 44 PRIVATE 45 45 46 PUBLIC :: TURB_ECMWF ! called by sbcblk.F9046 PUBLIC :: ECMWF_INIT, TURB_ECMWF 47 47 48 48 ! !! ECMWF own values for given constants, taken form IFS documentation... … … 55 55 REAL(wp), PARAMETER :: alpha_Q = 0.62 ! 56 56 57 INTEGER , PARAMETER :: nb_itt = 5! number of itterations57 INTEGER , PARAMETER :: nb_itt = 10 ! number of itterations 58 58 59 59 !!---------------------------------------------------------------------- 60 60 CONTAINS 61 61 62 SUBROUTINE turb_ecmwf( zt, zu, T_s, t_zt, q_s, q_zt, U_zu, l_use_cs, l_use_wl, & 63 & Cd, Ch, Ce, t_zu, q_zu, U_blk, & 64 & Cdn, Chn, Cen, & 65 & Qsw, rad_lw, slp, pdT_cs, & ! optionals for cool-skin (and warm-layer) 66 & pdT_wl ) ! optionals for warm-layer only 62 63 SUBROUTINE ecmwf_init(l_use_cs, l_use_wl) 64 !!--------------------------------------------------------------------- 65 !! *** FUNCTION ecmwf_init *** 66 !! 67 !! INPUT : 68 !! ------- 69 !! * l_use_cs : use the cool-skin parameterization 70 !! * l_use_wl : use the warm-layer parameterization 71 !!--------------------------------------------------------------------- 72 LOGICAL , INTENT(in) :: l_use_cs ! use the cool-skin parameterization 73 LOGICAL , INTENT(in) :: l_use_wl ! use the warm-layer parameterization 74 INTEGER :: ierr 75 !!--------------------------------------------------------------------- 76 IF ( l_use_wl ) THEN 77 ierr = 0 78 ALLOCATE ( dT_wl(jpi,jpj), Hz_wl(jpi,jpj), STAT=ierr ) 79 !IF( ierr > 0 ) STOP ' ECMWF_INIT => allocation of dT_wl & Hz_wl failed!' 80 dT_wl(:,:) = 0._wp 81 Hz_wl(:,:) = rd0 ! (rd0, constant, = 3m is default for Zeng & Beljaars) 82 END IF 83 !! 84 IF ( l_use_cs ) THEN 85 ierr = 0 86 ALLOCATE ( dT_cs(jpi,jpj), STAT=ierr ) 87 !IF( ierr > 0 ) STOP ' ECMWF_INIT => allocation of dT_cs failed!' 88 dT_cs(:,:) = -0.25_wp ! First guess of skin correction 89 END IF 90 END SUBROUTINE ecmwf_init 91 92 93 94 SUBROUTINE turb_ecmwf( kt, zt, zu, T_s, t_zt, q_s, q_zt, U_zu, l_use_cs, l_use_wl, & 95 & Cd, Ch, Ce, t_zu, q_zu, U_blk, & 96 & Cdn, Chn, Cen, & 97 & Qsw, rad_lw, slp, pdT_cs, & ! optionals for cool-skin (and warm-layer) 98 & pdT_wl, pHz_wl ) ! optionals for warm-layer only 67 99 !!---------------------------------------------------------------------- 68 100 !! *** ROUTINE turb_ecmwf *** … … 80 112 !! INPUT : 81 113 !! ------- 114 !! * kt : current time step (starts at 1) 82 115 !! * zt : height for temperature and spec. hum. of air [m] 83 116 !! * zu : height for wind speed (usually 10m) [m] … … 95 128 !! 96 129 !! * q_s : SSQ aka saturation specific humidity at temp. T_s [kg/kg] 97 !! -> doesn't need to be given a value if skin temp computed (in case l_use_ skin=True)98 !! -> MUST be given the correct value if not computing skint temp. (in case l_use_ skin=False)130 !! -> doesn't need to be given a value if skin temp computed (in case l_use_cs=True or l_use_wl=True) 131 !! -> MUST be given the correct value if not computing skint temp. (in case l_use_cs=False or l_use_wl=False) 99 132 !! 100 133 !! OPTIONAL INPUT: … … 103 136 !! * rad_lw : downwelling longwave radiation at the surface (>0) [W/m^2] 104 137 !! * slp : sea-level pressure [Pa] 138 !! 139 !! OPTIONAL OUTPUT: 140 !! ---------------- 105 141 !! * pdT_cs : SST increment "dT" for cool-skin correction [K] 106 142 !! * pdT_wl : SST increment "dT" for warm-layer correction [K] 143 !! * pHz_wl : thickness of warm-layer [m] 107 144 !! 108 145 !! OUTPUT : … … 118 155 !! ** Author: L. Brodeau, June 2019 / AeroBulk (https://github.com/brodeau/aerobulk/) 119 156 !!---------------------------------------------------------------------------------- 157 INTEGER, INTENT(in ) :: kt ! current time step 120 158 REAL(wp), INTENT(in ) :: zt ! height for t_zt and q_zt [m] 121 159 REAL(wp), INTENT(in ) :: zu ! height for U_zu [m] … … 139 177 REAL(wp), INTENT(in ), OPTIONAL, DIMENSION(jpi,jpj) :: slp ! [Pa] 140 178 REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: pdT_cs 141 !142 179 REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: pdT_wl ! [K] 180 REAL(wp), INTENT( out), OPTIONAL, DIMENSION(jpi,jpj) :: pHz_wl ! [m] 143 181 ! 144 182 INTEGER :: j_itt … … 162 200 !!---------------------------------------------------------------------------------- 163 201 202 IF ( kt == nit000 ) CALL ECMWF_INIT(l_use_cs, l_use_wl) 203 164 204 l_zt_equal_zu = .FALSE. 165 205 IF( ABS(zu - zt) < 0.01_wp ) l_zt_equal_zu = .TRUE. ! testing "zu == zt" is risky with double precision … … 168 208 IF ( l_use_cs ) THEN 169 209 IF( .NOT.(PRESENT(Qsw) .AND. PRESENT(rad_lw) .AND. PRESENT(slp)) ) THEN 170 PRINT *, ' * PROBLEM ('//trim(crtnm)//'): you need to provide Qsw, rad_lw & slp to use cool-skin param!' 171 STOP 172 END IF 173 ALLOCATE ( pdTc(jpi,jpj) ) 174 pdTc(:,:) = -0.25_wp ! First guess of skin correction 210 PRINT *, ' * PROBLEM ('//TRIM(crtnm)//'): you need to provide Qsw, rad_lw & slp to use cool-skin param!'; STOP 211 END IF 175 212 END IF 176 213 177 214 IF ( l_use_wl ) THEN 178 IF(.NOT.(PRESENT(Qsw) .AND. PRESENT(rad_lw) .AND. PRESENT(slp))) THEN 179 PRINT *, ' * PROBLEM ('//trim(crtnm)//'): you need to provide Qsw, rad_lw & slp to use warm-layer param!' 180 STOP 181 END IF 182 ALLOCATE ( pdTw(jpi,jpj) ) 183 pdTw(:,:) = 0._wp 215 IF( .NOT.(PRESENT(Qsw) .AND. PRESENT(rad_lw) .AND. PRESENT(slp))) THEN 216 PRINT *, ' * PROBLEM ('//TRIM(crtnm)//'): you need to provide Qsw, rad_lw & slp to use warm-layer param!'; STOP 217 END IF 184 218 END IF 185 219 … … 322 356 !! Cool-skin contribution 323 357 324 CALL UPDATE_QNSOL_TAU( T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_blk, slp, rad_lw, &358 CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, U_blk, slp, rad_lw, & 325 359 & ztmp1, ztmp0, Qlat=ztmp2) ! Qnsol -> ztmp1 / Tau -> ztmp0 326 360 327 CALL CS_ECMWF( Qsw, ztmp1, u_star, zsst , pdTc) ! Qnsol -> ztmp1328 329 T_s(:,:) = zsst(:,:) + pdTc(:,:)330 IF( l_use_wl ) T_s(:,:) = T_s(:,:) + pdTw(:,:)361 CALL CS_ECMWF( Qsw, ztmp1, u_star, zsst ) ! Qnsol -> ztmp1 362 363 T_s(:,:) = zsst(:,:) + dT_cs(:,:)*tmask(:,:,1) 364 IF( l_use_wl ) T_s(:,:) = T_s(:,:) + dT_wl(:,:)*tmask(:,:,1) 331 365 q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:)) 332 366 … … 335 369 IF( l_use_wl ) THEN 336 370 !! Warm-layer contribution 337 CALL UPDATE_QNSOL_TAU( T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_blk, slp, rad_lw, &371 CALL UPDATE_QNSOL_TAU( zu, T_s, q_s, t_zu, q_zu, u_star, t_star, q_star, U_zu, U_blk, slp, rad_lw, & 338 372 & ztmp1, ztmp2) ! Qnsol -> ztmp1 / Tau -> ztmp2 339 CALL WL_ECMWF( Qsw, ztmp1, u_star, zsst , pdTw)373 CALL WL_ECMWF( Qsw, ztmp1, u_star, zsst ) 340 374 !! Updating T_s and q_s !!! 341 T_s(:,:) = zsst(:,:) + pdTw(:,:)342 IF( l_use_cs ) T_s(:,:) = T_s(:,:) + pdTc(:,:)375 T_s(:,:) = zsst(:,:) + dT_wl(:,:)*tmask(:,:,1) 376 IF( l_use_cs ) T_s(:,:) = T_s(:,:) + dT_cs(:,:)*tmask(:,:,1) 343 377 q_s(:,:) = rdct_qsat_salt*q_sat(MAX(T_s(:,:), 200._wp), slp(:,:)) 344 378 END IF 345 346 379 347 380 IF( l_use_cs .OR. l_use_wl .OR. (.NOT. l_zt_equal_zu) ) THEN … … 361 394 Cen = vkarmn*vkarmn / (log(zu/z0q)*log(zu/z0q)) 362 395 363 IF ( l_use_cs .AND. PRESENT(pdT_cs) ) pdT_cs = pdTc 364 IF ( l_use_wl .AND. PRESENT(pdT_wl) ) pdT_wl = pdTw 396 IF ( l_use_cs .AND. PRESENT(pdT_cs) ) pdT_cs = dT_cs 397 IF ( l_use_wl .AND. PRESENT(pdT_wl) ) pdT_wl = dT_wl 398 IF ( l_use_wl .AND. PRESENT(pHz_wl) ) pHz_wl = Hz_wl 365 399 366 400 IF ( l_use_cs .OR. l_use_wl ) DEALLOCATE ( zsst ) 367 IF ( l_use_cs ) DEALLOCATE ( pdTc )368 IF ( l_use_wl ) DEALLOCATE ( pdTw )369 401 370 402 END SUBROUTINE turb_ecmwf
Note: See TracChangeset
for help on using the changeset viewer.