- Timestamp:
- 2012-05-22T09:37:43+02:00 (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_r3379_CMCC6_topbfm/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r3294 r3398 49 49 PUBLIC turb_core_2z ! routine calles in sbcblk_mfs module 50 50 51 INTEGER , PARAMETER :: jpfld = 9 ! maximum number of files to read52 51 INTEGER , PARAMETER :: jp_wndi = 1 ! index of 10m wind velocity (i-component) (m/s) at T-point 53 52 INTEGER , PARAMETER :: jp_wndj = 2 ! index of 10m wind velocity (j-component) (m/s) at T-point … … 59 58 INTEGER , PARAMETER :: jp_snow = 8 ! index of snow (solid prcipitation) (kg/m2/s) 60 59 INTEGER , PARAMETER :: jp_tdif = 9 ! index of tau diff associated to HF tau (N/m2) at T-point 60 #if defined key_orca_r025 61 INTEGER , PARAMETER :: jp_swc = 10 ! index of GEWEX correction for SW radiation at T-point 62 INTEGER , PARAMETER :: jp_lwc = 11 ! index of GEWEX correction for LW radiation at T-point 63 INTEGER , PARAMETER :: jp_prc = 12 ! index of PMWC correction forat T-point 64 INTEGER , PARAMETER :: jpfld = 12 ! maximum number of files to read 65 #else 66 INTEGER , PARAMETER :: jpfld = 9 ! maximum number of files to read 67 #endif 61 68 62 69 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf ! structure of input fields (file informations, fields read) … … 75 82 LOGICAL :: ln_taudif = .FALSE. ! logical flag to use the "mean of stress module - module of mean stress" data 76 83 REAL(wp) :: rn_pfac = 1. ! multiplication factor for precipitation 84 #if defined key_orca_r025 85 LOGICAL :: ln_printdia= .TRUE. ! logical flag for height of air temp. and hum 86 LOGICAL :: ln_netsw = .TRUE. ! logical flag for height of air temp. and hum 87 LOGICAL :: ln_core_graceopt=.FALSE., ln_core_spinup=.FALSE. 88 LOGICAL :: ln_gwxc = .TRUE. 89 LOGICAL :: ln_corad_antar =.FALSE., ln_corad_arc =.FALSE. , ln_cotair_arc = .FALSE. 90 LOGICAL :: ln_coprecip =.FALSE. 91 REAL(wp) :: rn_qns_bias = 0._wp ! heat flux bias 92 93 #endif 77 94 78 95 !! * Substitutions … … 117 134 !! - emp, emps evaporation minus precipitation 118 135 !!---------------------------------------------------------------------- 136 #if defined key_orca_r025 && key_lim2 137 USE ice_2 138 #endif 119 139 INTEGER, INTENT(in) :: kt ! ocean time step 120 140 !! … … 122 142 INTEGER :: ifpr ! dummy loop indice 123 143 INTEGER :: jfld ! dummy loop arguments 144 INTEGER :: ji, jj 124 145 !! 125 146 CHARACTER(len=100) :: cn_dir ! Root directory for location of core files … … 128 149 TYPE(FLD_N) :: sn_qlw , sn_tair, sn_prec, sn_snow ! " " 129 150 TYPE(FLD_N) :: sn_tdif ! " " 151 #if defined key_orca_r025 152 TYPE(FLD_N) :: sn_swc, sn_lwc ! " " 153 TYPE(FLD_N) :: sn_prc 154 INTEGER :: iter_shapiro = 250 155 REAL :: zzlat, zzlat1, zzlat2, zfrld, ztmp 156 REAL(wp), DIMENSION(jpi,jpj):: xyt,z_qsr,z_qlw,z_qsr1,z_qlw1,z_tair 157 REAL(wp), DIMENSION(jpi,jpj):: zqsr_lr, zqsr_hr, zqlw_lr, zqlw_hr, zprec_hr, zprec_lr 158 CHARACTER(len=20) :: c_kind='ORCA_GLOB' 159 NAMELIST/namsbc_core/ cn_dir , ln_2m , ln_taudif, rn_pfac, & 160 & sn_wndi, sn_wndj, sn_humi , sn_qsr , & 161 & sn_qlw , sn_tair, sn_prec , sn_snow, sn_tdif, & 162 & sn_swc , sn_lwc , sn_prc , ln_gwxc, & 163 & ln_corad_antar, ln_corad_arc, ln_cotair_arc, ln_coprecip , & 164 & rn_qns_bias, ln_printdia, ln_netsw, ln_core_graceopt,ln_core_spinup 165 !!--------------------------------------------------------------------- 166 #else 130 167 NAMELIST/namsbc_core/ cn_dir , ln_2m , ln_taudif, rn_pfac, & 131 168 & sn_wndi, sn_wndj, sn_humi , sn_qsr , & 132 169 & sn_qlw , sn_tair, sn_prec , sn_snow, sn_tdif 133 170 !!--------------------------------------------------------------------- 171 #endif 134 172 135 173 ! ! ====================== ! … … 151 189 sn_snow = FLD_N( 'snow' , -1 , 'snow' , .true. , .false. , 'yearly' , '' , '' ) 152 190 sn_tdif = FLD_N( 'taudif' , 24 , 'taudif' , .true. , .false. , 'yearly' , '' , '' ) 191 #if defined key_orca_r025 192 sn_swc = FLD_N( 'swc' , 24 , 'swc' , .true. , .false. , 'yearly' , '' , '' ) 193 sn_lwc = FLD_N( 'lwc' , 24 , 'lwc' , .true. , .false. , 'yearly' , '' , '' ) 194 sn_prc = FLD_N( 'prc' , 24 , 'prc' , .true. , .false. , 'yearly' , '' , '' ) 195 #endif 153 196 ! 154 197 REWIND( numnam ) ! read in namlist namsbc_core … … 171 214 lhftau = ln_taudif ! do we use HF tau information? 172 215 jfld = jpfld - COUNT( (/.NOT. lhftau/) ) 216 #if defined key_orca_r025 217 slf_i(jp_swc ) = sn_swc 218 slf_i(jp_lwc ) = sn_lwc 219 slf_i(jp_prc ) = sn_prc 220 IF( .NOT. ln_gwxc ) jfld = jfld - 2 221 IF( .NOT. ln_coprecip ) jfld = jfld - 1 222 #endif 173 223 ! 174 224 ALLOCATE( sf(jfld), STAT=ierror ) ! set sf structure … … 185 235 CALL fld_read( kt, nn_fsbc, sf ) ! input fields provided at the current time-step 186 236 187 ! ! surface ocean fluxes computed with CLIO bulk formulea 188 IF( MOD( kt - 1, nn_fsbc ) == 0 ) CALL blk_oce_core( sf, sst_m, ssu_m, ssv_m ) 237 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 238 239 #if defined key_orca_r025 240 ! Introduce ERA-Interim filtering and correction 241 242 IF( ln_gwxc ) THEN 243 244 call Shapiro_1D(sf(jp_qsr)%fnow(:,:,1),iter_shapiro, c_kind, zqsr_lr) 245 zqsr_hr(:,:)=sf(jp_qsr)%fnow(:,:,1)-zqsr_lr(:,:) ! We get large scale and small scale 246 247 call Shapiro_1D(sf(jp_qlw)%fnow(:,:,1),iter_shapiro, c_kind, zqlw_lr) 248 zqlw_hr(:,:)=sf(jp_qlw)%fnow(:,:,1)-zqlw_lr(:,:) ! We get large scale and small scale 249 250 z_qsr1(:,:)=zqsr_lr(:,:)*sf(jp_swc)%fnow(:,:,1) + zqsr_hr(:,:) 251 z_qlw1(:,:)=zqlw_lr(:,:)*sf(jp_lwc)%fnow(:,:,1) + zqlw_hr(:,:) 252 253 DO jj=1,jpj 254 DO ji=1,jpi 255 z_qsr1(ji,jj)=max(z_qsr1(ji,jj),0.0) 256 z_qlw1(ji,jj)=max(z_qlw1(ji,jj),0.0) 257 END DO 258 END DO 259 260 ENDIF 261 262 IF( ln_coprecip ) THEN 263 264 call Shapiro_1D(sf(jp_prec)%fnow(:,:,1),iter_shapiro,c_kind,zprec_lr) 265 zprec_hr(:,:)=sf(jp_prec)%fnow(:,:,1)-zprec_lr(:,:) ! We get large scale and small scale 266 267 DO jj=1,jpj 268 DO ji=1,jpi 269 IF( zprec_lr(ji,jj) .GT. 0._wp ) THEN 270 ztmp = LOG( ( 1000._wp + sf(jp_prc)%fnow(ji,jj,1) ) * EXP( zprec_lr(ji,jj) ) / 1000._wp ) 271 sf(jp_prec)%fnow(ji,jj,1) = max(ztmp+zprec_hr(ji,jj),0.0) 272 ENDIF 273 END DO 274 END DO 275 276 ENDIF 277 278 IF ( ln_corad_antar ) THEN ! correction of SW and LW in the Southern Ocean 279 280 z_qsr(:,:)=0.8*z_qsr1(:,:) 281 z_qlw(:,:)=1.1*z_qlw1(:,:) 282 xyt(:,:) = 0.e0 283 zzlat1 = -65. 284 zzlat2 = -60. 285 DO jj = 1, jpj 286 DO ji = 1, jpi 287 zzlat = gphit(ji,jj) 288 IF ( zzlat >= zzlat1 .AND. zzlat <= zzlat2 ) THEN 289 xyt(ji,jj) = (zzlat2-zzlat)/(zzlat2-zzlat1) 290 ELSE IF ( zzlat < zzlat1 ) THEN 291 xyt(ji,jj) = 1 292 ENDIF 293 END DO 294 END DO 295 z_qsr1(:,:)=z_qsr(:,:)*xyt(:,:)+(1.0-xyt(:,:))*z_qsr1(:,:) 296 z_qlw1(:,:)=z_qlw(:,:)*xyt(:,:)+(1.0-xyt(:,:))*z_qlw1(:,:) 297 298 ENDIF 299 300 IF ( ln_corad_arc ) THEN ! correction of SW in the Arctic Ocean 301 302 z_qsr(:,:)=0.7*z_qsr1(:,:) 303 xyt(:,:) = 0.e0 304 zzlat1 = 78. 305 zzlat2 = 82. 306 DO jj = 1, jpj 307 DO ji = 1, jpi 308 zzlat = gphit(ji,jj) 309 IF ( zzlat >= zzlat1 .AND. zzlat <= zzlat2 ) THEN 310 xyt(ji,jj) = (zzlat-zzlat1)/(zzlat2-zzlat1) 311 ELSE IF ( zzlat > zzlat2 ) THEN 312 xyt(ji,jj) = 1 313 ENDIF 314 END DO 315 END DO 316 z_qsr1(:,:)=z_qsr(:,:)*xyt(:,:)+(1.0-xyt(:,:))*z_qsr1(:,:) 317 318 ENDIF 319 320 sf(jp_qsr)%fnow(:,:,1)=z_qsr1(:,:) 321 sf(jp_qlw)%fnow(:,:,1)=z_qlw1(:,:) 322 323 #if defined key_lim2 324 IF ( ln_cotair_arc ) THEN ! correction of Air Temperature in the Arctic Ocean 325 326 z_tair(:,:)=sf(jp_tair)%fnow(:,:,1) - 2.0 327 xyt(:,:) = 0.e0 ; zzlat1 = 78. ; zzlat2 = 82. 328 DO jj = 1, jpj 329 DO ji = 1, jpi 330 zzlat = gphit(ji,jj) ; zfrld=frld(ji,jj) 331 IF ( zzlat >= zzlat1 .AND. zzlat <= zzlat2 .AND. zfrld < 0.85 ) THEN 332 xyt(ji,jj) = (zzlat-zzlat1)/(zzlat2-zzlat1) 333 ELSE IF ( zzlat > zzlat2 .AND. zfrld < 0.85 ) THEN 334 xyt(ji,jj) = 1 335 ENDIF 336 END DO 337 END DO 338 sf(jp_tair)%fnow(:,:,1)=z_tair(:,:)*xyt(:,:)+(1.0-xyt(:,:))*sf(jp_tair)%fnow(:,:,1) 339 340 ENDIF 341 #endif 342 343 #endif 344 CALL blk_oce_core( sf, sst_m, ssu_m, ssv_m ) ! surface ocean fluxes computed with CLIO bulk formule 345 346 ENDIF 189 347 190 348 #if defined key_cice … … 332 490 IF( lhftau ) THEN 333 491 !CDIR COLLAPSE 492 #if defined key_orca_r025 493 ! Changed!!! Multiply by QSCAT correction 494 zwnd_i(:,:) = zwnd_i(:,:) * sf(jp_tdif)%fnow(:,:,1) 495 zwnd_j(:,:) = zwnd_j(:,:) * sf(jp_tdif)%fnow(:,:,1) 496 #endif 334 497 taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:,1) 335 498 ENDIF … … 946 1109 ! 947 1110 END FUNCTION psi_h 948 1111 1112 SUBROUTINE Shapiro_1D(rla_varin,id_np, cd_overlap, rlpa_varout) !GIG 1113 !!===================================================================== 1114 !! 1115 !! Description: This function applies a 1D Shapiro filter 1116 !! (3 points filter) horizontally to a 2D field 1117 !! in regular grid 1118 !! Arguments : 1119 !! rla_varin : Input variable to filter 1120 !! zla_mask : Input mask variable 1121 !! id_np : Number of Shapiro filter iterations 1122 !! cd_overlap : Logical argument for periodical condition 1123 !! (global ocean case) 1124 !! rlpa_varout : Output filtered variable 1125 !! 1126 !! History : 08/2009 S. CAILLEAU : from 1st version of N. FERRY 1127 !! 09/2009 C. REGNIER : Corrections 1128 !! 1129 !!===================================================================== 1130 IMPLICIT NONE 1131 INTEGER, INTENT(IN) :: id_np 1132 REAL(wp), DIMENSION(jpi,jpj), INTENT(IN) :: rla_varin !GIG 1133 CHARACTER(len=20), INTENT(IN) :: cd_overlap !GIG 1134 REAL(wp), DIMENSION(jpi,jpj), INTENT(OUT) :: rlpa_varout !GIG 1135 1136 REAL(wp), DIMENSION(jpi,jpj) :: rlpa_varout_tmp 1137 REAL, PARAMETER :: rl_alpha = 1./2. ! fixed stability coefficient (isotrope case) 1138 REAL, parameter :: rap_aniso_diff_XY=2.25 ! anisotrope case 1139 REAL :: alphax,alphay, znum, zden,test 1140 INTEGER :: ji, jj, jn, nn 1141 ! 1142 !! rap_aniso_diff_XY=2.25 : valeur trouvée empiriquement pour 140 itération po% ur le filtre de Shapiro et 1143 !! pour un rapport d'anisotopie de 1.5 : on filtre de plus rapidement en x qu'eny. 1144 !------------------------------------------------------------------------------ 1145 ! 1146 ! Loop on several filter iterations 1147 1148 ! Global ocean case 1149 IF (( cd_overlap == 'MERCA_GLOB' ) .OR. & 1150 ( cd_overlap == 'REGULAR_GLOB' ) .OR. & 1151 ( cd_overlap == 'ORCA_GLOB' )) THEN 1152 rlpa_varout(:,:) = rla_varin(:,:) 1153 rlpa_varout_tmp(:,:) = rlpa_varout(:,:) 1154 ! 1155 1156 alphax=1./2. 1157 alphay=1./2. 1158 ! Dx/Dy=rap_aniso_diff_XY , D_ = vitesse de diffusion 1159 ! 140 passes du fitre, Lx/Ly=1.5, le rap_aniso_diff_XY correspondant est: 1160 IF ( rap_aniso_diff_XY .GE. 1. ) alphay=alphay/rap_aniso_diff_XY 1161 IF ( rap_aniso_diff_XY .LT. 1. ) alphax=alphax*rap_aniso_diff_XY 1162 1163 DO jn = 1,id_np ! number of passes of the filter 1164 DO ji = 2,jpim1 1165 DO jj = 2,jpjm1 1166 ! We crop on the coast 1167 znum = rlpa_varout_tmp(ji,jj) & 1168 + 0.25*alphax*(rlpa_varout_tmp(ji-1,jj )-rlpa_varout_tmp(ji,jj))*tmask(ji-1,jj ,1) & 1169 + 0.25*alphax*(rlpa_varout_tmp(ji+1,jj )-rlpa_varout_tmp(ji,jj))*tmask(ji+1,jj ,1) & 1170 + 0.25*alphay*(rlpa_varout_tmp(ji ,jj-1)-rlpa_varout_tmp(ji,jj))*tmask(ji ,jj-1,1) & 1171 + 0.25*alphay*(rlpa_varout_tmp(ji ,jj+1)-rlpa_varout_tmp(ji,jj))*tmask(ji ,jj+1,1) 1172 rlpa_varout(ji,jj)=znum*tmask(ji,jj,1)+rla_varin(ji,jj)*(1.-tmask(ji,jj,1)) 1173 ENDDO ! end loop ji 1174 ENDDO ! end loop jj 1175 ! 1176 ! 1177 ! Periodical condition in case of cd_overlap (global ocean) 1178 ! - on a mercator projection grid we consider that singular point at poles 1179 ! are a mean of the values at points of the previous latitude 1180 ! - on ORCA and regular grid we copy the values at points of the previous latitude 1181 IF ( cd_overlap == 'MERCAT_GLOB' ) THEN 1182 !GIG case unchecked 1183 rlpa_varout(1,1) = SUM(rlpa_varout(:,2)) / jpi 1184 rlpa_varout(jpi,jpj) = SUM(rlpa_varout(:,jpj-1)) / jpi 1185 ELSE 1186 call lbc_lnk(rlpa_varout, 'T', 1.) ! Boundary condition 1187 ENDIF 1188 rlpa_varout_tmp(:,:) = rlpa_varout(:,:) 1189 ENDDO ! end loop jn 1190 ENDIF 1191 1192 ! 1193 END SUBROUTINE Shapiro_1D 1194 949 1195 !!====================================================================== 950 1196 END MODULE sbcblk_core
Note: See TracChangeset
for help on using the changeset viewer.
