Changeset 11991 for NEMO/branches
- Timestamp:
- 2019-11-27T18:32:01+01:00 (4 years ago)
- Location:
- NEMO/branches/2019/ENHANCE-03_domcfg/src
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/ENHANCE-03_domcfg/src/dom_oce.F90
r11604 r11991 239 239 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wmask !: land/ocean mask at W- pts 240 240 241 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: msk_opnsea , msk_closea!: open ocean mask, closed sea mask (all of them)242 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: msk_ glo , msk_rnf , msk_emp!: closed sea masks243 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: msk_ gloid, msk_rnfid, msk_empid!: closed sea masks241 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: msk_opnsea , msk_csundef !: open ocean mask, closed sea mask (all of them) 242 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: msk_csglo , msk_csrnf , msk_csemp !: closed sea masks 243 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: msk_csgrpglo, msk_csgrprnf, msk_csgrpemp !: closed sea masks 244 244 245 245 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: tpol, fpol !: north fold mask (jperio= 3 or 4) … … 344 344 & hift (jpi,jpj) , hifu (jpi,jpj) , STAT=ierr(10) ) 345 345 346 ALLOCATE( msk_opnsea (jpi,jpj), msk_closea(jpi,jpj),&347 & msk_ glo (jpi,jpj), msk_rnf (jpi,jpj), msk_emp(jpi,jpj), &348 & msk_ gloid(jpi,jpj), msk_rnfid(jpi,jpj), msk_empid(jpi,jpj), STAT=ierr(11) )346 ALLOCATE( msk_opnsea (jpi,jpj), msk_csundef (jpi,jpj), & 347 & msk_csglo (jpi,jpj), msk_csrnf (jpi,jpj), msk_csemp (jpi,jpj), & 348 & msk_csgrpglo(jpi,jpj), msk_csgrprnf(jpi,jpj), msk_csgrpemp(jpi,jpj), STAT=ierr(11) ) 349 349 ! 350 350 dom_oce_alloc = MAXVAL(ierr) -
NEMO/branches/2019/ENHANCE-03_domcfg/src/domain.F90
r11604 r11991 416 416 IF (ln_domclo) THEN 417 417 ! mask for the open sea 418 CALL iom_rstput( 0, 0, inum, 'mask_opensea' , msk_opnsea , ktype = jp_i4 )418 CALL iom_rstput( 0, 0, inum, 'mask_opensea' , msk_opnsea , ktype = jp_i4 ) 419 419 ! mask for all the under closed sea 420 CALL iom_rstput( 0, 0, inum, 'mask_csundef' , msk_c losea, ktype = jp_i4 )420 CALL iom_rstput( 0, 0, inum, 'mask_csundef' , msk_csundef , ktype = jp_i4 ) 421 421 ! mask for global, local net precip, local net precip and evaporation correction 422 CALL iom_rstput( 0, 0, inum, 'mask_csglo' , msk_ glo , ktype = jp_i4 )423 CALL iom_rstput( 0, 0, inum, 'mask_csemp' , msk_ emp , ktype = jp_i4 )424 CALL iom_rstput( 0, 0, inum, 'mask_csrnf' , msk_ rnf , ktype = jp_i4 )422 CALL iom_rstput( 0, 0, inum, 'mask_csglo' , msk_csglo , ktype = jp_i4 ) 423 CALL iom_rstput( 0, 0, inum, 'mask_csemp' , msk_csemp , ktype = jp_i4 ) 424 CALL iom_rstput( 0, 0, inum, 'mask_csrnf' , msk_csrnf , ktype = jp_i4 ) 425 425 ! mask for the various river mouth (in case multiple lake in the same outlet) 426 CALL iom_rstput( 0, 0, inum, 'mask_csgrpglo', msk_ gloid, ktype = jp_i4 )427 CALL iom_rstput( 0, 0, inum, 'mask_csgrpemp', msk_ empid, ktype = jp_i4 )428 CALL iom_rstput( 0, 0, inum, 'mask_csgrprnf', msk_ rnfid, ktype = jp_i4 )426 CALL iom_rstput( 0, 0, inum, 'mask_csgrpglo', msk_csgrpglo, ktype = jp_i4 ) 427 CALL iom_rstput( 0, 0, inum, 'mask_csgrpemp', msk_csgrpemp, ktype = jp_i4 ) 428 CALL iom_rstput( 0, 0, inum, 'mask_csgrprnf', msk_csgrprnf, ktype = jp_i4 ) 429 429 END IF 430 430 ! -
NEMO/branches/2019/ENHANCE-03_domcfg/src/domclo.F90
r11658 r11991 108 108 CALL dom_ngb(rn_lon_opnsea, rn_lat_opnsea, jiseed, jjseed, zdistseed, 'T') 109 109 110 !! 1.2 fill selectcell to -1110 !! 1.2 fill connected cell to -1 111 111 CALL fill_pool( jiseed, jjseed, msk_opnsea, -1._wp ) 112 112 … … 134 134 !! 1.4 Define closed sea mask (all of them, ie defined in the namelist or not) 135 135 !! needed to remove the undefined closed seas at the end 136 msk_c losea(:,:) = ( ssmask(:,:) - msk_opnsea(:,:) ) * 99._wp136 msk_csundef(:,:) = ( ssmask(:,:) - msk_opnsea(:,:) ) * 99._wp 137 137 138 138 !!---------------------------------------------------------------------- … … 143 143 jglo = 1 ; jrnf = 1 ; jemp = 1 144 144 !! mask used to group lake by net evap/precip distribution technics 145 msk_ glo(:,:) = msk_closea(:,:)146 msk_ rnf(:,:) = msk_closea(:,:)147 msk_ emp(:,:) = msk_closea(:,:)148 149 !! mask used to group multiple lake with the same river mouth (great lake for example)150 msk_ gloid(:,:) = 0.0_wp151 msk_ rnfid(:,:) = 0.0_wp152 msk_ empid(:,:) = 0.0_wp145 msk_csglo(:,:) = msk_csundef(:,:) 146 msk_csrnf(:,:) = msk_csundef(:,:) 147 msk_csemp(:,:) = msk_csundef(:,:) 148 149 !! mask used to define group of lake sharing the same river mouth 150 msk_csgrpglo(:,:) = 0.0_wp 151 msk_csgrprnf(:,:) = 0.0_wp 152 msk_csgrpemp(:,:) = 0.0_wp 153 153 154 154 IF (lwp) WRITE(numout,*)'closed seas: ' … … 164 164 CASE('glo') 165 165 jsch = jglo 166 zmsksrc(:,:) = msk_ glo(:,:)167 zmsktrg(:,:) = msk_ gloid(:,:)166 zmsksrc(:,:) = msk_csglo(:,:) 167 zmsktrg(:,:) = msk_csgrpglo(:,:) 168 168 CASE('rnf') 169 169 jsch = jrnf 170 zmsksrc(:,:) = msk_ rnf(:,:)171 zmsktrg(:,:) = msk_ rnfid(:,:)170 zmsksrc(:,:) = msk_csrnf(:,:) 171 zmsktrg(:,:) = msk_csgrprnf(:,:) 172 172 CASE('emp') 173 173 jsch = jemp 174 zmsksrc(:,:) = msk_ emp(:,:)175 zmsktrg(:,:) = msk_ empid(:,:)174 zmsksrc(:,:) = msk_csemp(:,:) 175 zmsktrg(:,:) = msk_csgrpemp(:,:) 176 176 CASE DEFAULT 177 177 CALL ctl_stop( 'STOP', 'domclo: ',TRIM(csch),' is an unknown target type for lake (should be glo, emp, rnf)' ) … … 186 186 187 187 !! sanity check on the msk value (closea mask should be 99 otherwise, lake already processed) 188 !! check if s ome lake are not connected188 !! check if seed on land or lake already processed 189 189 zchk = 0._wp 190 IF (mi0(jiseed) == mi1(jiseed) .AND. mj0(jjseed) == mj1(jjseed)) zchk = msk_c losea(mi0(jiseed),mj0(jjseed))190 IF (mi0(jiseed) == mi1(jiseed) .AND. mj0(jjseed) == mj1(jjseed)) zchk = msk_csundef(mi0(jiseed),mj0(jjseed)) 191 191 CALL mpp_max('domclo',zchk) 192 192 … … 215 215 216 216 !! fill close sea mask with counter value 217 !! and update undefined closed sea mask 217 218 CALL fill_pool( jiseed, jjseed, zmsksrc, REAL(jsch ,8)) 218 219 WHERE (zmsksrc(:,:) == REAL(jsch,8)) 219 msk_c losea= 0._wp220 msk_csundef = 0._wp 220 221 zmsktrg = sn_lake(jcs)%idtrg 221 222 END WHERE … … 224 225 IF (cloc /= 'global') THEN 225 226 226 !! set a minimumvalue for radius of the river influence227 !! set value for radius of the river influence 227 228 zradtrg = 0._wp 228 229 IF (mi0(jiseed) == mi1(jiseed) .AND. mj0(jjseed) == mj1(jjseed)) THEN … … 290 291 CASE ('glo') 291 292 jglo = jglo + 1 292 msk_ glo(:,:)= zmsksrc(:,:)293 msk_ gloid(:,:) = zmsktrg(:,:)293 msk_csglo(:,:) = zmsksrc(:,:) 294 msk_csgrpglo(:,:) = zmsktrg(:,:) 294 295 IF (lwp) WRITE(numout,*)' net evap/precip will be spread globally (glo)' 295 296 CASE ('rnf') 296 297 jrnf = jrnf + 1 297 msk_ rnf(:,:)= zmsksrc(:,:)298 msk_ rnfid(:,:) = zmsktrg(:,:)298 msk_csrnf(:,:) = zmsksrc(:,:) 299 msk_csgrprnf(:,:) = zmsktrg(:,:) 299 300 IF (lwp) WRITE(numout,*)' net precip will be spread locally and net evap globally (rnf)' 300 301 CASE ('emp') 301 302 jemp = jemp + 1 302 msk_ emp(:,:)= zmsksrc(:,:)303 msk_ empid(:,:) = zmsktrg(:,:)303 msk_csemp(:,:) = zmsksrc(:,:) 304 msk_csgrpemp(:,:) = zmsktrg(:,:) 304 305 IF (lwp) WRITE(numout,*)' net evap/precip will be spread locally (emp)' 305 306 END SELECT … … 314 315 315 316 !! mask all the cells not defined as closed sea 316 WHERE ( msk_ glo(:,:) == 99._wp ) msk_glo = 0._wp317 WHERE ( msk_ rnf(:,:) == 99._wp ) msk_rnf = 0._wp318 WHERE ( msk_ emp(:,:) == 99._wp ) msk_emp = 0._wp317 WHERE ( msk_csglo(:,:) == 99._wp ) msk_csglo = 0._wp 318 WHERE ( msk_csrnf(:,:) == 99._wp ) msk_csrnf = 0._wp 319 WHERE ( msk_csemp(:,:) == 99._wp ) msk_csemp = 0._wp 319 320 320 321 !! non defined closed sea 321 WHERE ( msk_c losea(:,:) > 0._wp ) msk_closea= 1._wp322 WHERE ( msk_csundef(:,:) > 0._wp ) msk_csundef = 1._wp 322 323 323 324 END SUBROUTINE dom_clo -
NEMO/branches/2019/ENHANCE-03_domcfg/src/domutl.F90
r11604 r11991 144 144 REAL(wp), INTENT(in) :: rfill ! filling value 145 145 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: rdta ! input data 146 REAL(wp), DIMENSION(jpi,jpj) :: rseedmap , rseedmap_b! location of new seed (used for processor exchange)146 REAL(wp), DIMENSION(jpi,jpj) :: rseedmap ! location of new seed (used for processor exchange) 147 147 148 148 INTEGER :: ii , ij , jj, kii, kjj ! working integer … … 175 175 DO WHILE ( nseed .NE. 0 ) 176 176 DO WHILE ( ASSOCIATED(seed) ) 177 ii=seed%i; ij=seed%j ; rseedmap(ii,ij)=1.177 ii=seed%i; ij=seed%j 178 178 ! update stack size 179 179 CALL del_head_idx(seed) … … 197 197 nseed=SUM(rseedmap); IF( lk_mpp ) CALL mpp_sum('domutil', nseed ) ! this is the sum of all the point check this iteration 198 198 ! 199 rseedmap_b(:,:)=rseedmap(:,:)200 199 CALL lbc_lnk('domutil', rseedmap, 'T', 1.) 201 200 ! 202 201 ! build new list of seed 202 ! new seed only if data > 0 (ie not land), data not already filled and rseedmap > 0 203 203 DO ii=1,jpi 204 204 DO jj=1,jpj 205 IF (rseedmap(ii,jj) > 0.0 .AND. r seedmap(ii,jj) /= rseedmap_b(ii,jj) .AND. rdta(ii,jj) > 0 .AND. rdta(ii,jj) /= rfill) THEN205 IF (rseedmap(ii,jj) > 0.0 .AND. rdta(ii,jj) > 0 .AND. rdta(ii,jj) /= rfill) THEN 206 206 CALL add_head_idx(seed, ii, jj, 1) 207 207 END IF
Note: See TracChangeset
for help on using the changeset viewer.