Changeset 2528 for trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
- Timestamp:
- 2010-12-27T18:33:53+01:00 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
- Property svn:executable deleted
r1528 r2528 8 8 !! - ! 2007-01 (D. Storkey) Tidal forcing 9 9 !! 3.0 ! 2008-04 (NEMO team) add in the reference version 10 !! 3.3 ! 2010-09 (E.O'Dea) updates for Shelf configurations 11 !! 3.3 ! 2010-09 (D.Storkey) add ice boundary conditions 10 12 !!---------------------------------------------------------------------- 11 13 #if defined key_bdy … … 17 19 USE oce ! ocean dynamics and tracers variables 18 20 USE dom_oce ! ocean space and time domain 21 USE obc_par ! ocean open boundary conditions 19 22 USE bdy_oce ! unstructured open boundary conditions 20 23 USE bdytides ! tides at open boundaries initialization (tide_init routine) … … 30 33 31 34 !!---------------------------------------------------------------------- 32 !! NEMO/OPA 3. 0 , LOCEAN-IPSL (2008)35 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 33 36 !! $Id$ 34 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 35 !!--------------------------------------------------------------------------------- 36 37 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 38 !!---------------------------------------------------------------------- 37 39 CONTAINS 38 40 … … 48 50 !! 49 51 !! ** Input : bdy_init.nc, input file for unstructured open boundaries 50 !!51 52 !!---------------------------------------------------------------------- 52 53 INTEGER :: ii, ij, ik, igrd, ib, ir ! dummy loop indices … … 54 55 INTEGER :: ib_len, ibr_max 55 56 INTEGER :: iw, ie, is, in 56 INTEGER :: inum ! temporarylogical unit57 INTEGER :: id_dummy ! temporaryintegers57 INTEGER :: inum ! local logical unit 58 INTEGER :: id_dummy ! local integers 58 59 INTEGER :: igrd_start, igrd_end ! start and end of loops on igrd 59 60 INTEGER, DIMENSION (2) :: kdimsz … … 63 64 REAL(wp) , DIMENSION(jpidta,jpjdta) :: zmask ! global domain mask 64 65 REAL(wp) , DIMENSION(jpbdta,1) :: zdta ! temporary array 65 CHARACTER(LEN=80),DIMENSION( 3) :: clfile66 CHARACTER(LEN=80),DIMENSION(6) :: clfile 66 67 !! 67 NAMELIST/nambdy/filbdy_mask, filbdy_data_T, filbdy_data_U, filbdy_data_V, & 68 & ln_bdy_tides, ln_bdy_clim, ln_bdy_vol, ln_bdy_mask, & 69 & ln_bdy_dyn_fla, ln_bdy_dyn_frs, ln_bdy_tra_frs, & 70 & nbdy_dta , nb_rimwidth , volbdy 68 NAMELIST/nambdy/cn_mask, cn_dta_frs_T, cn_dta_frs_U, cn_dta_frs_V, & 69 & cn_dta_fla_T, cn_dta_fla_U, cn_dta_fla_V, & 70 & ln_tides, ln_clim, ln_vol, ln_mask, & 71 & ln_dyn_fla, ln_dyn_frs, ln_tra_frs,ln_ice_frs, & 72 & nn_dtactl, nn_rimwidth, nn_volctl 71 73 !!---------------------------------------------------------------------- 72 74 … … 75 77 IF(lwp) WRITE(numout,*) '~~~~~~~~' 76 78 ! 77 IF( jperio /= 0 ) CALL ctl_stop( 'Cyclic or symmetric,', & 78 ' and unstructured open boundary condition are not compatible' ) 79 80 #if defined key_obc 81 CALL ctl_stop( 'Straight open boundaries,', & 82 ' and unstructured open boundaries are not compatible' ) 83 #endif 84 85 ! Read namelist parameters 79 IF( jperio /= 0 ) CALL ctl_stop( 'Cyclic or symmetric,', & 80 & ' and unstructured open boundary condition are not compatible' ) 81 82 IF( lk_obc ) CALL ctl_stop( 'Straight open boundaries,', & 83 & ' and unstructured open boundaries are not compatible' ) 84 86 85 ! --------------------------- 87 REWIND( numnam ) 86 REWIND( numnam ) ! Read namelist parameters 88 87 READ ( numnam, nambdy ) 89 88 90 ! control prints89 ! ! control prints 91 90 IF(lwp) WRITE(numout,*) ' nambdy' 92 91 93 ! Check nbdy_dta value 94 IF(lwp) WRITE(numout,*) 'nbdy_dta =', nbdy_dta 95 IF(lwp) WRITE(numout,*) ' ' 96 SELECT CASE( nbdy_dta ) 97 CASE( 0 ) 98 IF(lwp) WRITE(numout,*) ' initial state used for bdy data' 99 CASE( 1 ) 100 IF(lwp) WRITE(numout,*) ' boundary data taken from file' 101 CASE DEFAULT 102 CALL ctl_stop( 'nbdy_dta must be 0 or 1' ) 92 ! ! check type of data used (nn_dtactl value) 93 IF(lwp) WRITE(numout,*) 'nn_dtactl =', nn_dtactl 94 IF(lwp) WRITE(numout,*) 95 SELECT CASE( nn_dtactl ) ! 96 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' initial state used for bdy data' 97 CASE( 1 ) ; IF(lwp) WRITE(numout,*) ' boundary data taken from file' 98 CASE DEFAULT ; CALL ctl_stop( 'nn_dtactl must be 0 or 1' ) 103 99 END SELECT 104 100 105 IF(lwp) WRITE(numout,*) ' ' 106 IF(lwp) WRITE(numout,*) 'Boundary rim width for the FRS nb_rimwidth = ', nb_rimwidth 107 108 IF(lwp) WRITE(numout,*) ' ' 109 IF(lwp) WRITE(numout,*) ' volbdy = ', volbdy 110 111 IF (ln_bdy_vol) THEN 112 SELECT CASE ( volbdy ) ! Check volbdy value 113 CASE( 1 ) 114 IF(lwp) WRITE(numout,*) ' The total volume will be constant' 115 CASE( 0 ) 116 IF(lwp) WRITE(numout,*) ' The total volume will vary according' 117 IF(lwp) WRITE(numout,*) ' to the surface E-P flux' 118 CASE DEFAULT 119 CALL ctl_stop( 'volbdy must be 0 or 1' ) 120 END SELECT 101 IF(lwp) WRITE(numout,*) 102 IF(lwp) WRITE(numout,*) 'Boundary rim width for the FRS nn_rimwidth = ', nn_rimwidth 103 104 IF(lwp) WRITE(numout,*) 105 IF(lwp) WRITE(numout,*) ' nn_volctl = ', nn_volctl 106 107 IF( ln_vol ) THEN ! check volume conservation (nn_volctl value) 108 SELECT CASE ( nn_volctl ) 109 CASE( 1 ) ; IF(lwp) WRITE(numout,*) ' The total volume will be constant' 110 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' The total volume will vary according to the surface E-P flux' 111 CASE DEFAULT ; CALL ctl_stop( 'nn_volctl must be 0 or 1' ) 112 END SELECT 113 IF(lwp) WRITE(numout,*) 121 114 ELSE 122 IF(lwp) WRITE(numout,*) 'No volume correction with unstructured open boundaries' 123 IF(lwp) WRITE(numout,*) ' ' 124 ENDIF 125 126 IF (ln_bdy_tides) THEN 127 IF(lwp) WRITE(numout,*) ' ' 115 IF(lwp) WRITE(numout,*) 'No volume correction with unstructured open boundaries' 116 IF(lwp) WRITE(numout,*) 117 ENDIF 118 119 IF( ln_tides ) THEN 128 120 IF(lwp) WRITE(numout,*) 'Tidal harmonic forcing at unstructured open boundaries' 129 IF(lwp) WRITE(numout,*) ' ' 130 ENDIF 131 132 IF (ln_bdy_dyn_fla) THEN 133 IF(lwp) WRITE(numout,*) ' ' 121 IF(lwp) WRITE(numout,*) 122 ENDIF 123 124 IF( ln_dyn_fla ) THEN 134 125 IF(lwp) WRITE(numout,*) 'Flather condition on U, V at unstructured open boundaries' 135 IF(lwp) WRITE(numout,*) ' ' 136 ENDIF 137 138 IF (ln_bdy_dyn_frs) THEN 139 IF(lwp) WRITE(numout,*) ' ' 126 IF(lwp) WRITE(numout,*) 127 ENDIF 128 129 IF( ln_dyn_frs ) THEN 140 130 IF(lwp) WRITE(numout,*) 'FRS condition on U and V at unstructured open boundaries' 141 IF(lwp) WRITE(numout,*) ' ' 142 ENDIF 143 144 IF (ln_bdy_tra_frs) THEN 145 IF(lwp) WRITE(numout,*) ' ' 131 IF(lwp) WRITE(numout,*) 132 ENDIF 133 134 IF( ln_tra_frs ) THEN 146 135 IF(lwp) WRITE(numout,*) 'FRS condition on T & S fields at unstructured open boundaries' 147 IF(lwp) WRITE(numout,*) ' ' 148 ENDIF 149 150 ! Read tides namelist 151 ! ------------------------ 152 IF( ln_bdy_tides ) CALL tide_init 136 IF(lwp) WRITE(numout,*) 137 ENDIF 138 139 IF( ln_ice_frs ) THEN 140 IF(lwp) WRITE(numout,*) 'FRS condition on ice fields at unstructured open boundaries' 141 IF(lwp) WRITE(numout,*) 142 ENDIF 143 144 IF( ln_tides ) CALL tide_init ! Read tides namelist 145 153 146 154 147 ! Read arrays defining unstructured open boundaries … … 160 153 ! = 0 elsewhere 161 154 162 IF( cp_cfg == "eel" .AND. jp_cfg == 5 ) THEN 155 IF( cp_cfg == "eel" .AND. jp_cfg == 5 ) THEN ! EEL configuration at 5km resolution 163 156 zmask( : ,:) = 0.e0 164 157 zmask(jpizoom+1:jpizoom+jpiglo-2,:) = 1.e0 165 ELSE IF ( ln_bdy_mask ) THEN166 CALL iom_open( filbdy_mask, inum )158 ELSE IF( ln_mask ) THEN 159 CALL iom_open( cn_mask, inum ) 167 160 CALL iom_get ( inum, jpdom_data, 'bdy_msk', zmask(:,:) ) 168 161 CALL iom_close( inum ) … … 171 164 ENDIF 172 165 173 ! Save mask over local domain 174 DO ij = 1, nlcj 166 DO ij = 1, nlcj ! Save mask over local domain 175 167 DO ii = 1, nlci 176 168 bdytmask(ii,ij) = zmask( mig(ii), mjg(ij) ) … … 187 179 END DO 188 180 END DO 189 190 ! Lateral boundary conditions 191 CALL lbc_lnk( bdyumask(:,:), 'U', 1. ) 192 CALL lbc_lnk( bdyvmask(:,:), 'V', 1. ) 181 CALL lbc_lnk( bdyumask(:,:), 'U', 1. ) ; CALL lbc_lnk( bdyvmask(:,:), 'V', 1. ) ! Lateral boundary cond. 182 193 183 194 184 ! Read discrete distance and mapping indices … … 200 190 IF( cp_cfg == "eel" .AND. jp_cfg == 5 ) THEN 201 191 icount = 0 202 ! Define west boundary (from ii=2 to ii=1+nb_rimwidth): 203 DO ir = 1, nb_rimwidth 192 DO ir = 1, nn_rimwidth ! Define west boundary (from ii=2 to ii=1+nn_rimwidth): 204 193 DO ij = 3, jpjglo-2 205 icount =icount+1194 icount = icount + 1 206 195 nbidta(icount,:) = ir + 1 + (jpizoom-1) 207 nbjdta(icount,:) = ij + (jpjzoom-1)196 nbjdta(icount,:) = ij + (jpjzoom-1) 208 197 nbrdta(icount,:) = ir 209 198 END DO 210 199 END DO 211 212 ! Define east boundary (from ii=jpiglo-1 to ii=jpiglo-nb_rimwidth): 213 DO ir=1,nb_rimwidth 200 ! 201 DO ir = 1, nn_rimwidth ! Define east boundary (from ii=jpiglo-1 to ii=jpiglo-nn_rimwidth): 214 202 DO ij=3,jpjglo-2 215 icount =icount+1203 icount = icount + 1 216 204 nbidta(icount,:) = jpiglo-ir + (jpizoom-1) 217 205 nbidta(icount,2) = jpiglo-ir-1 + (jpizoom-1) ! special case for u points … … 220 208 END DO 221 209 END DO 222 210 ! 223 211 ELSE ! Read indices and distances in unstructured boundary data files 224 225 IF( ln_bdy_tides ) THEN 226 ! Read tides input files for preference in case there are 227 ! no bdydata files. 228 clfile(1) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_T.nc' 229 clfile(2) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_U.nc' 230 clfile(3) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_V.nc' 231 ELSE 232 clfile(1) = filbdy_data_T 233 clfile(2) = filbdy_data_U 234 clfile(3) = filbdy_data_V 212 ! 213 IF( ln_tides ) THEN ! Read tides input files for preference in case there are no bdydata files 214 clfile(4) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_T.nc' 215 clfile(5) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_U.nc' 216 clfile(6) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_V.nc' 217 ENDIF 218 IF( ln_dyn_fla .AND. .NOT. ln_tides ) THEN 219 clfile(4) = cn_dta_fla_T 220 clfile(5) = cn_dta_fla_U 221 clfile(6) = cn_dta_fla_V 222 ENDIF 223 224 IF( ln_tra_frs ) THEN 225 clfile(1) = cn_dta_frs_T 226 IF( .NOT. ln_dyn_frs ) THEN 227 clfile(2) = cn_dta_frs_T ! Dummy read re read T file for sake of 6 files 228 clfile(3) = cn_dta_frs_T ! 229 ENDIF 235 230 ENDIF 236 237 ! how many files are we to read in? 238 igrd_start = 1 239 igrd_end = 3 240 IF(.NOT. ln_bdy_tides ) THEN 241 IF(.NOT. (ln_bdy_dyn_fla) .AND..NOT. (ln_bdy_tra_frs)) THEN 242 ! No T-grid file. 243 igrd_start = 2 244 ELSEIF ( .NOT. ln_bdy_dyn_frs .AND..NOT. ln_bdy_dyn_fla ) THEN 245 ! No U-grid or V-grid file. 246 igrd_end = 1 247 ENDIF 231 IF( ln_dyn_frs ) THEN 232 IF( .NOT. ln_tra_frs ) clfile(1) = cn_dta_frs_U ! Dummy Read 233 clfile(2) = cn_dta_frs_U 234 clfile(3) = cn_dta_frs_V 235 ENDIF 236 237 ! ! how many files are we to read in? 238 IF(ln_tides .OR. ln_dyn_fla) igrd_start = 4 239 ! 240 IF(ln_tra_frs ) THEN ; igrd_start = 1 241 ELSEIF(ln_dyn_frs) THEN ; igrd_start = 2 242 ENDIF 243 ! 244 IF( ln_tra_frs ) igrd_end = 1 245 ! 246 IF(ln_dyn_fla .OR. ln_tides) THEN ; igrd_end = 6 247 ELSEIF( ln_dyn_frs ) THEN ; igrd_end = 3 248 248 ENDIF 249 249 … … 251 251 CALL iom_open( clfile(igrd), inum ) 252 252 id_dummy = iom_varid( inum, 'nbidta', kdimsz=kdimsz ) 253 WRITE(numout,*) 'kdimsz : ',kdimsz253 IF(lwp) WRITE(numout,*) 'kdimsz : ',kdimsz 254 254 ib_len = kdimsz(1) 255 IF( ib_len > jpbdta) CALL ctl_stop( & 256 'Boundary data array in file too long.', & 257 'File :', TRIM(clfile(igrd)), & 258 'increase parameter jpbdta.' ) 255 IF( ib_len > jpbdta) CALL ctl_stop( 'Boundary data array in file too long.', & 256 & 'File :', TRIM(clfile(igrd)),'increase parameter jpbdta.' ) 259 257 260 258 CALL iom_get( inum, jpdom_unknown, 'nbidta', zdta(1:ib_len,:) ) … … 264 262 CALL iom_get( inum, jpdom_unknown, 'nbjdta', zdta(1:ib_len,:) ) 265 263 DO ii = 1,ib_len 266 nbjdta(ii,igrd) = INT( zdta(ii,1) )267 END DO 268 CALL iom_get 264 nbjdta(ii,igrd) = INT( zdta(ii,1) ) 265 END DO 266 CALL iom_get( inum, jpdom_unknown, 'nbrdta', zdta(1:ib_len,:) ) 269 267 DO ii = 1,ib_len 270 nbrdta(ii,igrd) = INT( zdta(ii,1) )268 nbrdta(ii,igrd) = INT( zdta(ii,1) ) 271 269 END DO 272 270 CALL iom_close( inum ) 273 271 274 ! Check that rimwidth in file is big enough:275 ibr_max = MAXVAL( nbrdta(:,igrd) )276 IF(lwp) WRITE(numout,*)277 IF(lwp) WRITE(numout,*) ' Maximum rimwidth in file is ', ibr_max278 IF(lwp) WRITE(numout,*) ' nb_rimwidth from namelist is ', nb_rimwidth279 IF (ibr_max < nb_rimwidth) CALL ctl_stop( &280 'nb_rimwidth is larger than maximum rimwidth in file' )272 IF( igrd < 4) THEN ! Check that rimwidth in file is big enough for Frs case(barotropic is one): 273 ibr_max = MAXVAL( nbrdta(:,igrd) ) 274 IF(lwp) WRITE(numout,*) 275 IF(lwp) WRITE(numout,*) ' Maximum rimwidth in file is ', ibr_max 276 IF(lwp) WRITE(numout,*) ' nn_rimwidth from namelist is ', nn_rimwidth 277 IF (ibr_max < nn_rimwidth) CALL ctl_stop( 'nn_rimwidth is larger than maximum rimwidth in file' ) 278 ENDIF !Check igrd < 4 281 279 ! 282 280 END DO … … 293 291 294 292 DO igrd = igrd_start, igrd_end 295 icount = 0296 icountr = 0297 nblen(igrd) = 0298 nblenrim(igrd) = 0299 nblendta(igrd) = 0300 DO ir=1, nb_rimwidth301 DO ib = 1, jpbdta302 ! check if point is in local domain and equals ir303 IF( nbidta(ib,igrd) >= iw .AND. nbidta(ib,igrd) <= ie .AND. &304 & nbjdta(ib,igrd) >= is .AND. nbjdta(ib,igrd) <= in .AND. &305 & nbrdta(ib,igrd) == ir ) THEN306 !307 icount = icount + 1308 !309 IF( ir == 1 ) icountr = icountr+1293 icount = 0 294 icountr = 0 295 nblen (igrd) = 0 296 nblenrim(igrd) = 0 297 nblendta(igrd) = 0 298 DO ir=1, nn_rimwidth 299 DO ib = 1, jpbdta 300 ! check if point is in local domain and equals ir 301 IF( nbidta(ib,igrd) >= iw .AND. nbidta(ib,igrd) <= ie .AND. & 302 & nbjdta(ib,igrd) >= is .AND. nbjdta(ib,igrd) <= in .AND. & 303 & nbrdta(ib,igrd) == ir ) THEN 304 ! 305 icount = icount + 1 306 ! 307 IF( ir == 1 ) icountr = icountr+1 310 308 IF (icount > jpbdim) THEN 311 309 IF(lwp) WRITE(numout,*) 'bdy_ini: jpbdim too small' … … 328 326 DO igrd = igrd_start, igrd_end 329 327 DO ib = 1, nblen(igrd) 330 ! tanh formulation 331 nbw(ib,igrd) = 1.- TANH( FLOAT( nbr(ib,igrd) - 1 ) *0.5 ) 332 ! quadratic 333 ! nbw(ib,igrd) = (FLOAT(nb_rimwidth+1-nbr(ib,igrd))/FLOAT(nb_rimwidth))**2 334 ! linear 335 ! nbw(ib,igrd) = FLOAT(nb_rimwidth+1-nbr(ib,igrd))/FLOAT(nb_rimwidth) 328 nbw(ib,igrd) = 1.- TANH( FLOAT( nbr(ib,igrd) - 1 ) *0.5 ) ! tanh formulation 329 ! nbw(ib,igrd) = (FLOAT(nn_rimwidth+1-nbr(ib,igrd))/FLOAT(nn_rimwidth))**2 ! quadratic 330 ! nbw(ib,igrd) = FLOAT(nn_rimwidth+1-nbr(ib,igrd))/FLOAT(nn_rimwidth) ! linear 336 331 END DO 337 332 END DO … … 384 379 385 380 ! Lateral boundary conditions 386 CALL lbc_lnk( fmask , 'F', 1. ) 387 CALL lbc_lnk( bdytmask(:,:), 'T', 1. ) 388 CALL lbc_lnk( bdyumask(:,:), 'U', 1. ) 389 CALL lbc_lnk( bdyvmask(:,:), 'V', 1. ) 390 391 IF( ln_bdy_vol .OR. ln_bdy_dyn_fla ) THEN ! Indices and directions of rim velocity components 381 CALL lbc_lnk( fmask , 'F', 1. ) ; CALL lbc_lnk( bdytmask(:,:), 'T', 1. ) 382 CALL lbc_lnk( bdyumask(:,:), 'U', 1. ) ; CALL lbc_lnk( bdyvmask(:,:), 'V', 1. ) 383 384 IF( ln_vol .OR. ln_dyn_fla ) THEN ! Indices and directions of rim velocity components 392 385 ! 393 386 !flagu = -1 : u component is normal to the dynamical boundary but its direction is outward … … 437 430 ! Compute total lateral surface for volume correction: 438 431 ! ---------------------------------------------------- 439 440 432 bdysurftot = 0.e0 441 IF( ln_ bdy_vol ) THEN433 IF( ln_vol ) THEN 442 434 igrd = 2 ! Lateral surface at U-points 443 435 DO ib = 1, nblenrim(igrd) … … 455 447 & * tmask_i(nbi(ib,igrd),nbj(ib,igrd)+1) 456 448 END DO 457 449 ! 458 450 IF( lk_mpp ) CALL mpp_sum( bdysurftot ) ! sum over the global domain 459 451 END IF … … 468 460 ubtbdy(:) = 0.e0 469 461 vbtbdy(:) = 0.e0 462 #if defined key_lim2 463 frld_bdy(:) = 0.e0 464 hicif_bdy(:) = 0.e0 465 hsnif_bdy(:) = 0.e0 466 #endif 470 467 471 468 ! Read in tidal constituents and adjust for model start time 472 469 ! ---------------------------------------------------------- 473 IF( ln_ bdy_tides ) CALL tide_data470 IF( ln_tides ) CALL tide_data 474 471 ! 475 472 END SUBROUTINE bdy_init
Note: See TracChangeset
for help on using the changeset viewer.
