- Timestamp:
- 2019-07-18T15:25:07+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/ENHANCE-03_closea/src/OCE/DOM/closea.F90
r11207 r11295 33 33 34 34 IMPLICIT NONE 35 PRIVATE 35 PRIVATE read_csmask 36 PRIVATE alloc_csmask 36 37 37 38 PUBLIC dom_clo ! called by domain module 38 PUBLIC sbc_clo_init ! called by sbcmod module39 PUBLIC sbc_clo ! called by sbcmod module40 39 PUBLIC clo_rnf ! called by sbcrnf module 41 40 PUBLIC clo_bat ! called in domzgr module 42 41 43 LOGICAL, PUBLIC :: ln_maskcs !:mask all closed sea44 LOGICAL, PUBLIC :: ln_mask_csundef !: mask allclosed sea45 LOGICAL, PUBLIC :: ln_clo_rnf !: closed sea treated as runoff (update rnf mask)42 LOGICAL, PUBLIC :: ln_maskcs !: logical to mask all closed sea 43 LOGICAL, PUBLIC :: ln_mask_csundef !: logical to mask all undefined closed sea 44 LOGICAL, PUBLIC :: ln_clo_rnf !: closed sea treated as runoff (update rnf mask) 46 45 47 46 LOGICAL, PUBLIC :: l_sbc_clo !: T => net evap/precip over closed seas spread outover the globe/river mouth 48 47 LOGICAL, PUBLIC :: l_clo_rnf !: T => Some closed seas output freshwater (RNF) to specified runoff points. 49 48 50 INTEGER, PUBLIC :: jncsg !: number of closed seas global mappings (inferred from closea_mask_glo field) 51 INTEGER, PUBLIC :: jncsr !: number of closed seas rnf mappings (inferred from closea_mask_rnf field) 52 INTEGER, PUBLIC :: jncse !: number of closed seas empmr mappings (inferred from closea_mask_emp field) 53 54 INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: jcsgrpg, jcsgrpr, jcsgrpe 55 56 INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: mask_opnsea, mask_csundef 49 INTEGER, PUBLIC :: ncsg !: number of closed seas global mappings (inferred from closea_mask_glo field) 50 INTEGER, PUBLIC :: ncsr !: number of closed seas rnf mappings (inferred from closea_mask_rnf field) 51 INTEGER, PUBLIC :: ncse !: number of closed seas empmr mappings (inferred from closea_mask_emp field) 52 53 INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: mask_opnsea, mask_csundef !: mask defining the open sea and the undefined closed sea 57 54 58 INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: mask_csglo, mask_csgrpglo !: mask of integers defining closed seas 59 INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: mask_csrnf, mask_csgrprnf !: mask of integers defining closed seas rnf mappings 60 INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: mask_csemp, mask_csgrpemp !: mask of integers defining closed seas empmr mappings 61 62 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: rsurfsrcg, rsurftrgg !: closed sea target glo surface areas 63 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: rsurfsrcr, rsurftrgr !: closed sea target rnf surface areas 64 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: rsurfsrce, rsurftrge !: closed sea target emp surface areas 55 INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: mask_csglo, mask_csgrpglo !: mask of integers defining closed seas 56 INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: mask_csrnf, mask_csgrprnf !: mask of integers defining closed seas rnf mappings 57 INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: mask_csemp, mask_csgrpemp !: mask of integers defining closed seas empmr mappings 65 58 66 59 !! * Substitutions … … 154 147 ! 155 148 ! compute number of cs for each cases 156 jncsg = MAXVAL( mask_csglo(:,:) ) ; CALL mpp_max( 'closea', jncsg )157 jncsr = MAXVAL( mask_csrnf(:,:) ) ; CALL mpp_max( 'closea', jncsr )158 jncse = MAXVAL( mask_csemp(:,:) ) ; CALL mpp_max( 'closea', jncse )149 ncsg = MAXVAL( mask_csglo(:,:) ) ; CALL mpp_max( 'closea', ncsg ) 150 ncsr = MAXVAL( mask_csrnf(:,:) ) ; CALL mpp_max( 'closea', ncsr ) 151 ncse = MAXVAL( mask_csemp(:,:) ) ; CALL mpp_max( 'closea', ncse ) 159 152 ! 160 153 ! allocate closed sea group masks … … 168 161 CALL read_csmask( cn_domcfg, 'mask_csgrpemp', mask_csgrpemp ) 169 162 ! 170 ! Allocate cs variables (surf)171 CALL alloc_cssurf( jncsg, rsurfsrcg, rsurftrgg )172 CALL alloc_cssurf( jncsr, rsurfsrcr, rsurftrgr )173 CALL alloc_cssurf( jncse, rsurfsrce, rsurftrge )174 !175 ! Allocate cs group variables (jcsgrp)176 CALL alloc_csgrp( jncsg, jcsgrpg )177 CALL alloc_csgrp( jncsr, jcsgrpr )178 CALL alloc_csgrp( jncse, jcsgrpe )179 !180 163 END IF 181 164 END SUBROUTINE dom_clo 182 183 SUBROUTINE sbc_clo_init184 185 ! compute source surface area186 CALL get_cssrcsurf( jncsg, mask_csglo, rsurfsrcg )187 CALL get_cssrcsurf( jncsr, mask_csrnf, rsurfsrcr )188 CALL get_cssrcsurf( jncse, mask_csemp, rsurfsrce )189 !190 ! compute target surface area and group number (jcsgrp) for all cs and cases191 ! glo could be simpler but for lisibility, all treated the same way192 ! It is only done once, so not a big deal193 CALL get_cstrgsurf( jncsg, mask_csglo, mask_csgrpglo, rsurftrgg, jcsgrpg )194 CALL get_cstrgsurf( jncsr, mask_csrnf, mask_csgrprnf, rsurftrgr, jcsgrpr )195 CALL get_cstrgsurf( jncse, mask_csemp, mask_csgrpemp, rsurftrge, jcsgrpe )196 !197 ! print out in ocean.ouput198 CALL prt_csctl( jncsg, rsurfsrcg, rsurftrgg, jcsgrpg, 'glo' )199 CALL prt_csctl( jncsr, rsurfsrcr, rsurftrgr, jcsgrpr, 'rnf' )200 CALL prt_csctl( jncse, rsurfsrce, rsurftrge, jcsgrpe, 'emp' )201 202 END SUBROUTINE sbc_clo_init203 204 SUBROUTINE get_cssrcsurf(kncs, pmaskcs, psurfsrc)205 206 ! subroutine parameters207 INTEGER, INTENT(in ) :: kncs208 INTEGER, DIMENSION(:,:), INTENT(in ) :: pmaskcs209 210 REAL(wp), DIMENSION(:) , INTENT(inout) :: psurfsrc211 212 ! local variables213 INTEGER, DIMENSION(jpi,jpj) :: zmsksrc214 INTEGER :: jcs215 216 DO jcs = 1,kncs217 !218 ! build river mouth mask for this lake219 WHERE ( pmaskcs == jcs )220 zmsksrc = 1221 ELSE WHERE222 zmsksrc = 0223 END WHERE224 !225 ! compute target area226 psurfsrc(jcs) = glob_sum('closea', e1e2t(:,:) * zmsksrc(:,:) )227 !228 END DO229 230 END SUBROUTINE231 232 SUBROUTINE get_cstrgsurf(kncs, pmaskcs, pmaskcsgrp, psurftrg, kcsgrp )233 234 ! subroutine parameters235 INTEGER, INTENT(in ) :: kncs236 INTEGER, DIMENSION(:), INTENT(inout) :: kcsgrp237 INTEGER, DIMENSION(:,:), INTENT(in ) :: pmaskcs, pmaskcsgrp238 239 REAL(wp), DIMENSION(:) , INTENT(inout) :: psurftrg240 241 ! local variables242 INTEGER, DIMENSION(jpi,jpj) :: zmskgrp, zmsksrc, zmsktrg243 INTEGER :: jcs, jtmp244 245 DO jcs = 1,kncs246 !247 ! find group number248 zmskgrp = pmaskcsgrp249 zmsksrc = pmaskcs250 !251 ! set value where cs is252 zmsktrg = HUGE(1)253 WHERE ( zmsksrc == jcs ) zmsktrg = jcs254 !255 ! zmsk = HUGE outside the cs number jcs256 ! ktmp = jcs - group number257 ! jgrp = group corresponding to the cs jcs258 zmsktrg = zmsktrg - zmskgrp259 jtmp = MINVAL(zmsktrg) ; CALL mpp_min('closea',jtmp)260 kcsgrp(jcs) = jcs - jtmp261 !262 ! build river mouth mask for this lake263 WHERE ( zmskgrp * mask_opnsea == kcsgrp(jcs) )264 zmsktrg = 1265 ELSE WHERE266 zmsktrg = 0267 END WHERE268 !269 ! compute target area270 psurftrg(jcs) = glob_sum('closea', e1e2t(:,:) * zmsktrg(:,:) )271 !272 END DO273 274 END SUBROUTINE275 276 SUBROUTINE prt_csctl(kncs, psurfsrc, psurftrg, kcsgrp, pcstype)277 ! subroutine parameters278 INTEGER, INTENT(in ) :: kncs279 INTEGER, DIMENSION(:), INTENT(in ) :: kcsgrp280 !281 REAL(wp), DIMENSION(:), INTENT(in ) :: psurfsrc, psurftrg282 !283 CHARACTER(256), INTENT(in ) :: pcstype284 !285 ! local variable286 INTEGER :: jcs287 288 IF ( lwp .AND. kncs > 0 ) THEN289 WRITE(numout,*)''290 !291 WRITE(numout,*)'Closed sea target ',TRIM(pcstype),' : '292 !293 DO jcs = 1,kncs294 WRITE(numout,FMT='(3a,i3,a,i3)') ' ',TRIM(pcstype),' closed sea id is ',jcs,' and trg id is : ', kcsgrp(jcs)295 WRITE(numout,FMT='(a,f12.2)' ) ' src surface areas (km2) : ', psurfsrc(jcs) * 1.0e-6296 WRITE(numout,FMT='(a,f12.2)' ) ' trg surface areas (km2) : ', psurftrg(jcs) * 1.0e-6297 END DO298 !299 WRITE(numout,*)''300 END IF301 END SUBROUTINE302 303 SUBROUTINE sbc_clo( kt ) ! to be move in SBC in a file sbcclo ???304 !!---------------------------------------------------------------------305 !! *** ROUTINE sbc_clo ***306 !!307 !! ** Purpose : Special handling of closed seas308 !!309 !! ** Method : Water flux is forced to zero over closed sea310 !! Excess is shared between remaining ocean, or311 !! put as run-off in open ocean.312 !!313 !! ** Action : emp updated surface freshwater fluxes and associated heat content at kt314 !!----------------------------------------------------------------------315 INTEGER , INTENT(in ) :: kt ! ocean model time step316 !!----------------------------------------------------------------------317 !318 IF( ln_timing ) CALL timing_start('sbc_clo')319 !320 ! update emp and qns321 CALL sbc_csupdate( jncsg, jcsgrpg, mask_csglo, mask_csgrpglo, rsurfsrcg, rsurftrgg, 'glo', mask_opnsea, rsurftrgg )322 CALL sbc_csupdate( jncsr, jcsgrpr, mask_csrnf, mask_csgrprnf, rsurfsrcr, rsurftrgr, 'rnf', mask_opnsea, rsurftrgg )323 CALL sbc_csupdate( jncse, jcsgrpe, mask_csemp, mask_csgrpemp, rsurfsrce, rsurftrge, 'emp', mask_opnsea, rsurftrgg )324 !325 ! is this really useful ??????326 emp(:,:) = emp(:,:) * tmask(:,:,1)327 qns(:,:) = qns(:,:) * tmask(:,:,1)328 !329 ! is this really useful ??????330 CALL lbc_lnk( 'closea', emp , 'T', 1._wp )331 CALL lbc_lnk( 'closea', qns , 'T', 1._wp )332 !333 END SUBROUTINE sbc_clo334 335 SUBROUTINE sbc_csupdate(kncs, kcsgrp, pmsk_src, pmsk_trg, psurfsrc, psurftrg, pcstype, pmsk_opnsea, psurf_opnsea)336 337 ! subroutine parameters338 INTEGER, INTENT(in ) :: kncs339 INTEGER, DIMENSION(: ), INTENT(in ) :: kcsgrp340 INTEGER, DIMENSION(:,:), INTENT(in ) :: pmsk_src, pmsk_trg, pmsk_opnsea341 342 REAL(wp), DIMENSION(:), INTENT(inout) :: psurfsrc, psurftrg, psurf_opnsea343 344 CHARACTER(256), INTENT(in ) :: pcstype345 346 ! local variables347 INTEGER :: jcs348 INTEGER, DIMENSION(jpi,jpj) :: zmsk_src, zmsk_trg349 350 REAL(wp) :: zcoef, zcoef1, ztmp351 REAL(wp) :: zcsfwf352 REAL(wp) :: zsurftrg353 354 DO jcs = 1, kncs355 !!356 !! 0. get mask of each closed sea357 zmsk_src(:,:) = 0358 WHERE ( pmsk_src(:,:) == jcs ) zmsk_src = 1359 !!360 !! 1. Work out net freshwater fluxes over each closed seas from EMP - RNF.361 zcsfwf = glob_sum( 'closea', e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * zmsk_src )362 !!363 !! 2. Deal with runoff special case (net evaporation spread globally)364 IF (pcstype == 'rnf' .AND. zcsfwf > 0) THEN365 zsurftrg = psurf_opnsea(1)366 zmsk_trg = pmsk_opnsea367 ELSE368 zsurftrg = psurftrg(jcs)369 zmsk_trg = pmsk_trg370 END IF371 zmsk_trg = zmsk_trg * pmsk_opnsea372 !!373 !! 3. Add residuals to target points374 zcoef = zcsfwf / zsurftrg375 zcoef1 = rcp * zcoef376 WHERE( zmsk_trg(:,:) == kcsgrp(jcs) )377 emp(:,:) = emp(:,:) + zcoef378 qns(:,:) = qns(:,:) - zcoef1 * sst_m(:,:)379 ENDWHERE380 !!381 !! 4. Subtract residuals from source points382 zcoef = zcsfwf / psurfsrc(jcs)383 zcoef1 = rcp * zcoef384 WHERE( pmsk_src(:,:) == jcs )385 emp(:,:) = emp(:,:) - zcoef386 qns(:,:) = qns(:,:) + zcoef1 * sst_m(:,:)387 ENDWHERE388 !!389 END DO ! jcs390 391 END SUBROUTINE392 393 165 394 166 SUBROUTINE clo_rnf( p_rnfmsk ) … … 420 192 END SUBROUTINE clo_rnf 421 193 422 SUBROUTINE clo_bat( k_top, k_bot, p_mask, p_prt )194 SUBROUTINE clo_bat( k_top, k_bot, k_mask, cd_prt ) 423 195 !!--------------------------------------------------------------------- 424 196 !! *** ROUTINE clo_bat *** … … 436 208 !! subroutine parameter 437 209 INTEGER, DIMENSION(:,:), INTENT(inout) :: k_top, k_bot ! ocean first and last level indices 438 INTEGER, DIMENSION(:,:), INTENT(in ) :: p_mask ! mask used to mask ktop and k_bot439 CHARACTER(256), INTENT(in ) :: p_prt! text for control print210 INTEGER, DIMENSION(:,:), INTENT(in ) :: k_mask ! mask used to mask ktop and k_bot 211 CHARACTER(256), INTENT(in ) :: cd_prt ! text for control print 440 212 !! 441 213 !! local variables … … 444 216 IF ( lwp ) THEN 445 217 WRITE(numout,*) 446 WRITE(numout,*) 'clo_bat : Suppression closed seas based on ',TRIM( p_prt),' field.'218 WRITE(numout,*) 'clo_bat : Suppression closed seas based on ',TRIM(cd_prt),' field.' 447 219 WRITE(numout,*) '~~~~~~~' 448 220 WRITE(numout,*) 449 221 ENDIF 450 222 !! 451 k_top(:,:) = k_top(:,:) * p_mask(:,:)452 k_bot(:,:) = k_bot(:,:) * p_mask(:,:)223 k_top(:,:) = k_top(:,:) * k_mask(:,:) 224 k_bot(:,:) = k_bot(:,:) * k_mask(:,:) 453 225 !! 454 226 END SUBROUTINE clo_bat 455 227 456 SUBROUTINE read_csmask( p_file, p_var, p_mskout)228 SUBROUTINE read_csmask(cd_file, cd_var, k_mskout) 457 229 ! 458 230 ! subroutine parameter 459 CHARACTER(256), INTENT(in ) :: p_file, p_var460 INTEGER, DIMENSION(:,:), INTENT(inout) :: p_mskout231 CHARACTER(256), INTENT(in ) :: cd_file, cd_var ! netcdf file and variable name 232 INTEGER, DIMENSION(:,:), INTENT(inout) :: k_mskout ! output mask variable 461 233 ! 462 234 ! local variables 463 INTEGER :: ics 464 REAL(wp), DIMENSION(jpi,jpj) :: zdta 465 ! 466 CALL iom_open ( p_file, ics )467 CALL iom_get ( ics, jpdom_data, TRIM( p_var), zdta )235 INTEGER :: ics ! netcdf id 236 REAL(wp), DIMENSION(jpi,jpj) :: zdta ! netcdf data 237 ! 238 CALL iom_open ( cd_file, ics ) 239 CALL iom_get ( ics, jpdom_data, TRIM(cd_var), zdta ) 468 240 CALL iom_close( ics ) 469 p_mskout(:,:) = NINT(zdta(:,:))241 k_mskout(:,:) = NINT(zdta(:,:)) 470 242 ! 471 243 END SUBROUTINE read_csmask 472 244 473 SUBROUTINE alloc_csmask( pmask )245 SUBROUTINE alloc_csmask( kmask ) 474 246 ! 475 247 ! subroutine parameter 476 INTEGER, ALLOCATABLE, DIMENSION(:,:), INTENT(inout) :: pmask248 INTEGER, ALLOCATABLE, DIMENSION(:,:), INTENT(inout) :: kmask 477 249 ! 478 250 ! local variables 479 251 INTEGER :: ierr 480 252 ! 481 ALLOCATE( pmask(jpi,jpj) , STAT=ierr )253 ALLOCATE( kmask(jpi,jpj) , STAT=ierr ) 482 254 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'alloc_csmask: failed to allocate surf array') 483 255 ! 484 256 END SUBROUTINE 485 257 486 487 SUBROUTINE alloc_cssurf( klen, pvarsrc, pvartrg )488 !489 ! subroutine parameter490 INTEGER, INTENT(in) :: klen491 REAL(wp), ALLOCATABLE, DIMENSION(:), INTENT(inout) :: pvarsrc, pvartrg492 !493 ! local variables494 INTEGER :: ierr495 !496 ! klen (number of lake) can be zero so use MAX(klen,1) to avoid 0 length array497 ALLOCATE( pvarsrc(MAX(klen,1)) , pvartrg(MAX(klen,1)) , STAT=ierr )498 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'sbc_clo: failed to allocate surf array')499 ! initialise to 0500 pvarsrc(:) = 0.e0_wp501 pvartrg(:) = 0.e0_wp502 END SUBROUTINE503 504 SUBROUTINE alloc_csgrp( klen, kvar )505 !506 ! subroutine parameter507 INTEGER, INTENT(in) :: klen508 INTEGER, ALLOCATABLE, DIMENSION(:), INTENT(inout) :: kvar509 !510 ! local variables511 INTEGER :: ierr512 !513 ! klen (number of lake) can be zero so use MAX(klen,1) to avoid 0 length array514 ALLOCATE( kvar(MAX(klen,1)) , STAT=ierr )515 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'sbc_clo: failed to allocate group array')516 ! initialise to 0517 kvar(:) = 0518 END SUBROUTINE519 520 !!======================================================================521 258 END MODULE closea 522
Note: See TracChangeset
for help on using the changeset viewer.
