Changeset 11629
- Timestamp:
- 2019-10-01T18:17:20+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/ENHANCE-03_closea/src/OCE
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/ENHANCE-03_closea/src/OCE/DOM/closea.F90
r11295 r11629 16 16 !!---------------------------------------------------------------------- 17 17 !! dom_clo : read in masks which define closed seas and runoff areas 18 !! sbc_clo : Special handling of freshwater fluxes over closed seas19 18 !! clo_rnf : set close sea outflows as river mouths (see sbcrnf) 20 !! clo_ bat: set to zero a field over closed sea (see domzgr)19 !! clo_msk : set to zero a field over closed sea (see domzgr) 21 20 !!---------------------------------------------------------------------- 22 21 USE oce ! dynamics and tracers … … 38 37 PUBLIC dom_clo ! called by domain module 39 38 PUBLIC clo_rnf ! called by sbcrnf module 40 PUBLIC clo_ bat! called in domzgr module39 PUBLIC clo_msk ! called in domzgr module 41 40 42 41 LOGICAL, PUBLIC :: ln_maskcs !: logical to mask all closed sea … … 77 76 !! ** Action : Read mask_cs* fields (if needed) from domain_cfg file and infer 78 77 !! number of closed seas for each case (glo, rnf, emp) from mask_cs* field. 79 !! mask_csglo and mask_csgrpglo : integer values defining mappings from closed seas and associated groups to the open ocean for net fluxes. 78 !! 79 !! ** Output : mask_csglo and mask_csgrpglo : integer values defining mappings from closed seas and associated groups to the open ocean for net fluxes. 80 80 !! mask_csrnf and mask_csgrprnf : integer values defining mappings from closed seas and associated groups to a runoff area for downwards flux only. 81 81 !! mask_csemp and mask_csgrpemp : integer values defining mappings from closed seas and associated groups to a runoff area for net fluxes. … … 107 107 END IF 108 108 ! 109 l_sbc_clo = .false. ; l_clo_rnf = .false.110 IF (.NOT. ln_maskcs) l_sbc_clo = .true.111 IF (.NOT. ln_maskcs .AND. ln_clo_rnf) l_clo_rnf = .true.112 !113 109 ! read the closed seas masks (if they exist) from domain_cfg file (if it exists) 114 110 ! ------------------------------------------------------------------------------ … … 119 115 ! 120 116 IF ( ln_maskcs ) THEN 121 ! not special treatment of closed sea 117 ! closed sea are masked 118 ! no special treatment of closed sea 119 ! no redistribution of emp unbalance over closed sea into river mouth/open ocean 122 120 l_sbc_clo = .false. ; l_clo_rnf = .false. 123 121 ELSE 124 ! special treatment of closed seas122 ! redistribution of emp unbalance over closed sea into river mouth/open ocean 125 123 l_sbc_clo = .true. 126 124 ! … … 128 126 IF ( ln_clo_rnf) l_clo_rnf = .true. 129 127 ! 128 ! closed sea not defined (ie not in the domcfg namelist used to build the domcfg.nc file) are masked 130 129 IF ( ln_mask_csundef) THEN 131 ! load undef cs mask (1 in undef closed sea)132 130 CALL alloc_csmask( mask_csundef ) 133 131 CALL read_csmask( cn_domcfg, 'mask_csundef', mask_csundef ) 134 ! revert the mask for masking in domzgr 132 ! revert the mask for masking of undefined closed seas in domzgr 133 ! (0 over the undefined closed sea and 1 elsewhere) 135 134 mask_csundef = 1 - mask_csundef 136 135 END IF 137 136 ! 138 ! allocate source mask 137 ! allocate source mask for each cases 139 138 CALL alloc_csmask( mask_csglo ) 140 139 CALL alloc_csmask( mask_csrnf ) … … 151 150 ncse = MAXVAL( mask_csemp(:,:) ) ; CALL mpp_max( 'closea', ncse ) 152 151 ! 153 ! allocate closed sea group masks 152 ! allocate closed sea group masks 153 !(used to defined the target area in case multiple lakes have the same river mouth (great lakes for example) 154 154 CALL alloc_csmask( mask_csgrpglo ) 155 155 CALL alloc_csmask( mask_csgrprnf ) … … 176 176 !! ** Action : update (p_)mskrnf (set 1 at closed sea outflow) 177 177 !!---------------------------------------------------------------------- 178 !!179 178 !! subroutine parameter 180 179 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: p_rnfmsk ! river runoff mask (rnfmsk array) … … 192 191 END SUBROUTINE clo_rnf 193 192 194 SUBROUTINE clo_ bat( k_top, k_bot, k_mask, cd_prt )195 !!--------------------------------------------------------------------- 196 !! *** ROUTINE clo_ bat***193 SUBROUTINE clo_msk( k_top, k_bot, k_mask, cd_prt ) 194 !!--------------------------------------------------------------------- 195 !! *** ROUTINE clo_msk *** 197 196 !! 198 197 !! ** Purpose : Suppress closed sea from the domain 199 198 !! 200 !! ** Method : Read in closea_mask field (if it exists) from domain_cfg file. 201 !! Where closea_mask > 0 set first and last ocean level to 0 199 !! ** Method : Where closea_mask > 0 set first and last ocean level to 0 202 200 !! (As currently coded you can't define a closea_mask field in 203 201 !! usr_def_zgr). … … 205 203 !! ** Action : set k_top=0 and k_bot=0 over closed seas 206 204 !!---------------------------------------------------------------------- 207 !!208 205 !! subroutine parameter 209 206 INTEGER, DIMENSION(:,:), INTENT(inout) :: k_top, k_bot ! ocean first and last level indices … … 216 213 IF ( lwp ) THEN 217 214 WRITE(numout,*) 218 WRITE(numout,*) 'clo_ bat: Suppression closed seas based on ',TRIM(cd_prt),' field.'215 WRITE(numout,*) 'clo_msk : Suppression closed seas based on ',TRIM(cd_prt),' field.' 219 216 WRITE(numout,*) '~~~~~~~' 220 217 WRITE(numout,*) … … 224 221 k_bot(:,:) = k_bot(:,:) * k_mask(:,:) 225 222 !! 226 END SUBROUTINE clo_ bat223 END SUBROUTINE clo_msk 227 224 228 225 SUBROUTINE read_csmask(cd_file, cd_var, k_mskout) 229 ! 226 !!--------------------------------------------------------------------- 227 !! *** ROUTINE read_csmask *** 228 !! 229 !! ** Purpose : read mask in cd_filec file 230 !!---------------------------------------------------------------------- 230 231 ! subroutine parameter 231 CHARACTER(256), INTENT(in ) :: cd_file, cd_var ! netcdf file and variable name232 INTEGER, DIMENSION(:,:), INTENT( inout) :: k_mskout! output mask variable232 CHARACTER(256), INTENT(in ) :: cd_file, cd_var ! netcdf file and variable name 233 INTEGER, DIMENSION(:,:), INTENT( out) :: k_mskout ! output mask variable 233 234 ! 234 235 ! local variables 235 236 INTEGER :: ics ! netcdf id 236 237 REAL(wp), DIMENSION(jpi,jpj) :: zdta ! netcdf data 238 !!---------------------------------------------------------------------- 237 239 ! 238 240 CALL iom_open ( cd_file, ics ) … … 244 246 245 247 SUBROUTINE alloc_csmask( kmask ) 246 ! 248 !!--------------------------------------------------------------------- 249 !! *** ROUTINE alloc_csmask *** 250 !! 251 !! ** Purpose : allocated cs mask 252 !!---------------------------------------------------------------------- 247 253 ! subroutine parameter 248 254 INTEGER, ALLOCATABLE, DIMENSION(:,:), INTENT(inout) :: kmask … … 250 256 ! local variables 251 257 INTEGER :: ierr 258 !!---------------------------------------------------------------------- 252 259 ! 253 260 ALLOCATE( kmask(jpi,jpj) , STAT=ierr ) -
NEMO/branches/2019/ENHANCE-03_closea/src/OCE/DOM/domzgr.F90
r11207 r11629 121 121 IF ( ln_maskcs ) THEN 122 122 ! mask all the closed sea 123 CALL clo_ bat( k_top, k_bot, mask_opnsea, 'mask_opensea' )123 CALL clo_msk( k_top, k_bot, mask_opnsea, 'mask_opensea' ) 124 124 ELSE IF ( ln_mask_csundef ) THEN 125 125 ! defined closed sea are kept 126 126 ! mask all the undefined closed sea 127 CALL clo_ bat( k_top, k_bot, mask_csundef, 'mask_csundef' )127 CALL clo_msk( k_top, k_bot, mask_csundef, 'mask_csundef' ) 128 128 END IF 129 129 END IF -
NEMO/branches/2019/ENHANCE-03_closea/src/OCE/SBC/sbcclo.F90
r11295 r11629 2 2 !!====================================================================== 3 3 !! *** MODULE sbcclo *** 4 !! Ocean forcing: closea sea correction4 !! Ocean forcing: redistribution of emp unbalance over closed sea into river mouth or open ocean 5 5 !!===================================================================== 6 !! History : 4.1 ! 2019-09 (P. Mathiot) original 7 !! NEMO 8 !!---------------------------------------------------------------------- 9 ! 10 !!---------------------------------------------------------------------- 6 !! History : 4.0 and earlier ! see closea.F90 history 7 !! NEMO 4.1 ! 2019-09 (P. Mathiot) rewrite sbc_clo module to match new closed sea mask definition (original sbcclo.F90) 8 !! 9 !!---------------------------------------------------------------------- 10 ! 11 !!---------------------------------------------------------------------- 12 !! Public subroutines: 11 13 !! sbc_clo : update emp and qns over target area and source area 12 14 !! sbc_clo_init : initialise all variable needed for closed sea correction 13 15 !! 14 !! alloc_cssurf : allocate closed sea surface array15 !! alloc_cs grp : allocate closed sea grouparray16 !! Private subroutines: 17 !! alloc_csarr : allocate closed sea array 16 18 !! get_cssrcsurf : compute source surface area 17 19 !! get_cstrgsurf : compute target surface area … … 33 35 IMPLICIT NONE 34 36 ! 35 PRIVATE alloc_cssurf 36 PRIVATE alloc_csgrp 37 PRIVATE get_cssrcsurf 38 PRIVATE get_cstrgsurf 39 PRIVATE prt_csctl 40 PRIVATE sbc_csupdate 37 PRIVATE 41 38 ! 42 39 PUBLIC sbc_clo 43 40 PUBLIC sbc_clo_init 44 41 ! 45 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: rsurfsrcg, rsurftrgg !: closed seatarget glo surface areas46 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: rsurfsrcr, rsurftrgr !: closed seatarget rnf surface areas47 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: rsurfsrce, rsurftrge !: closed seatarget emp surface areas48 ! 49 INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: mcsgrpg, mcsgrpr, mcsgrpe !: closed sea group for glo, rnf and emp42 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: rsurfsrcg, rsurftrgg !: closed sea source/target glo surface areas 43 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: rsurfsrcr, rsurftrgr !: closed sea source/target rnf surface areas 44 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: rsurfsrce, rsurftrge !: closed sea source/target emp surface areas 45 ! 46 INTEGER, PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) :: mcsgrpg, mcsgrpr, mcsgrpe !: closed sea group for glo, rnf and emp 50 47 ! 51 48 CONTAINS … … 59 56 !! *** ROUTINE sbc_clo_init *** 60 57 !! 61 !! ** Purpose : Initialisation of the net fw closed sea correction58 !! ** Purpose : Initialisation of the variable needed for the net fw closed sea correction 62 59 !! 63 60 !! ** Method : - compute source surface area for each closed sea 64 61 !! - defined the group of each closed sea 65 !! 66 !! - compute target surface area and corresponding group for each closed sea62 !! (needed to manage multiple closed sea and one target area like great lakes / St Laurent outlet) 63 !! - compute target surface area 67 64 !!---------------------------------------------------------------------- 68 65 ! 69 66 ! 0. Allocate cs variables (surf) 70 CALL alloc_cs surf( ncsg, rsurfsrcg, rsurftrgg )71 CALL alloc_cs surf( ncsr, rsurfsrcr, rsurftrgr )72 CALL alloc_cs surf( ncse, rsurfsrce, rsurftrge )67 CALL alloc_csarr( ncsg, rsurfsrcg, rsurftrgg, mcsgrpg ) 68 CALL alloc_csarr( ncsr, rsurfsrcr, rsurftrgr, mcsgrpr ) 69 CALL alloc_csarr( ncse, rsurfsrce, rsurftrge, mcsgrpe ) 73 70 ! 74 71 ! 1. compute source surface area … … 77 74 CALL get_cssrcsurf( ncse, mask_csemp, rsurfsrce ) 78 75 ! 79 ! 2. Allocate cs group variables (mcsgrp) 80 CALL alloc_csgrp( ncsg, mcsgrpg ) 81 CALL alloc_csgrp( ncsr, mcsgrpr ) 82 CALL alloc_csgrp( ncse, mcsgrpe ) 83 ! 84 ! 3. compute target surface area and group number (mcsgrp) for all cs and cases 76 ! 2. compute target surface area and group number (mcsgrp) for all cs and cases 85 77 ! glo could be simpler but for lisibility, all treated the same way 86 78 ! It is only done once, so not a big deal … … 89 81 CALL get_cstrgsurf( ncse, mask_csemp, mask_csgrpemp, rsurftrge, mcsgrpe ) 90 82 ! 91 ! 4. print out in ocean.ouput 83 ! 3. print out in ocean.ouput 84 IF ( lwp ) WRITE(numout,*) 'sbc_clo_init : compute surface area for source (closed sea) and target (river mouth)' 85 IF ( lwp ) WRITE(numout,*) '~~~~~~~~~~~~~~' 92 86 CALL prt_csctl( ncsg, rsurfsrcg, rsurftrgg, mcsgrpg, 'glo' ) 93 87 CALL prt_csctl( ncsr, rsurfsrcr, rsurftrgr, mcsgrpr, 'rnf' ) … … 96 90 END SUBROUTINE sbc_clo_init 97 91 98 SUBROUTINE sbc_clo( kt ) ! to be move in SBC in a file sbcclo ???92 SUBROUTINE sbc_clo( kt ) 99 93 !!--------------------------------------------------------------------- 100 94 !! *** ROUTINE sbc_clo *** … … 144 138 !!---------------------------------------------------------------------- 145 139 ! subroutine parameters 146 INTEGER, INTENT(in ) :: kncs ! closed sea number 147 INTEGER, DIMENSION(:,:), INTENT(in ) :: kmaskcs ! closed sea mask 148 149 REAL(wp), DIMENSION(:) , INTENT(inout) :: psurfsrc ! source surface area 140 INTEGER , INTENT(in ) :: kncs ! closed sea number 141 INTEGER , DIMENSION(:,:), INTENT(in ) :: kmaskcs ! closed sea mask 142 REAL(wp), DIMENSION(:) , INTENT( out) :: psurfsrc ! source surface area 150 143 151 144 ! local variables … … 177 170 !!---------------------------------------------------------------------- 178 171 ! subroutine parameters 172 ! input 179 173 INTEGER, INTENT(in ) :: kncs ! closed sea number 180 INTEGER, DIMENSION(:) , INTENT(inout) :: kcsgrp ! closed sea group number181 174 INTEGER, DIMENSION(:,:), INTENT(in ) :: kmaskcs, kmaskcsgrp ! closed sea and group mask 182 175 183 REAL(wp), DIMENSION(:) , INTENT(inout) :: psurftrg ! target surface area 176 ! output 177 INTEGER , DIMENSION(:) , INTENT( out) :: kcsgrp ! closed sea group number 178 REAL(wp), DIMENSION(:) , INTENT( out) :: psurftrg ! target surface area 184 179 185 180 ! local variables 186 181 INTEGER :: jcs, jtmp ! tmp 187 INTEGER, DIMENSION(jpi,jpj) :: imskgrp, imsksrc, imsktrg ! tmp group, source and targetmask182 INTEGER, DIMENSION(jpi,jpj) :: imskgrp, imsksrc, imsktrg, imsk ! tmp group, source, target and tmp mask 188 183 !!---------------------------------------------------------------------- 189 184 ! … … 194 189 imsksrc = kmaskcs 195 190 ! 196 ! set cs value where cs is 197 imsktrg = HUGE(1) 198 WHERE ( imsksrc == jcs ) imsktrg = jcs 199 ! 200 ! zmsk = HUGE outside the cs number jcs 201 ! ktmp = jcs - group number 202 ! jgrp = group corresponding to the cs jcs 203 imsktrg = imsktrg - imskgrp 204 jtmp = MINVAL(imsktrg) ; CALL mpp_min('closea',jtmp) 191 ! set cs value where cs is defined 192 ! imsk = HUGE outside the cs id jcs 193 imsk = HUGE(1) 194 WHERE ( imsksrc == jcs ) imsk = jcs 195 ! 196 ! jtmp = jcs - group id for this lake 197 imsk = imsk - imskgrp 198 jtmp = MINVAL(imsk) ; CALL mpp_min('closea',jtmp) 199 ! kcsgrp = group id corresponding to the cs id jcs 200 ! kcsgrp(jcs)=(jcs - (jcs - group id))=group id 205 201 kcsgrp(jcs) = jcs - jtmp 206 202 ! 207 !! 1. build river mouth mask for this lake203 !! 1. build the target river mouth mask for this lake 208 204 WHERE ( imskgrp * mask_opnsea == kcsgrp(jcs) ) 209 205 imsktrg = 1 … … 243 239 ! 244 240 DO jcs = 1,kncs 245 WRITE(numout,FMT='(3a,i3,a,i3)') ' ',TRIM(cdcstype),' closed sea id is ',jcs,' and trg id is : ', kcsgrp(jcs)241 WRITE(numout,FMT='(3a,i3,a,i3)') ' ',TRIM(cdcstype),' closed sea id is ',jcs,' and trg group id is : ', kcsgrp(jcs) 246 242 WRITE(numout,FMT='(a,f12.2)' ) ' src surface areas (km2) : ', psurfsrc(jcs) * 1.0e-6 247 243 WRITE(numout,FMT='(a,f12.2)' ) ' trg surface areas (km2) : ', psurftrg(jcs) * 1.0e-6 … … 253 249 END SUBROUTINE 254 250 255 SUBROUTINE sbc_csupdate(kncs, kcsgrp, kmsk_src, kmsk_ trg, psurfsrc, psurftrg, cdcstype, kmsk_opnsea, psurf_opnsea, pwcs, pqcs)251 SUBROUTINE sbc_csupdate(kncs, kcsgrp, kmsk_src, kmsk_grp, psurfsrc, psurftrg, cdcstype, kmsk_opnsea, psurf_opnsea, pwcs, pqcs) 256 252 !!----------------------------------------------------------------------- 257 253 !! *** routine sbc_csupdate *** … … 261 257 !!---------------------------------------------------------------------- 262 258 ! subroutine parameters 263 INTEGER, INTENT(in) :: kncs ! closed sea number264 INTEGER, DIMENSION(: ), INTENT(in) :: kcsgrp ! closed sea group number265 INTEGER, DIMENSION(:,:), INTENT(in) :: kmsk_src, kmsk_ trg, kmsk_opnsea! source, target, open ocean mask259 INTEGER, INTENT(in) :: kncs ! closed sea id 260 INTEGER, DIMENSION(: ), INTENT(in) :: kcsgrp ! closed sea group id 261 INTEGER, DIMENSION(:,:), INTENT(in) :: kmsk_src, kmsk_grp, kmsk_opnsea ! source, target, open ocean mask 266 262 267 263 REAL(wp), DIMENSION(:) , INTENT(in ) :: psurfsrc, psurftrg, psurf_opnsea ! source, target and open ocean surface area … … 271 267 272 268 ! local variables 273 INTEGER :: jcs ! loop index over closed sea269 INTEGER :: jcs ! loop index over closed sea 274 270 INTEGER, DIMENSION(jpi,jpj) :: imsk_src, imsk_trg ! tmp array source and target closed sea masks 275 271 … … 281 277 DO jcs = 1, kncs ! loop over closed seas 282 278 ! 283 !! 0. get mask of eachclosed sea279 !! 0. get mask of the closed sea 284 280 imsk_src(:,:) = 0 285 281 WHERE ( kmsk_src(:,:) == jcs ) imsk_src(:,:) = 1 286 282 ! 287 !! 1. Work out net freshwater fluxes over each closed seas from EMP - RNF. 283 !! 1. Work out net freshwater fluxes over the closed sea from EMP - RNF. 284 !! (PM: should we consider used delayed glob sum ?) 288 285 zcsfwf = glob_sum( 'closea', e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * imsk_src(:,:) ) 289 286 ! 290 287 !! 2. Deal with runoff special case (net evaporation spread globally) 288 !! and compute trg mask 291 289 IF (cdcstype == 'rnf' .AND. zcsfwf > 0) THEN 292 zsurftrg = psurf_opnsea(1) 293 imsk_trg = k msk_opnsea * kcsgrp(jcs) ! set imsk_trg value to the corresponding group id290 zsurftrg = psurf_opnsea(1) ! change the target area surface 291 imsk_trg = kcsgrp(jcs) * kmsk_opnsea ! trg mask is now the open sea mask 294 292 ELSE 295 293 zsurftrg = psurftrg(jcs) 296 imsk_trg = kmsk_ trg294 imsk_trg = kmsk_grp * kmsk_opnsea 297 295 END IF 298 imsk_trg = imsk_trg * kmsk_opnsea299 296 ! 300 297 !! 3. Add residuals to target points 301 zcoef 302 zcoef1 298 zcoef = zcsfwf / zsurftrg 299 zcoef1 = rcp * zcoef 303 300 WHERE( imsk_trg(:,:) == kcsgrp(jcs) ) 304 301 pwcs(:,:) = pwcs(:,:) + zcoef … … 313 310 pqcs(:,:) = pqcs(:,:) + zcoef1 * sst_m(:,:) 314 311 ENDWHERE 312 ! WARNING (PM): the correction is done as it was done in the previous version 313 ! this do no conserve heat as there is no reason that 314 ! sum(zcoef1*sst_m) over the source (closed sea) (4) = sum(zcoef1*sst_m) over the target (river mouth) (3) 315 315 ! 316 316 END DO ! jcs … … 318 318 END SUBROUTINE 319 319 320 SUBROUTINE alloc_cs surf( klen, pvarsrc, pvartrg)320 SUBROUTINE alloc_csarr( klen, pvarsrc, pvartrg, kvargrp ) 321 321 !!----------------------------------------------------------------------- 322 322 !! *** routine alloc_cssurf *** 323 323 !! 324 !! ** Purpose : allocate closed sea surface array (source) 325 !!---------------------------------------------------------------------- 326 ! subroutine parameters 327 INTEGER, INTENT(in) :: klen 328 REAL(wp), ALLOCATABLE, DIMENSION(:), INTENT(inout) :: pvarsrc, pvartrg 324 !! ** Purpose : allocate closed sea surface array 325 !!---------------------------------------------------------------------- 326 ! subroutine parameters 327 INTEGER, INTENT(in) :: klen 328 INTEGER, ALLOCATABLE, DIMENSION(:), INTENT( out) :: kvargrp 329 REAL(wp), ALLOCATABLE, DIMENSION(:), INTENT( out) :: pvarsrc, pvartrg 329 330 ! 330 331 ! local variables … … 336 337 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'sbc_clo: failed to allocate surf array') 337 338 ! 339 ALLOCATE( kvargrp(MAX(klen,1)) , STAT=ierr ) 340 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'sbc_clo: failed to allocate group array') 341 ! 338 342 ! initialise to 0 339 343 pvarsrc(:) = 0.e0_wp 340 344 pvartrg(:) = 0.e0_wp 341 END SUBROUTINE 342 343 SUBROUTINE alloc_csgrp( klen, kvar ) 344 !!----------------------------------------------------------------------- 345 !! *** routine alloc_csgrp *** 346 !! 347 !! ** Purpose : allocate closed sea group surface array 348 !!---------------------------------------------------------------------- 349 ! subroutine parameters 350 INTEGER, INTENT(in) :: klen 351 INTEGER, ALLOCATABLE, DIMENSION(:), INTENT(inout) :: kvar 352 ! 353 ! local variables 354 INTEGER :: ierr 355 !!---------------------------------------------------------------------- 356 ! 357 ! klen (number of lake) can be zero so use MAX(klen,1) to avoid 0 length array 358 ALLOCATE( kvar(MAX(klen,1)) , STAT=ierr ) 359 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'sbc_clo: failed to allocate group array') 360 ! initialise to 0 361 kvar(:) = 0 345 kvargrp(:) = 0 362 346 END SUBROUTINE 363 347
Note: See TracChangeset
for help on using the changeset viewer.