Changeset 2185 for branches/devukmo2010/NEMO/OPA_SRC/BDY/bdyini.F90
- Timestamp:
- 2010-10-07T17:17:57+02:00 (14 years ago)
- File:
-
- 1 edited
-
branches/devukmo2010/NEMO/OPA_SRC/BDY/bdyini.F90 (modified) (19 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/devukmo2010/NEMO/OPA_SRC/BDY/bdyini.F90
r2128 r2185 19 19 USE oce ! ocean dynamics and tracers variables 20 20 USE dom_oce ! ocean space and time domain 21 USE obc_par ! ocean open boundary conditions 21 22 USE bdy_oce ! unstructured open boundary conditions 22 23 USE bdytides ! tides at open boundaries initialization (tide_init routine) … … 32 33 33 34 !!---------------------------------------------------------------------- 34 !! NEMO/OPA 3. 0 , LOCEAN-IPSL (2008)35 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 35 36 !! $Id$ 36 37 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 37 !!--------------------------------------------------------------------------------- 38 38 !!---------------------------------------------------------------------- 39 39 CONTAINS 40 40 … … 50 50 !! 51 51 !! ** Input : bdy_init.nc, input file for unstructured open boundaries 52 !!53 52 !!---------------------------------------------------------------------- 54 53 INTEGER :: ii, ij, ik, igrd, ib, ir ! dummy loop indices … … 56 55 INTEGER :: ib_len, ibr_max 57 56 INTEGER :: iw, ie, is, in 58 INTEGER :: inum ! temporarylogical unit59 INTEGER :: id_dummy ! temporaryintegers57 INTEGER :: inum ! local logical unit 58 INTEGER :: id_dummy ! local integers 60 59 INTEGER :: igrd_start, igrd_end ! start and end of loops on igrd 61 60 INTEGER, DIMENSION (2) :: kdimsz … … 68 67 !! 69 68 NAMELIST/nambdy/filbdy_mask, filbdy_data_T, filbdy_data_U, filbdy_data_V, & 70 & filbdy_data_bt_T, filbdy_data_bt_U, filbdy_data_bt_V, &69 & filbdy_data_bt_T, filbdy_data_bt_U, filbdy_data_bt_V, & 71 70 & ln_bdy_tides, ln_bdy_clim, ln_bdy_vol, ln_bdy_mask, & 72 71 & ln_bdy_dyn_fla, ln_bdy_dyn_frs, ln_bdy_tra_frs,ln_bdy_ice_frs, & 73 72 & nbdy_dta, nb_rimwidth, volbdy 74 75 73 !!---------------------------------------------------------------------- 76 74 … … 79 77 IF(lwp) WRITE(numout,*) '~~~~~~~~' 80 78 ! 81 IF( jperio /= 0 ) CALL ctl_stop( 'Cyclic or symmetric,', & 82 ' and unstructured open boundary condition are not compatible' ) 83 84 #if defined key_obc 85 CALL ctl_stop( 'Straight open boundaries,', & 86 ' and unstructured open boundaries are not compatible' ) 87 #endif 88 89 ! 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 90 85 ! --------------------------- 91 REWIND( numnam ) 86 REWIND( numnam ) ! Read namelist parameters 92 87 READ ( numnam, nambdy ) 93 88 94 ! control prints89 ! ! control prints 95 90 IF(lwp) WRITE(numout,*) ' nambdy' 96 91 97 ! Check nbdy_dta value92 ! ! check type of data used (nbdy_dta value) 98 93 IF(lwp) WRITE(numout,*) 'nbdy_dta =', nbdy_dta 99 IF(lwp) WRITE(numout,*) ' ' 100 SELECT CASE( nbdy_dta ) 101 CASE( 0 ) 102 IF(lwp) WRITE(numout,*) ' initial state used for bdy data' 103 CASE( 1 ) 104 IF(lwp) WRITE(numout,*) ' boundary data taken from file' 105 CASE DEFAULT 106 CALL ctl_stop( 'nbdy_dta must be 0 or 1' ) 94 IF(lwp) WRITE(numout,*) 95 SELECT CASE( nbdy_dta ) ! 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( 'nbdy_dta must be 0 or 1' ) 107 99 END SELECT 108 100 109 IF(lwp) WRITE(numout,*) ' '101 IF(lwp) WRITE(numout,*) 110 102 IF(lwp) WRITE(numout,*) 'Boundary rim width for the FRS nb_rimwidth = ', nb_rimwidth 111 103 112 IF(lwp) WRITE(numout,*) ' ' 113 IF(lwp) WRITE(numout,*) ' volbdy = ', volbdy 114 115 IF (ln_bdy_vol) THEN 116 SELECT CASE ( volbdy ) ! Check volbdy value 117 CASE( 1 ) 118 IF(lwp) WRITE(numout,*) ' The total volume will be constant' 119 CASE( 0 ) 120 IF(lwp) WRITE(numout,*) ' The total volume will vary according' 121 IF(lwp) WRITE(numout,*) ' to the surface E-P flux' 122 CASE DEFAULT 123 CALL ctl_stop( 'volbdy must be 0 or 1' ) 124 END SELECT 104 IF(lwp) WRITE(numout,*) 105 IF(lwp) WRITE(numout,*) ' volbdy = ', volbdy 106 107 IF( ln_bdy_vol ) THEN ! check volume conservation (volbdy value) 108 SELECT CASE ( volbdy ) 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( 'volbdy must be 0 or 1' ) 112 END SELECT 113 IF(lwp) WRITE(numout,*) 125 114 ELSE 126 IF(lwp) WRITE(numout,*) 'No volume correction with unstructured open boundaries' 127 IF(lwp) WRITE(numout,*) ' ' 128 ENDIF 129 130 IF (ln_bdy_tides) THEN 131 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_bdy_tides ) THEN 132 120 IF(lwp) WRITE(numout,*) 'Tidal harmonic forcing at unstructured open boundaries' 133 IF(lwp) WRITE(numout,*) ' ' 134 ENDIF 135 136 IF (ln_bdy_dyn_fla) THEN 137 IF(lwp) WRITE(numout,*) ' ' 121 IF(lwp) WRITE(numout,*) 122 ENDIF 123 124 IF( ln_bdy_dyn_fla ) THEN 138 125 IF(lwp) WRITE(numout,*) 'Flather condition on U, V at unstructured open boundaries' 139 IF(lwp) WRITE(numout,*) ' ' 140 ENDIF 141 142 IF (ln_bdy_dyn_frs) THEN 143 IF(lwp) WRITE(numout,*) ' ' 126 IF(lwp) WRITE(numout,*) 127 ENDIF 128 129 IF( ln_bdy_dyn_frs ) THEN 144 130 IF(lwp) WRITE(numout,*) 'FRS condition on U and V at unstructured open boundaries' 145 IF(lwp) WRITE(numout,*) ' ' 146 ENDIF 147 148 IF (ln_bdy_tra_frs) THEN 149 IF(lwp) WRITE(numout,*) ' ' 131 IF(lwp) WRITE(numout,*) 132 ENDIF 133 134 IF( ln_bdy_tra_frs ) THEN 150 135 IF(lwp) WRITE(numout,*) 'FRS condition on T & S fields at unstructured open boundaries' 151 IF(lwp) WRITE(numout,*) ' ' 152 ENDIF 153 154 IF (ln_bdy_ice_frs) THEN 155 IF(lwp) WRITE(numout,*) ' ' 136 IF(lwp) WRITE(numout,*) 137 ENDIF 138 139 IF( ln_bdy_ice_frs ) THEN 156 140 IF(lwp) WRITE(numout,*) 'FRS condition on ice fields at unstructured open boundaries' 157 IF(lwp) WRITE(numout,*) ' ' 158 ENDIF 159 160 ! Read tides namelist 161 ! ------------------------ 162 IF( ln_bdy_tides ) CALL tide_init 141 IF(lwp) WRITE(numout,*) 142 ENDIF 143 144 IF( ln_bdy_tides ) CALL tide_init ! Read tides namelist 145 163 146 164 147 ! Read arrays defining unstructured open boundaries … … 170 153 ! = 0 elsewhere 171 154 172 IF( cp_cfg == "eel" .AND. jp_cfg == 5 ) THEN 155 IF( cp_cfg == "eel" .AND. jp_cfg == 5 ) THEN ! EEL configuration at 5km resolution 173 156 zmask( : ,:) = 0.e0 174 157 zmask(jpizoom+1:jpizoom+jpiglo-2,:) = 1.e0 175 ELSE IF 158 ELSE IF( ln_bdy_mask ) THEN 176 159 CALL iom_open( filbdy_mask, inum ) 177 160 CALL iom_get ( inum, jpdom_data, 'bdy_msk', zmask(:,:) ) … … 181 164 ENDIF 182 165 183 ! Save mask over local domain 184 DO ij = 1, nlcj 166 DO ij = 1, nlcj ! Save mask over local domain 185 167 DO ii = 1, nlci 186 168 bdytmask(ii,ij) = zmask( mig(ii), mjg(ij) ) … … 197 179 END DO 198 180 END DO 199 200 ! Lateral boundary conditions 201 CALL lbc_lnk( bdyumask(:,:), 'U', 1. ) 202 CALL lbc_lnk( bdyvmask(:,:), 'V', 1. ) 181 CALL lbc_lnk( bdyumask(:,:), 'U', 1. ) ; CALL lbc_lnk( bdyvmask(:,:), 'V', 1. ) ! Lateral boundary cond. 182 203 183 204 184 ! Read discrete distance and mapping indices … … 210 190 IF( cp_cfg == "eel" .AND. jp_cfg == 5 ) THEN 211 191 icount = 0 212 ! Define west boundary (from ii=2 to ii=1+nb_rimwidth): 213 DO ir = 1, nb_rimwidth 192 DO ir = 1, nb_rimwidth ! Define west boundary (from ii=2 to ii=1+nb_rimwidth): 214 193 DO ij = 3, jpjglo-2 215 icount =icount+1194 icount = icount + 1 216 195 nbidta(icount,:) = ir + 1 + (jpizoom-1) 217 nbjdta(icount,:) = ij + (jpjzoom-1)196 nbjdta(icount,:) = ij + (jpjzoom-1) 218 197 nbrdta(icount,:) = ir 219 198 END DO 220 199 END DO 221 222 ! Define east boundary (from ii=jpiglo-1 to ii=jpiglo-nb_rimwidth): 223 DO ir=1,nb_rimwidth 200 ! 201 DO ir = 1, nb_rimwidth ! Define east boundary (from ii=jpiglo-1 to ii=jpiglo-nb_rimwidth): 224 202 DO ij=3,jpjglo-2 225 icount =icount+1203 icount = icount + 1 226 204 nbidta(icount,:) = jpiglo-ir + (jpizoom-1) 227 205 nbidta(icount,2) = jpiglo-ir-1 + (jpizoom-1) ! special case for u points … … 230 208 END DO 231 209 END DO 232 210 ! 233 211 ELSE ! Read indices and distances in unstructured boundary data files 234 235 IF( ln_bdy_tides ) THEN 236 ! Read tides input files for preference in case there are 237 ! no bdydata files. 212 ! 213 IF( ln_bdy_tides ) THEN ! Read tides input files for preference in case there are no bdydata files 238 214 clfile(4) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_T.nc' 239 215 clfile(5) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_U.nc' 240 216 clfile(6) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_V.nc' 241 217 ENDIF 242 IF( ln_bdy_dyn_fla . and. .not. ln_bdy_tides ) THEN218 IF( ln_bdy_dyn_fla .AND. .NOT. ln_bdy_tides ) THEN 243 219 clfile(4) = filbdy_data_bt_T 244 220 clfile(5) = filbdy_data_bt_U … … 248 224 IF( ln_bdy_tra_frs ) THEN 249 225 clfile(1) = filbdy_data_T 250 IF( . not. ln_bdy_dyn_frs ) THEN251 clfile(2) = filbdy_data_T ! Dummy read re read T file for sake of 6 files252 clfile(3) = filbdy_data_T !226 IF( .NOT. ln_bdy_dyn_frs ) THEN 227 clfile(2) = filbdy_data_T ! Dummy read re read T file for sake of 6 files 228 clfile(3) = filbdy_data_T ! 253 229 ENDIF 254 230 ENDIF 255 231 IF( ln_bdy_dyn_frs ) THEN 256 IF( .not. ln_bdy_tra_frs ) THEN 257 clfile(1) = filbdy_data_U ! Dummy Read 258 ENDIF 232 IF( .NOT. ln_bdy_tra_frs ) clfile(1) = filbdy_data_U ! Dummy Read 259 233 clfile(2) = filbdy_data_U 260 234 clfile(3) = filbdy_data_V 261 235 ENDIF 262 236 263 ! how many files are we to read in? 264 IF(ln_bdy_tides .or. ln_bdy_dyn_fla) then 265 igrd_start = 4 237 ! ! how many files are we to read in? 238 IF(ln_bdy_tides .OR. ln_bdy_dyn_fla) igrd_start = 4 239 ! 240 IF(ln_bdy_tra_frs ) THEN ; igrd_start = 1 241 ELSEIF(ln_bdy_dyn_frs) THEN ; igrd_start = 2 266 242 ENDIF 267 268 IF(ln_bdy_tra_frs) then 269 igrd_start = 1 270 ELSEIF(ln_bdy_dyn_frs) then 271 igrd_start = 2 272 ENDIF 273 274 IF( ln_bdy_tra_frs ) then 275 igrd_end = 1 276 ENDIF 277 278 IF(ln_bdy_dyn_fla .or. ln_bdy_tides) THEN 279 igrd_end = 6 280 ELSEIF( ln_bdy_dyn_frs) THEN 281 igrd_end = 3 243 ! 244 IF( ln_bdy_tra_frs ) igrd_end = 1 245 ! 246 IF(ln_bdy_dyn_fla .OR. ln_bdy_tides) THEN ; igrd_end = 6 247 ELSEIF( ln_bdy_dyn_frs ) THEN ; igrd_end = 3 282 248 ENDIF 283 249 … … 287 253 IF(lwp) WRITE(numout,*) 'kdimsz : ',kdimsz 288 254 ib_len = kdimsz(1) 289 IF( ib_len > jpbdta) CALL ctl_stop( & 290 'Boundary data array in file too long.', & 291 'File :', TRIM(clfile(igrd)), & 292 '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.' ) 293 257 294 258 CALL iom_get( inum, jpdom_unknown, 'nbidta', zdta(1:ib_len,:) ) … … 298 262 CALL iom_get( inum, jpdom_unknown, 'nbjdta', zdta(1:ib_len,:) ) 299 263 DO ii = 1,ib_len 300 nbjdta(ii,igrd) = INT( zdta(ii,1) )301 END DO 302 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,:) ) 303 267 DO ii = 1,ib_len 304 nbrdta(ii,igrd) = INT( zdta(ii,1) )268 nbrdta(ii,igrd) = INT( zdta(ii,1) ) 305 269 END DO 306 270 CALL iom_close( inum ) 307 271 308 ! Check that rimwidth in file is big enough for Frs case(barotropic is one): 309 IF( igrd < 4) then 310 ibr_max = MAXVAL( nbrdta(:,igrd) ) 311 IF(lwp) WRITE(numout,*) 312 IF(lwp) WRITE(numout,*) ' Maximum rimwidth in file is ', ibr_max 313 IF(lwp) WRITE(numout,*) ' nb_rimwidth from namelist is ', nb_rimwidth 314 IF (ibr_max < nb_rimwidth) CALL ctl_stop( & 315 '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,*) ' nb_rimwidth from namelist is ', nb_rimwidth 277 IF (ibr_max < nb_rimwidth) CALL ctl_stop( 'nb_rimwidth is larger than maximum rimwidth in file' ) 316 278 ENDIF !Check igrd < 4 317 279 ! … … 329 291 330 292 DO igrd = igrd_start, igrd_end 331 icount = 0332 icountr = 0333 nblen(igrd) = 0334 nblenrim(igrd) = 0335 nblendta(igrd) = 0336 DO ir=1, nb_rimwidth337 DO ib = 1, jpbdta338 ! check if point is in local domain and equals ir339 IF( nbidta(ib,igrd) >= iw .AND. nbidta(ib,igrd) <= ie .AND. &340 & nbjdta(ib,igrd) >= is .AND. nbjdta(ib,igrd) <= in .AND. &341 & nbrdta(ib,igrd) == ir ) THEN342 !343 icount = icount + 1344 !345 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, nb_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 346 308 IF (icount > jpbdim) THEN 347 309 IF(lwp) WRITE(numout,*) 'bdy_ini: jpbdim too small' … … 364 326 DO igrd = igrd_start, igrd_end 365 327 DO ib = 1, nblen(igrd) 366 ! tanh formulation 367 nbw(ib,igrd) = 1.- TANH( FLOAT( nbr(ib,igrd) - 1 ) *0.5 ) 368 ! quadratic 369 ! nbw(ib,igrd) = (FLOAT(nb_rimwidth+1-nbr(ib,igrd))/FLOAT(nb_rimwidth))**2 370 ! linear 371 ! 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(nb_rimwidth+1-nbr(ib,igrd))/FLOAT(nb_rimwidth))**2 ! quadratic 330 ! nbw(ib,igrd) = FLOAT(nb_rimwidth+1-nbr(ib,igrd))/FLOAT(nb_rimwidth) ! linear 372 331 END DO 373 332 END DO … … 420 379 421 380 ! Lateral boundary conditions 422 CALL lbc_lnk( fmask , 'F', 1. ) 423 CALL lbc_lnk( bdytmask(:,:), 'T', 1. ) 424 CALL lbc_lnk( bdyumask(:,:), 'U', 1. ) 425 CALL lbc_lnk( bdyvmask(:,:), 'V', 1. ) 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. ) 426 383 427 384 IF( ln_bdy_vol .OR. ln_bdy_dyn_fla ) THEN ! Indices and directions of rim velocity components … … 473 430 ! Compute total lateral surface for volume correction: 474 431 ! ---------------------------------------------------- 475 476 432 bdysurftot = 0.e0 477 433 IF( ln_bdy_vol ) THEN … … 491 447 & * tmask_i(nbi(ib,igrd),nbj(ib,igrd)+1) 492 448 END DO 493 449 ! 494 450 IF( lk_mpp ) CALL mpp_sum( bdysurftot ) ! sum over the global domain 495 451 END IF
Note: See TracChangeset
for help on using the changeset viewer.
