Changeset 473 for trunk/NEMO/OPA_SRC/OBC
- Timestamp:
- 2006-05-11T17:04:37+02:00 (18 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/OBC/obcdta.F90 (modified) (25 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/OBC/obcdta.F90
r465 r473 26 26 USE lib_mpp ! distributed memory computing 27 27 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 28 USE ioipsl 28 USE iom 29 # if defined key_dynspg_rl 29 30 USE obccli ! climatological obc, use only in rigid-lid case 31 # endif 30 32 31 33 IMPLICIT NONE … … 41 43 ntobc1, & ! first record used 42 44 ntobc2, & ! second record used 43 itobc ! number of time steps in OBC files44 45 REAL(wp), DIMENSION(:), ALLOCATABLE :: ztcobc ! time_counter variable of BCs45 ntobc ! number of time steps in OBC files 46 47 REAL(wp), DIMENSION(:), ALLOCATABLE :: tcobc ! time_counter variable of BCs 46 48 47 49 !! * Substitutions … … 72 74 !! attribute of variable time_counter). 73 75 !! 76 !! History : 77 !! ! 98-05 (J.M. Molines) Original code 78 !! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90 79 !! 9.0 ! 04-06 (F. Durand, A-M. Treguier) Netcdf BC files on input 74 80 !!-------------------------------------------------------------------- 75 81 !! * Arguments … … 83 89 !! * Ajouts FD 84 90 INTEGER :: isrel ! number of seconds since 1/1/1992 85 INTEGER, SAVE :: itobce, itobcw, & ! number of time steps in OBC files 86 itobcs, itobcn ! " " " " 87 INTEGER :: ikprint ! frequency for printouts. 88 INTEGER :: fid_e, fid_w, fid_n, fid_s ! file identifiers 89 LOGICAL :: l_exv 90 INTEGER, DIMENSION(flio_max_dims) :: f_d ! dimensions lenght 91 92 CHARACTER(LEN=25) :: v_name 91 INTEGER, DIMENSION(1) :: itobce, itobcw, & ! number of time steps in OBC files 92 itobcs, itobcn ! " " " " 93 INTEGER :: istop 94 INTEGER :: iprint ! frequency for printouts. 95 INTEGER :: id_e, id_w, id_n, id_s ! file identifiers 96 LOGICAL :: llnot_done 97 CHARACTER(LEN=25) :: cl_vname 93 98 !!-------------------------------------------------------------------- 94 99 95 100 IF( lk_dynspg_rl ) THEN 96 CALL obc_dta_psi( kt ) ! update bsf data at open boundaries 97 IF( nobc_dta == 1 .AND. kt == nit000 ) THEN 98 IF(lwp) WRITE(numout,*) ' time-variable psi boundary data not allowed yet' 99 STOP 100 ENDIF 101 CALL obc_dta_psi (kt) ! update bsf data at open boundaries 102 IF ( nobc_dta == 1 .AND. kt == nit000 ) CALL ctl_stop( 'obcdta : time-variable psi boundary data not allowed yet' ) 101 103 ENDIF 102 103 CALL ipslnlf( new_number=numout ) 104 104 105 105 ! 1. First call: check time frames available in files. 106 106 ! ------------------------------------------------------- 107 107 108 IF ( kt == nit000 )THEN108 IF ( kt == nit000 ) THEN 109 109 110 110 nlecto = 0 111 111 112 IF (lwp) WRITE(numout,*)113 IF (lwp) WRITE(numout,*) 'obc_dta : find boundary data'114 IF (lwp) WRITE(numout,*) '~~~~~~~'112 IF (lwp) WRITE(numout,*) 113 IF (lwp) WRITE(numout,*) 'obc_dta : find boundary data' 114 IF (lwp) WRITE(numout,*) '~~~~~~~' 115 115 116 IF ( nobc_dta == 0 )THEN116 IF ( nobc_dta == 0 ) THEN 117 117 IF(lwp) WRITE(numout,*) ' OBC data taken from initial conditions.' 118 118 ntobc1 = 1 119 119 ntobc2 = 1 120 120 ELSE 121 IF (lwp) WRITE(numout,*) ' OBC data taken from netcdf files.'122 IF (lwp) WRITE(numout,*) ' climatology (T/F):',ln_obc_clim121 IF (lwp) WRITE(numout,*) ' OBC data taken from netcdf files.' 122 IF (lwp) WRITE(numout,*) ' climatology (T/F):',ln_obc_clim 123 123 ! check the number of time steps in the files. 124 itobce =0 ; itobcw = 0; itobcn = 0; itobcs = 0 125 v_name = 'time_counter' 126 IF( lp_obc_east ) THEN 127 CALL flioopfd ('obceast_TS.nc',fid_e) 128 CALL flioinqv (fid_e,TRIM(v_name),l_exv,len_dims=f_d) 129 IF( l_exv ) THEN 130 itobce = f_d(1) 131 ELSE 132 WRITE(numout,*) ' Variable ',TRIM(v_name),' not found in file ','obceast_TS.nc' 124 cl_vname = 'time_counter' 125 IF ( lp_obc_east ) THEN 126 CALL iom_open ( 'obceast_TS.nc' , id_e ) 127 idvar = iom_varid( id_e, cl_vname, kdimsz = itobce ) 128 ENDIF 129 IF ( lp_obc_west ) THEN 130 CALL iom_open ( 'obcwest_TS.nc' , id_w ) 131 idvar = iom_varid( id_w, cl_vname, kdimsz = itobcw ) 132 ENDIF 133 IF ( lp_obc_north ) THEN 134 CALL iom_open ( 'obcnorth_TS.nc', id_n ) 135 idvar = iom_varid( id_n, cl_vname, kdimsz = itobcn ) 136 ENDIF 137 IF ( lp_obc_south ) THEN 138 CALL iom_open ( 'obcsouth_TS.nc', id_s ) 139 idvar = iom_varid( id_s, cl_vname, kdimsz = itobcs ) 140 ENDIF 141 142 ntobc = MAX(itobce(1),itobcw(1),itobcn(1),itobcs(1)) 143 istop = 0 144 IF ( lp_obc_east .AND. itobce(1) /= ntobc ) istop = 1 145 IF ( lp_obc_west .AND. itobcw(1) /= ntobc ) istop = 1 146 IF ( lp_obc_north .AND. itobcn(1) /= ntobc ) istop = 1 147 IF ( lp_obc_south .AND. itobcs(1) /= ntobc ) istop = 1 148 IF ( istop /= 0 ) THEN 149 WRITE(ctmp1,*) ' east, west, north, south: ', itobce(1), itobcw(1), itobcn(1), itobcs(1) 150 CALL ctl_stop( 'obcdta : all files must have the same number of time steps', ctmp1 ) 151 ENDIF 152 IF ( ntobc == 1 ) THEN 153 IF ( lwp ) WRITE(numout,*) ' obcdta found one time step only in the OBC files' 154 ELSE 155 ALLOCATE (tcobc(ntobc)) 156 llnot_done = .TRUE. 157 IF ( lp_obc_east ) THEN 158 IF ( llnot_done ) THEN 159 CALL iom_gettime ( id_e, TRIM(cl_vname), tcobc ) 160 llnot_done = .FALSE. 161 ENDIF 162 CALL iom_close (id_e) 133 163 ENDIF 134 ENDIF 135 IF( lp_obc_west ) THEN 136 CALL flioopfd ('obcwest_TS.nc',fid_w) 137 CALL flioinqv (fid_w,TRIM(v_name),l_exv,len_dims=f_d) 138 IF( l_exv ) THEN 139 itobcw = f_d(1) 140 ELSE 141 WRITE(numout,*) ' Variable ',TRIM(v_name),' not found in file ','obcwest_TS.nc' 164 IF ( lp_obc_west ) THEN 165 IF ( llnot_done ) THEN 166 CALL iom_gettime ( id_w, TRIM(cl_vname), tcobc ) 167 llnot_done = .FALSE. 168 ENDIF 169 CALL iom_close (id_w) 142 170 ENDIF 143 ENDIF 144 IF( lp_obc_north ) THEN 145 CALL flioopfd ('obcnorth_TS.nc',fid_n) 146 CALL flioinqv (fid_n,TRIM(v_name),l_exv,len_dims=f_d) 147 IF( l_exv ) THEN 148 itobcn = f_d(1) 149 ELSE 150 WRITE(numout,*) ' Variable ',TRIM(v_name),' not found in file ','obcnorth_TS.nc' 171 IF ( lp_obc_north ) THEN 172 IF ( llnot_done ) THEN 173 CALL iom_gettime ( id_n, TRIM(cl_vname), tcobc ) 174 llnot_done = .FALSE. 175 ENDIF 176 CALL iom_close (id_n) 151 177 ENDIF 152 ENDIF 153 IF( lp_obc_south ) THEN 154 CALL flioopfd ('obcsouth_TS.nc',fid_s) 155 CALL flioinqv (fid_s,TRIM(v_name),l_exv,len_dims=f_d) 156 IF( l_exv ) THEN 157 itobcs = f_d(1) 158 ELSE 159 WRITE(numout,*) ' Variable ',TRIM(v_name),' not found in file ','obcsouth_TS.nc' 178 IF ( lp_obc_south ) THEN 179 IF ( llnot_done ) THEN 180 CALL iom_gettime ( id_s, TRIM(cl_vname), tcobc ) 181 llnot_done = .FALSE. 182 ENDIF 183 CALL iom_close (id_s) 160 184 ENDIF 161 ENDIF 162 163 itobc = MAX(itobce,itobcw,itobcn,itobcs) 164 nstop = 0 165 IF( lp_obc_east .AND. itobce /= itobc ) nstop = nstop+1 166 IF( lp_obc_west .AND. itobcw /= itobc ) nstop = nstop+1 167 IF( lp_obc_north .AND. itobcn /= itobc ) nstop = nstop+1 168 IF( lp_obc_south .AND. itobcs /= itobc ) nstop = nstop+1 169 IF( nstop /= 0 ) THEN 170 IF( lwp ) THEN 171 WRITE(numout,*) ' obcdta : all files must have the same number of time steps' 172 WRITE(numout,*) ' east, west, north, south: ', itobce, itobcw, itobcn, itobcs 173 ENDIF 174 STOP 175 ENDIF 176 IF( itobc == 1 ) THEN 177 IF( lwp ) WRITE(numout,*) ' obcdta found one time step only in the OBC files' 178 ELSE 179 ALLOCATE (ztcobc(itobc)) 180 l_exv = .TRUE. 181 IF( lp_obc_east ) THEN 182 IF( l_exv ) THEN 183 CALL fliogetv (fid_e,TRIM(v_name),ztcobc) 184 l_exv = .FALSE. 185 ENDIF 186 CALL flioclo (fid_e) 187 ENDIF 188 IF( lp_obc_west ) THEN 189 IF( l_exv ) THEN 190 CALL fliogetv (fid_w,TRIM(v_name),ztcobc) 191 l_exv = .FALSE. 192 ENDIF 193 CALL flioclo (fid_w) 194 ENDIF 195 IF( lp_obc_north ) THEN 196 IF( l_exv ) THEN 197 CALL fliogetv (fid_n,TRIM(v_name),ztcobc) 198 l_exv = .FALSE. 199 ENDIF 200 CALL flioclo (fid_n) 201 ENDIF 202 IF( lp_obc_south ) THEN 203 IF( l_exv ) THEN 204 CALL fliogetv (fid_s,TRIM(v_name),ztcobc) 205 l_exv = .FALSE. 206 ENDIF 207 CALL flioclo (fid_s) 208 ENDIF 209 IF( lwp ) WRITE(numout,*) ' obcdta found', itobc,' time steps in the OBC files' 210 IF( .NOT. ln_obc_clim .AND. itobc == 12 ) THEN 185 IF ( lwp ) WRITE(numout,*) ' obcdta found', ntobc,' time steps in the OBC files' 186 IF ( .NOT. ln_obc_clim .AND. ntobc == 12 ) THEN 211 187 IF ( lwp ) WRITE(numout,*) ' WARNING: With monthly data we assume climatology' 212 188 ln_obc_clim = .true. … … 332 308 zxy = 0 333 309 ELSE 334 IF( itobc == 1 ) THEN310 IF( ntobc == 1 ) THEN 335 311 itimo = 1 336 ELSE IF( itobc == 12 ) THEN ! BC are monthly312 ELSE IF( ntobc == 12 ) THEN ! BC are monthly 337 313 ! we assume we have climatology in that case 338 314 iman = 12 … … 342 318 itimo = imois 343 319 ELSE 344 IF(lwp) WRITE(numout,*) 'data other than constant or monthly', kt345 iman = itobc346 itimo = FLOOR( kt*rdt / ( ztcobc(2)-ztcobc(1)) )320 IF(lwp) WRITE(numout,*) 'data other than constant or monthly', kt 321 iman = ntobc 322 itimo = FLOOR( kt*rdt / (tcobc(2)-tcobc(1)) ) 347 323 isrel = kt*rdt 348 324 ENDIF … … 355 331 356 332 ! Calendar computation 357 IF( itobc == 1 ) THEN ! BC are constant in time333 IF( ntobc == 1 ) THEN ! BC are constant in time 358 334 ntobc1 = 1 359 335 ntobc2 = 1 360 ELSE IF( itobc == 12 ) THEN ! BC are monthly336 ELSE IF( ntobc == 12 ) THEN ! BC are monthly 361 337 ntobc1 = itimo ! first file record used 362 338 ntobc2 = ntobc1 + 1 ! last file record used … … 386 362 ! ... Read datafile and set temperature, salinity and normal velocity 387 363 ! ... initialise the sedta, tedta, uedta arrays 388 CALL flioopfd ('obceast_TS.nc',fid_e)389 CALL obc_dta_gv (fid_e,'y','vosaline',jpjef-jpjed+1,ntobc1,pdta_3D=sedta(:,:,1))390 CALL obc_dta_gv (fid_e,'y','vosaline',jpjef-jpjed+1,ntobc2,pdta_3D=sedta(:,:,2))391 CALL obc_dta_gv (fid_e,'y','votemper',jpjef-jpjed+1,ntobc1,pdta_3D=tedta(:,:,1))392 CALL obc_dta_gv (fid_e,'y','votemper',jpjef-jpjed+1,ntobc2,pdta_3D=tedta(:,:,2))393 CALL flioclo (fid_e)394 395 CALL flioopfd ('obceast_U.nc',fid_e)396 CALL obc_dta_gv (fid_e,'y','vozocrtx',jpjef-jpjed+1,ntobc1,pdta_3D=uedta(:,:,1))397 CALL obc_dta_gv (fid_e,'y','vozocrtx',jpjef-jpjed+1,ntobc2,pdta_3D=uedta(:,:,2))398 CALL flioclo (fid_e)364 CALL iom_open ( 'obceast_TS.nc' , id_e ) 365 CALL iom_get ( id_e, jpdom_unknown, 'votemper', tedta(:,:,1), ktime=ntobc1 ) 366 CALL iom_get ( id_e, jpdom_unknown, 'votemper', tedta(:,:,2), ktime=ntobc2 ) 367 CALL iom_get ( id_e, jpdom_unknown, 'vosaline', sedta(:,:,1), ktime=ntobc1 ) 368 CALL iom_get ( id_e, jpdom_unknown, 'vosaline', sedta(:,:,2), ktime=ntobc2 ) 369 CALL iom_close (id_e) 370 ! 371 CALL iom_open ( 'obceast_U.nc' , id_e ) 372 CALL iom_get ( id_e, jpdom_unknown, 'vozocrtx', uedta(:,:,1), ktime=ntobc1 ) 373 CALL iom_get ( id_e, jpdom_unknown, 'vozocrtx', uedta(:,:,2), ktime=ntobc2 ) 374 CALL iom_close ( id_e ) 399 375 ! Usually printout is done only once at kt = nit000, 400 376 ! unless nprint (namelist) > 1 … … 402 378 WRITE(numout,*) 403 379 WRITE(numout,*) ' Read East OBC data records ', ntobc1, ntobc2 404 i kprint = (jpjef-jpjed+1)/20 +1380 iprint = (jpjef-jpjed+1)/20 +1 405 381 WRITE(numout,*) ' Temperature record 1 - printout every 3 level' 406 CALL prihre( tedta(:,:,1),jpjef-jpjed+1,jpk,1,jpjef-jpjed+1,i kprint, &382 CALL prihre( tedta(:,:,1),jpjef-jpjed+1,jpk,1,jpjef-jpjed+1,iprint, & 407 383 & jpk, 1, -3, 1., numout ) 408 384 WRITE(numout,*) 409 385 WRITE(numout,*) ' Salinity record 1 - printout every 3 level' 410 CALL prihre( sedta(:,:,1), jpjef-jpjed+1, jpk, 1, jpjef-jpjed+1, i kprint, &386 CALL prihre( sedta(:,:,1), jpjef-jpjed+1, jpk, 1, jpjef-jpjed+1, iprint, & 411 387 & jpk, 1, -3, 1., numout ) 412 388 WRITE(numout,*) 413 389 WRITE(numout,*) ' Normal velocity U record 1 - printout every 3 level' 414 CALL prihre( uedta(:,:,1), jpjef-jpjed+1, jpk, 1, jpjef-jpjed+1, i kprint, &390 CALL prihre( uedta(:,:,1), jpjef-jpjed+1, jpk, 1, jpjef-jpjed+1, iprint, & 415 391 & jpk, 1, -3, 1., numout ) 416 392 ENDIF … … 420 396 ! ... Read datafile and set temperature, salinity and normal velocity 421 397 ! ... initialise the swdta, twdta, uwdta arrays 422 CALL flioopfd ('obcwest_TS.nc',fid_w)423 CALL obc_dta_gv (fid_w,'y','vosaline',jpjwf-jpjwd+1,ntobc1,pdta_3D=swdta(:,:,1))424 CALL obc_dta_gv (fid_w,'y','vosaline',jpjwf-jpjwd+1,ntobc2,pdta_3D=swdta(:,:,2))425 CALL obc_dta_gv (fid_w,'y','votemper',jpjwf-jpjwd+1,ntobc1,pdta_3D=twdta(:,:,1))426 CALL obc_dta_gv (fid_w,'y','votemper',jpjwf-jpjwd+1,ntobc2,pdta_3D=twdta(:,:,2))427 CALL flioclo (fid_w)428 429 CALL flioopfd ('obcwest_U.nc',fid_w)430 CALL obc_dta_gv (fid_w,'y','vozocrtx',jpjwf-jpjwd+1,ntobc1,pdta_3D=uwdta(:,:,1))431 CALL obc_dta_gv (fid_w,'y','vozocrtx',jpjwf-jpjwd+1,ntobc2,pdta_3D=uwdta(:,:,2))432 CALL flioclo (fid_w)433 398 CALL iom_open ( 'obcwest_TS.nc' , id_w ) 399 CALL iom_get ( id_w, jpdom_unknown, 'votemper', twdta(:,:,1), ktime=ntobc1 ) 400 CALL iom_get ( id_w, jpdom_unknown, 'votemper', twdta(:,:,2), ktime=ntobc2 ) 401 CALL iom_get ( id_w, jpdom_unknown, 'vosaline', swdta(:,:,1), ktime=ntobc1 ) 402 CALL iom_get ( id_w, jpdom_unknown, 'vosaline', swdta(:,:,2), ktime=ntobc2 ) 403 CALL iom_close (id_w) 404 ! 405 CALL iom_open ( 'obcwest_U.nc' , id_w ) 406 CALL iom_get ( id_w, jpdom_unknown, 'vozocrtx', uwdta(:,:,1), ktime=ntobc1 ) 407 CALL iom_get ( id_w, jpdom_unknown, 'vozocrtx', uwdta(:,:,2), ktime=ntobc2 ) 408 CALL iom_close ( id_w ) 409 ! 434 410 IF( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN 435 411 WRITE(numout,*) 436 412 WRITE(numout,*) ' Read West OBC data records ', ntobc1, ntobc2 437 i kprint = (jpjwf-jpjwd+1)/20 +1413 iprint = (jpjwf-jpjwd+1)/20 +1 438 414 WRITE(numout,*) ' Temperature record 1 - printout every 3 level' 439 CALL prihre( twdta(:,:,1), jpjwf-jpjwd+1, jpk, 1, jpjwf-jpjwd+1, i kprint, &415 CALL prihre( twdta(:,:,1), jpjwf-jpjwd+1, jpk, 1, jpjwf-jpjwd+1, iprint, & 440 416 & jpk, 1, -3, 1., numout ) 441 417 WRITE(numout,*) 442 418 WRITE(numout,*) ' Salinity record 1 - printout every 3 level' 443 CALL prihre( swdta(:,:,1), jpjwf-jpjwd+1, jpk, 1, jpjwf-jpjwd+1, i kprint, &419 CALL prihre( swdta(:,:,1), jpjwf-jpjwd+1, jpk, 1, jpjwf-jpjwd+1, iprint, & 444 420 & jpk, 1, -3, 1., numout ) 445 421 WRITE(numout,*) 446 422 WRITE(numout,*) ' Normal velocity U record 1 - printout every 3 level' 447 CALL prihre( uwdta(:,:,1), jpjwf-jpjwd+1, jpk, 1, jpjwf-jpjwd+1, i kprint, &423 CALL prihre( uwdta(:,:,1), jpjwf-jpjwd+1, jpk, 1, jpjwf-jpjwd+1, iprint, & 448 424 & jpk, 1, -3, 1., numout ) 449 425 ENDIF … … 451 427 452 428 IF( lp_obc_north ) THEN 453 CALL flioopfd ('obcnorth_TS.nc',fid_n)454 CALL obc_dta_gv (fid_n,'x','vosaline',jpinf-jpind+1,ntobc1,pdta_3D=sndta(:,:,1))455 CALL obc_dta_gv (fid_n,'x','vosaline',jpinf-jpind+1,ntobc2,pdta_3D=sndta(:,:,2))456 CALL obc_dta_gv (fid_n,'x','votemper',jpinf-jpind+1,ntobc1,pdta_3D=tndta(:,:,1))457 CALL obc_dta_gv (fid_n,'x','votemper',jpinf-jpind+1,ntobc2,pdta_3D=tndta(:,:,2))458 CALL flioclo (fid_n)459 460 CALL flioopfd ('obcnorth_V.nc',fid_n)461 CALL obc_dta_gv (fid_n,'x','vomecrty',jpinf-jpind+1,ntobc1,pdta_3D=vndta(:,:,1))462 CALL obc_dta_gv (fid_n,'x','vomecrty',jpinf-jpind+1,ntobc2,pdta_3D=vndta(:,:,2))463 CALL flioclo (fid_n)464 429 CALL iom_open ( 'obcnorth_TS.nc', id_n ) 430 CALL iom_get ( id_n, jpdom_unknown, 'votemper', tndta(:,:,1), ktime=ntobc1 ) 431 CALL iom_get ( id_n, jpdom_unknown, 'votemper', tndta(:,:,2), ktime=ntobc2 ) 432 CALL iom_get ( id_n, jpdom_unknown, 'vosaline', sndta(:,:,1), ktime=ntobc1 ) 433 CALL iom_get ( id_n, jpdom_unknown, 'vosaline', sndta(:,:,2), ktime=ntobc2 ) 434 CALL iom_close ( id_n ) 435 ! 436 CALL iom_open ( 'obcnorth_V.nc', id_n ) 437 CALL iom_get ( id_n, jpdom_unknown, 'vomecrty', vndta(:,:,1), ktime=ntobc1 ) 438 CALL iom_get ( id_n, jpdom_unknown ,'vomecrty', vndta(:,:,2), ktime=ntobc2 ) 439 CALL iom_close ( id_n ) 440 ! 465 441 IF( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN 466 442 WRITE(numout,*) 467 443 WRITE(numout,*) ' Read North OBC data records ', ntobc1, ntobc2 468 i kprint = (jpinf-jpind+1)/20 +1444 iprint = (jpinf-jpind+1)/20 +1 469 445 WRITE(numout,*) ' Temperature record 1 - printout every 3 level' 470 CALL prihre( tndta(:,:,1), jpinf-jpind+1, jpk, 1, jpinf-jpind+1, i kprint, &446 CALL prihre( tndta(:,:,1), jpinf-jpind+1, jpk, 1, jpinf-jpind+1, iprint, & 471 447 & jpk, 1, -3, 1., numout ) 472 448 WRITE(numout,*) 473 449 WRITE(numout,*) ' Salinity record 1 - printout every 3 level' 474 CALL prihre( sndta(:,:,1), jpinf-jpind+1, jpk, 1, jpinf-jpind+1, i kprint, &450 CALL prihre( sndta(:,:,1), jpinf-jpind+1, jpk, 1, jpinf-jpind+1, iprint, & 475 451 & jpk, 1, -3, 1., numout ) 476 452 WRITE(numout,*) 477 453 WRITE(numout,*) ' Normal velocity V record 1 - printout every 3 level' 478 CALL prihre( vndta(:,:,1), jpinf-jpind+1, jpk, 1, jpinf-jpind+1, i kprint, &454 CALL prihre( vndta(:,:,1), jpinf-jpind+1, jpk, 1, jpinf-jpind+1, iprint, & 479 455 & jpk, 1, -3, 1., numout ) 480 456 ENDIF … … 482 458 483 459 IF( lp_obc_south ) THEN 484 CALL flioopfd ('obcsouth_TS.nc',fid_s)485 CALL obc_dta_gv (fid_s,'x','vosaline',jpisf-jpisd+1,ntobc1,pdta_3D=ssdta(:,:,1))486 CALL obc_dta_gv (fid_s,'x','vosaline',jpisf-jpisd+1,ntobc2,pdta_3D=ssdta(:,:,2))487 CALL obc_dta_gv (fid_s,'x','votemper',jpisf-jpisd+1,ntobc1,pdta_3D=tsdta(:,:,1))488 CALL obc_dta_gv (fid_s,'x','votemper',jpisf-jpisd+1,ntobc2,pdta_3D=tsdta(:,:,2))489 CALL flioclo (fid_s)490 491 CALL flioopfd ('obcsouth_V.nc',fid_s)492 CALL obc_dta_gv (fid_s,'x','vomecrty',jpisf-jpisd+1,ntobc1,pdta_3D=vsdta(:,:,1))493 CALL obc_dta_gv (fid_s,'x','vomecrty',jpisf-jpisd+1,ntobc2,pdta_3D=vsdta(:,:,2))494 CALL flioclo (fid_s)495 460 CALL iom_open ( 'obcsouth_TS.nc', id_s ) 461 CALL iom_get ( id_s, jpdom_unknown, 'votemper', tsdta(:,:,1), ktime=ntobc1 ) 462 CALL iom_get ( id_s, jpdom_unknown, 'votemper', tsdta(:,:,2), ktime=ntobc2 ) 463 CALL iom_get ( id_s, jpdom_unknown, 'vosaline', ssdta(:,:,1), ktime=ntobc1 ) 464 CALL iom_get ( id_s, jpdom_unknown, 'vosaline', ssdta(:,:,2), ktime=ntobc2 ) 465 CALL iom_close ( id_s ) 466 ! 467 CALL iom_open ( 'obcsouth_V.nc', id_s ) 468 CALL iom_get ( id_s, jpdom_unknown, 'vomecrty', vsdta(:,:,1), ktime=ntobc1 ) 469 CALL iom_get ( id_s, jpdom_unknown ,'vomecrty', vsdta(:,:,2), ktime=ntobc2 ) 470 CALL iom_close ( id_s ) 471 ! 496 472 IF( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN 497 473 WRITE(numout,*) 498 474 WRITE(numout,*) ' Read South OBC data records ', ntobc1, ntobc2 499 i kprint = (jpisf-jpisd+1)/20 +1475 iprint = (jpisf-jpisd+1)/20 +1 500 476 WRITE(numout,*) ' Temperature record 1 - printout every 3 level' 501 CALL prihre( tsdta(:,:,1), jpisf-jpisd+1, jpk, 1, jpisf-jpisd+1, i kprint, &477 CALL prihre( tsdta(:,:,1), jpisf-jpisd+1, jpk, 1, jpisf-jpisd+1, iprint, & 502 478 & jpk, 1, -3, 1., numout ) 503 479 WRITE(numout,*) 504 480 WRITE(numout,*) ' Salinity record 1 - printout every 3 level' 505 CALL prihre( ssdta(:,:,1), jpisf-jpisd+1, jpk, 1, jpisf-jpisd+1, i kprint, &481 CALL prihre( ssdta(:,:,1), jpisf-jpisd+1, jpk, 1, jpisf-jpisd+1, iprint, & 506 482 & jpk, 1, -3, 1., numout ) 507 483 WRITE(numout,*) 508 484 WRITE(numout,*) ' Normal velocity V record 1 - printout every 3 level' 509 CALL prihre( vsdta(:,:,1), jpisf-jpisd+1, jpk, 1, jpisf-jpisd+1, i kprint, &485 CALL prihre( vsdta(:,:,1), jpisf-jpisd+1, jpk, 1, jpisf-jpisd+1, iprint, & 510 486 & jpk, 1, -3, 1., numout ) 511 487 ENDIF … … 522 498 ! ---------------------------------------------------- 523 499 524 IF( itobc == 1 .OR. nobc_dta == 0 ) THEN500 IF( ntobc == 1 .OR. nobc_dta == 0 ) THEN 525 501 zxy = 0. 526 ELSE IF( itobc == 12 ) THEN502 ELSE IF( ntobc == 12 ) THEN 527 503 zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 528 504 ELSE 529 zxy = ( ztcobc(ntobc1)-FLOAT(isrel))/(ztcobc(ntobc1)-ztcobc(ntobc2))505 zxy = (tcobc(ntobc1)-FLOAT(isrel))/(tcobc(ntobc1)-tcobc(ntobc2)) 530 506 ENDIF 531 507 … … 793 769 !! * Local declarations 794 770 INTEGER :: ji, jj, jk, ii, ij ! dummy loop indices 795 INTEGER :: fid_e, fid_w, fid_n, fid_s, fid ! file identifiers771 INTEGER :: id_e, id_w, id_n, id_s, fid ! file identifiers 796 772 INTEGER :: itimo, iman, imois, i15 797 INTEGER :: ntobcm, ntobcp, itimom, itimop773 INTEGER :: itobcm, itobcp, itimom, itimop 798 774 REAL(wp) :: zxy 799 775 INTEGER :: isrel, ikt ! number of seconds since 1/1/1992 800 INTEGER :: i kprint ! frequency for printouts.776 INTEGER :: iprint ! frequency for printouts. 801 777 802 778 !!--------------------------------------------------------------------------- … … 909 885 zxy = 0 910 886 ELSE 911 IF( itobc == 1) THEN887 IF(ntobc == 1) THEN 912 888 itimo = 1 913 ELSE IF ( itobc == 12) THEN ! BC are monthly889 ELSE IF (ntobc == 12) THEN ! BC are monthly 914 890 ! we assume we have climatology in that case 915 891 iman = 12 … … 920 896 ELSE 921 897 IF(lwp) WRITE(numout,*) 'data other than constant or monthly',kt 922 iman = itobc923 itimo = FLOOR( kt*rdt / ztcobc(1))898 iman = ntobc 899 itimo = FLOOR( kt*rdt / tcobc(1)) 924 900 isrel=kt*rdt 925 901 ENDIF … … 936 912 sshedta(:,0) = sshedta(:,1) 937 913 ubtedta(:,0) = ubtedta(:,1) 938 CALL flioopfd ('obceast_TS.nc',fid_e)939 CALL obc_dta_gv (fid_e,'y','vossurfh',jpjef-jpjed+1,ntobc1,pdta_2D=sshedta(:,1))940 CALL obc_dta_gv (fid_e,'y','vossurfh',jpjef-jpjed+1,ntobc2,pdta_2D=sshedta(:,2))914 CALL iom_open ( 'obceast_TS.nc', id_e ) 915 CALL iom_get ( id_e, jpdom_unknown, 'vossurfh', sshedta(:,1), ktime=ntobc1 ) 916 CALL iom_get ( id_e, jpdom_unknown, 'vossurfh', sshedta(:,2), ktime=ntobc2 ) 941 917 IF( lk_dynspg_ts ) THEN 942 CALL obc_dta_gv (fid_e,'y','vossurfh',jpjef-jpjed+1,ntobc2+1,pdta_2D=sshedta(:,3))943 ENDIF 944 CALL flioclo (fid_e)945 946 CALL flioopfd ('obceast_U.nc',fid_e)947 CALL obc_dta_gv (fid_e,'y','vozoubt',jpjef-jpjed+1,ntobc1,pdta_2D=ubtedta(:,1))948 CALL obc_dta_gv (fid_e,'y','vozoubt',jpjef-jpjed+1,ntobc2,pdta_2D=ubtedta(:,2))918 CALL iom_get (id_e, jpdom_unknown, 'vossurfh', sshedta(:,3), ktime=ntobc2+1 ) 919 ENDIF 920 CALL iom_close ( id_e ) 921 ! 922 CALL iom_open ( 'obceast_U.nc', id_e ) 923 CALL iom_get ( id_e, jpdom_unknown, 'vozoubt', ubtedta(:,1), ktime=ntobc1 ) 924 CALL iom_get ( id_e, jpdom_unknown, 'vozoubt', ubtedta(:,2), ktime=ntobc2 ) 949 925 IF( lk_dynspg_ts ) THEN 950 CALL obc_dta_gv (fid_e,'y','vozoubt',jpjef-jpjed+1,ntobc2+1,pdta_2D=ubtedta(:,3)) 951 ENDIF 952 CALL flioclo (fid_e) 953 926 CALL iom_get ( id_e, jpdom_unknown, 'vozoubt', ubtedta(:,3), ktime=ntobc2+1 ) 927 ENDIF 928 CALL iom_close ( id_e ) 954 929 ! ... Usually printout is done only once at kt = nit000, unless nprint (namelist) > 1 955 930 IF( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN 956 931 WRITE(numout,*) 957 932 WRITE(numout,*) ' Read East OBC barotropic data records ', ntobc1, ntobc2 958 i kprint = (jpjef-jpjed+1)/20 +1933 iprint = (jpjef-jpjed+1)/20 +1 959 934 WRITE(numout,*) 960 935 WRITE(numout,*) ' Sea surface height record 1' 961 CALL prihre( sshedta(:,1), jpjef-jpjed+1, 1, 1, jpjef-jpjed+1, i kprint, 1, 1, -3, 1., numout )962 WRITE(numout,*) 963 WRITE(numout,*) ' Normal transport (m2/s) record 1',i kprint964 CALL prihre( ubtedta(:,1), jpjef-jpjed+1, 1, 1, jpjef-jpjed+1, i kprint, 1, 1, -3, 1., numout )936 CALL prihre( sshedta(:,1), jpjef-jpjed+1, 1, 1, jpjef-jpjed+1, iprint, 1, 1, -3, 1., numout ) 937 WRITE(numout,*) 938 WRITE(numout,*) ' Normal transport (m2/s) record 1',iprint 939 CALL prihre( ubtedta(:,1), jpjef-jpjed+1, 1, 1, jpjef-jpjed+1, iprint, 1, 1, -3, 1., numout ) 965 940 ENDIF 966 941 ENDIF … … 971 946 sshwdta(:,0) = sshwdta(:,1) 972 947 ubtwdta(:,0) = ubtwdta(:,1) 973 CALL flioopfd ('obcwest_TS.nc',fid_w)974 CALL obc_dta_gv (fid_w,'y','vossurfh',jpjwf-jpjwd+1,ntobc1,pdta_2D=sshwdta(:,1))975 CALL obc_dta_gv (fid_w,'y','vossurfh',jpjwf-jpjwd+1,ntobc2,pdta_2D=sshwdta(:,2))948 CALL iom_open ( 'obcwest_TS.nc', id_w ) 949 CALL iom_get ( id_w, jpdom_unknown, 'vossurfh', sshwdta(:,1), ktime=ntobc1 ) 950 CALL iom_get ( id_w, jpdom_unknown, 'vossurfh', sshwdta(:,2), ktime=ntobc2 ) 976 951 IF( lk_dynspg_ts ) THEN 977 CALL obc_dta_gv (fid_w,'y','vossurfh',jpjwf-jpjwd+1,ntobc2+1,pdta_2D=sshwdta(:,3))978 ENDIF 979 CALL flioclo (fid_w)980 981 CALL flioopfd ('obcwest_U.nc',fid_w)982 CALL obc_dta_gv (fid_w,'y','vozoubt',jpjwf-jpjwd+1,ntobc1,pdta_2D=ubtwdta(:,1))983 CALL obc_dta_gv (fid_w,'y','vozoubt',jpjwf-jpjwd+1,ntobc2,pdta_2D=ubtwdta(:,2))952 CALL ( id_w, jpdom_unknown, 'vossurfh', sshwdta(:,3), ktime=ntobc2+1 ) 953 ENDIF 954 CALL iom_close ( id_w ) 955 ! 956 CALL iom_open ( 'obcwest_U.nc', id_w ) 957 CALL iom_get ( id_w, jpdom_unknown, 'vozoubt', ubtwdta(:,1), ktime=ntobc1 ) 958 CALL iom_get ( id_w, jpdom_unknown, 'vozoubt', ubtwdta(:,2), ktime=ntobc2 ) 984 959 IF( lk_dynspg_ts ) THEN 985 CALL obc_dta_gv (fid_w,'y','vozoubt',jpjwf-jpjwd+1,ntobc2+1,pdta_2D=ubtwdta(:,3)) 986 ENDIF 987 CALL flioclo (fid_w) 988 960 CALL iom_get ( id_w, jpdom_unknown, 'vozoubt', ubtwdta(:,3), ktime=ntobc2+1 ) 961 ENDIF 962 CALL iom_close ( id_w ) 989 963 ! ... Usually printout is done only once at kt = nit000, unless nprint (namelist) > 1 990 964 IF( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN 991 965 WRITE(numout,*) 992 966 WRITE(numout,*) ' Read West OBC barotropic data records ', ntobc1, ntobc2 993 i kprint = (jpjwf-jpjwd+1)/20 +1967 iprint = (jpjwf-jpjwd+1)/20 +1 994 968 WRITE(numout,*) 995 969 WRITE(numout,*) ' Sea surface height record 1 - printout surface level' 996 CALL prihre( sshwdta(:,1), jpjwf-jpjwd+1, 1, 1, jpjwf-jpjwd+1, i kprint, 1, 1, -3, 1., numout )970 CALL prihre( sshwdta(:,1), jpjwf-jpjwd+1, 1, 1, jpjwf-jpjwd+1, iprint, 1, 1, -3, 1., numout ) 997 971 WRITE(numout,*) 998 972 WRITE(numout,*) ' Normal transport (m2/s) record 1' 999 CALL prihre( ubtwdta(:,1), jpjwf-jpjwd+1, 1, 1, jpjwf-jpjwd+1, i kprint, 1, 1, -3, 1., numout )973 CALL prihre( ubtwdta(:,1), jpjwf-jpjwd+1, 1, 1, jpjwf-jpjwd+1, iprint, 1, 1, -3, 1., numout ) 1000 974 ENDIF 1001 975 ENDIF … … 1006 980 sshndta(:,0) = sshndta(:,1) 1007 981 vbtndta(:,0) = vbtndta(:,1) 1008 CALL flioopfd ('obcnorth_TS.nc',fid_n)1009 CALL obc_dta_gv (fid_n,'x','vossurfh',jpinf-jpind+1,ntobc1,pdta_2D=sshndta(:,1))1010 CALL obc_dta_gv (fid_n,'x','vossurfh',jpinf-jpind+1,ntobc2,pdta_2D=sshndta(:,2))982 CALL iom_open ( 'obcnorth_TS.nc', id_n ) 983 CALL iom_get (id_n, jpdom_unknown, 'vossurfh', sshndta(:,1), ktime=ntobc1 ) 984 CALL iom_get (id_n, jpdom_unknown, 'vossurfh', sshndta(:,2), ktime=ntobc2 ) 1011 985 IF( lk_dynspg_ts ) THEN 1012 CALL obc_dta_gv (fid_n,'x','vossurfh',jpinf-jpind+1,ntobc2+1,pdta_2D=sshndta(:,3))1013 ENDIF 1014 CALL flioclo (fid_n)1015 1016 CALL flioopfd ('obcnorth_V.nc',fid_n)1017 CALL obc_dta_gv (fid_n,'x','vomevbt',jpinf-jpind+1,ntobc1,pdta_2D=vbtndta(:,1))1018 CALL obc_dta_gv (fid_n,'x','vomevbt',jpinf-jpind+1,ntobc2,pdta_2D=vbtndta(:,2))986 CALL iom_get (id_n, jpdom_unknown, 'vossurfh', sshndta(:,3), ktime=ntobc2+1 ) 987 ENDIF 988 CALL iom_close ( id_n ) 989 990 CALL iom_open ( 'obcnorth_V.nc', id_n ) 991 CALL iom_get (id_n, jpdom_unknown, 'vomevbt', vbtndta(:,1), ktime=ntobc1 ) 992 CALL iom_get (id_n, jpdom_unknown, 'vomevbt', vbtndta(:,2), ktime=ntobc2 ) 1019 993 IF( lk_dynspg_ts ) THEN 1020 CALL obc_dta_gv (fid_n,'x','vomevbt',jpinf-jpind+1,ntobc2+1,pdta_2D=vbtndta(:,3))1021 ENDIF 1022 CALL flioclo (fid_n)994 CALL iom_get (id_n, jpdom_unknown, 'vomevbt', vbtndta(:,3), ktime=ntobc2+1 ) 995 ENDIF 996 CALL iom_close ( id_n ) 1023 997 1024 998 ! ... Usually printout is done only once at kt = nit000, unless nprint (namelist) > 1 … … 1026 1000 WRITE(numout,*) 1027 1001 WRITE(numout,*) ' Read North OBC barotropic data records ', ntobc1, ntobc2 1028 i kprint = (jpinf-jpind+1)/20 +11002 iprint = (jpinf-jpind+1)/20 +1 1029 1003 WRITE(numout,*) 1030 1004 WRITE(numout,*) ' Sea surface height record 1 - printout surface level' 1031 CALL prihre( sshndta(:,1), jpinf-jpind+1, 1, 1, jpinf-jpind+1, i kprint, 1, 1, -3, 1., numout )1005 CALL prihre( sshndta(:,1), jpinf-jpind+1, 1, 1, jpinf-jpind+1, iprint, 1, 1, -3, 1., numout ) 1032 1006 WRITE(numout,*) 1033 1007 WRITE(numout,*) ' Normal transport (m2/s) record 1' 1034 CALL prihre( vbtndta(:,1), jpinf-jpind+1, 1, 1, jpinf-jpind+1, i kprint, 1, 1, -3, 1., numout )1008 CALL prihre( vbtndta(:,1), jpinf-jpind+1, 1, 1, jpinf-jpind+1, iprint, 1, 1, -3, 1., numout ) 1035 1009 ENDIF 1036 1010 ENDIF … … 1041 1015 sshsdta(:,0) = sshsdta(:,1) 1042 1016 vbtsdta(:,0) = vbtsdta(:,1) 1043 CALL flioopfd ('obcsouth_TS.nc',fid_s)1044 CALL obc_dta_gv (fid_s,'x','vossurfh',jpisf-jpisd+1,ntobc1,pdta_2D=sshsdta(:,1))1045 CALL obc_dta_gv (fid_s,'x','vossurfh',jpisf-jpisd+1,ntobc2,pdta_2D=sshsdta(:,2))1017 CALL iom_open ( 'obcsouth_TS.nc', id_s ) 1018 CALL iom_get ( id_s, jpdom_unknown, 'vossurfh', sshsdta(:,1), ktime=ntobc1 ) 1019 CALL iom_get ( id_s, jpdom_unknown, 'vossurfh', sshsdta(:,2), ktime=ntobc2 ) 1046 1020 IF( lk_dynspg_ts ) THEN 1047 CALL obc_dta_gv (fid_s,'x','vossurfh',jpisf-jpisd+1,ntobc2+1,pdta_2D=sshsdta(:,3))1048 ENDIF 1049 CALL flioclo (fid_s)1050 1051 CALL flioopfd ('obcsouth_V.nc',fid_s)1052 CALL obc_dta_gv (fid_s,'x','vomevbt',jpisf-jpisd+1,ntobc1,pdta_2D=vbtsdta(:,1))1053 CALL obc_dta_gv (fid_s,'x','vomevbt',jpisf-jpisd+1,ntobc2,pdta_2D=vbtsdta(:,2))1021 CALL iom_get ( id_s, jpdom_unknown, 'vossurfh', sshsdta(:,3), ktime=ntobc2+1 ) 1022 ENDIF 1023 CALL iom_close ( id_s ) 1024 1025 CALL iom_open ( 'obcsouth_V.nc', id_s ) 1026 CALL iom_get ( id_s, jpdom_unknown, 'vomevbt', vbtsdta(:,1), ktime=ntobc1 ) 1027 CALL iom_get ( id_s, jpdom_unknown, 'vomevbt', vbtsdta(:,2), ktime=ntobc2 ) 1054 1028 IF( lk_dynspg_ts ) THEN 1055 CALL obc_dta_gv (fid_s,'x','vomevbt',jpisf-jpisd+1,ntobc2+1,pdta_2D=vbtsdta(:,3))1056 ENDIF 1057 CALL flioclo (fid_s)1029 CALL iom_get ( id_s, jpdom_unknown, 'vomevbt', vbtsdta(:,3), ktime=ntobc2+1 ) 1030 ENDIF 1031 CALL iom_close ( id_s ) 1058 1032 1059 1033 ! ... Usually printout is done only once at kt = nit000, unless nprint (namelist) > 1 … … 1061 1035 WRITE(numout,*) 1062 1036 WRITE(numout,*) ' Read South OBC barotropic data records ', ntobc1, ntobc2 1063 i kprint = (jpisf-jpisd+1)/20 +11037 iprint = (jpisf-jpisd+1)/20 +1 1064 1038 WRITE(numout,*) 1065 1039 WRITE(numout,*) ' Sea surface height record 1 - printout surface level' 1066 CALL prihre( sshsdta(:,1), jpisf-jpisd+1, 1, 1, jpisf-jpisd+1, i kprint, 1, 1, -3, 1., numout )1040 CALL prihre( sshsdta(:,1), jpisf-jpisd+1, 1, 1, jpisf-jpisd+1, iprint, 1, 1, -3, 1., numout ) 1067 1041 WRITE(numout,*) 1068 1042 WRITE(numout,*) ' Normal transport (m2/s) record 1' 1069 CALL prihre( vbtsdta(:,1), jpisf-jpisd+1, 1, 1, jpisf-jpisd+1, i kprint, 1, 1, -3, 1., numout )1043 CALL prihre( vbtsdta(:,1), jpisf-jpisd+1, 1, 1, jpisf-jpisd+1, iprint, 1, 1, -3, 1., numout ) 1070 1044 ENDIF 1071 1045 ENDIF … … 1081 1055 IF( nobc_dta == 1 ) THEN 1082 1056 isrel = (kt-1)*rdt + kbt*rdtbt 1083 itimo = FLOOR( kt*rdt / ( ztcobc(2)-ztcobc(1)) )1084 itimom = FLOOR( (kt-1)*rdt / ( ztcobc(2)-ztcobc(1)) )1085 itimop = FLOOR( (kt+1)*rdt / ( ztcobc(2)-ztcobc(1)) )1057 itimo = FLOOR( kt*rdt / (tcobc(2)-tcobc(1)) ) 1058 itimom = FLOOR( (kt-1)*rdt / (tcobc(2)-tcobc(1)) ) 1059 itimop = FLOOR( (kt+1)*rdt / (tcobc(2)-tcobc(1)) ) 1086 1060 IF( itimom == itimo .AND. itimop == itimo ) THEN 1087 ntobcm = ntobc11088 ntobcp = ntobc21061 itobcm = ntobc1 1062 itobcp = ntobc2 1089 1063 1090 1064 ELSEIF ( itimom <= itimo .AND. itimop == itimo ) THEN 1091 IF( FLOOR( isrel / ( ztcobc(2)-ztcobc(1)) ) < itimo ) THEN1092 ntobcm = ntobc1-11093 ntobcp = ntobc2-11065 IF( FLOOR( isrel / (tcobc(2)-tcobc(1)) ) < itimo ) THEN 1066 itobcm = ntobc1-1 1067 itobcp = ntobc2-1 1094 1068 ELSE 1095 ntobcm = ntobc11096 ntobcp = ntobc21069 itobcm = ntobc1 1070 itobcp = ntobc2 1097 1071 ENDIF 1098 1072 1099 1073 ELSEIF ( itimom == itimo .AND. itimop >= itimo ) THEN 1100 IF( FLOOR( isrel / ( ztcobc(2)-ztcobc(1)) ) < itimop ) THEN1101 ntobcm = ntobc11102 ntobcp = ntobc21074 IF( FLOOR( isrel / (tcobc(2)-tcobc(1)) ) < itimop ) THEN 1075 itobcm = ntobc1 1076 itobcp = ntobc2 1103 1077 ELSE 1104 ntobcm = ntobc1+11105 ntobcp = ntobc2+11078 itobcm = ntobc1+1 1079 itobcp = ntobc2+1 1106 1080 ENDIF 1107 1081 1108 1082 ELSEIF ( itimom == itimo-1 .AND. itimop == itimo+1 ) THEN 1109 IF( FLOOR( isrel / ( ztcobc(2)-ztcobc(1)) ) < itimo ) THEN1110 ntobcm = ntobc1-11111 ntobcp = ntobc2-11112 ELSEIF ( FLOOR( isrel / ( ztcobc(2)-ztcobc(1)) ) < itimop ) THEN1113 ntobcm = ntobc11114 ntobcp = ntobc21115 ELSEIF ( FLOOR( isrel / ( ztcobc(2)-ztcobc(1)) ) == itimop ) THEN1116 ntobcm = ntobc1+11117 ntobcp = ntobc2+21083 IF( FLOOR( isrel / (tcobc(2)-tcobc(1)) ) < itimo ) THEN 1084 itobcm = ntobc1-1 1085 itobcp = ntobc2-1 1086 ELSEIF ( FLOOR( isrel / (tcobc(2)-tcobc(1)) ) < itimop ) THEN 1087 itobcm = ntobc1 1088 itobcp = ntobc2 1089 ELSEIF ( FLOOR( isrel / (tcobc(2)-tcobc(1)) ) == itimop ) THEN 1090 itobcm = ntobc1+1 1091 itobcp = ntobc2+2 1118 1092 ELSE 1119 1093 IF(lwp) WRITE(numout, *) 'obc_dta_bt: You should not have seen this print! error 1?' … … 1127 1101 ELSE IF( lk_dynspg_exp ) THEN 1128 1102 isrel=kt*rdt 1129 ntobcm = ntobc11130 ntobcp = ntobc21103 itobcm = ntobc1 1104 itobcp = ntobc2 1131 1105 ENDIF 1132 1106 1133 IF( itobc == 1 .OR. nobc_dta == 0 ) THEN1107 IF( ntobc == 1 .OR. nobc_dta == 0 ) THEN 1134 1108 zxy = 0.e0 1135 ELSE IF( itobc == 12 ) THEN1109 ELSE IF( ntobc == 12 ) THEN 1136 1110 zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 1137 1111 ELSE 1138 zxy = ( ztcobc(ntobcm)-FLOAT(isrel)) / (ztcobc(ntobcm)-ztcobc(ntobcp))1112 zxy = (tcobc(itobcm)-FLOAT(isrel)) / (tcobc(itobcm)-tcobc(itobcp)) 1139 1113 ENDIF 1140 1114 … … 1177 1151 !! Default option 1178 1152 !!----------------------------------------------------------------------------- 1179 SUBROUTINE obc_dta_bt( kt, kbt ) ! Empty routine 1180 INTEGER,INTENT(in) :: kt, kbt 1181 WRITE(*,*) 'obc_dta_bt: You should not have seen this print! error?', kt, kbt 1153 SUBROUTINE obc_dta_bt ( kt, kbt ) ! Empty routine 1154 !! * Arguments 1155 INTEGER,INTENT(in) :: kt 1156 INTEGER, INTENT( in ) :: kbt ! barotropic ocean time-step index 1157 WRITE(*,*) 'obc_dta_bt: You should not have seen this print! error?', kt 1158 WRITE(*,*) 'obc_dta_bt: You should not have seen this print! error?', kbt 1182 1159 END SUBROUTINE obc_dta_bt 1183 1160 #endif 1184 1185 1186 SUBROUTINE obc_dta_gv (ifid,cldim,clobc,kobcij,ktobc,pdta_2D,pdta_3D)1187 !!-----------------------------------------------------------------------------1188 !! *** SUBROUTINE obc_dta_gv ***1189 !!1190 !! ** Purpose : Read an OBC forcing field from netcdf file1191 !! Input file are supposed to be 3D e.g.1192 !! - for a South or North OB : longitude x depth x time1193 !! - for a West or East OB : latitude x depth x time1194 !!1195 !! History :1196 !! ! 04-06 (A.-M. Treguier, F. Durand) Original code1197 !! ! 05-02 (J. Bellier, C. Talandier) use fliocom CALL1198 !!----------------------------------------------------------------------------1199 !! * Arguments1200 INTEGER, INTENT(IN) :: &1201 ifid , & ! netcdf file name identifier1202 kobcij, & ! Horizontal (i or j) dimension of the array1203 ktobc ! starting time index read1204 CHARACTER(LEN=*), INTENT(IN) :: &1205 cldim, & ! dimension along which is the open boundary ('x' or 'y')1206 clobc ! name of the netcdf variable read1207 REAL, DIMENSION(kobcij,jpk,1), INTENT(OUT), OPTIONAL :: &1208 pdta_3D ! 3D array of OBC forcing field1209 REAL, DIMENSION(kobcij,1), INTENT(OUT), OPTIONAL :: &1210 pdta_2D ! 3D array of OBC forcing field1211 1212 !! * Local declarations1213 INTEGER :: indim1214 LOGICAL :: l_exv1215 INTEGER,DIMENSION(4) :: f_d, istart, icount1216 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: v_tmp_41217 !----------------------------------------------------------------------1218 1219 CALL flioinqv (ifid,TRIM(clobc),l_exv,nb_dims=indim,len_dims=f_d)1220 IF( l_exv ) THEN1221 ! checks the number of dimensions1222 IF( indim == 2 ) THEN1223 istart(1:2) = (/ 1 , ktobc /)1224 icount(1:2) = (/ kobcij, 1 /)1225 CALL fliogetv (ifid,TRIM(clobc),pdta_2D,start=istart(1:2),count=icount(1:2))1226 ELSE IF( indim == 3 ) THEN1227 istart(1:3) = (/ 1 , 1 , ktobc /)1228 icount(1:3) = (/ kobcij, jpk , 1 /)1229 CALL fliogetv (ifid,TRIM(clobc),pdta_3D,start=istart(1:3),count=icount(1:3))1230 ELSE IF( indim == 4 ) THEN1231 istart(1:4) = (/ 1, 1, 1, ktobc /)1232 IF( TRIM(cldim) == 'y' ) THEN1233 icount(1:4) = (/ 1 , kobcij, jpk , 1 /)1234 ELSE1235 icount(1:4) = (/ kobcij, 1 , jpk , 1 /)1236 ENDIF1237 ALLOCATE (v_tmp_4(icount(1),icount(2),icount(3),icount(4)))1238 CALL fliogetv (ifid,TRIM(clobc),v_tmp_4,start=istart(1:4),count=icount(1:4))1239 IF( TRIM(cldim) == 'y' ) THEN1240 pdta_3D(1:kobcij,1:jpk,1:1) = v_tmp_4(1,1:kobcij,1:jpk,1:1)1241 ELSE1242 pdta_3D(1:kobcij,1:jpk,1:1) = v_tmp_4(1:kobcij,1,1:jpk,1:1)1243 ENDIF1244 DEALLOCATE (v_tmp_4)1245 ELSE1246 IF( lwp ) THEN1247 WRITE(numout,*) ' Problem in OBC file for ',TRIM(clobc),' :'1248 WRITE(numout,*) ' number of dimensions (not 3 or 4) =',indim1249 ENDIF1250 STOP1251 ENDIF1252 ELSE1253 WRITE(numout,*) ' Variable ',TRIM(clobc),' not found'1254 ENDIF1255 1256 END SUBROUTINE obc_dta_gv1257 1161 1258 1162 #else
Note: See TracChangeset
for help on using the changeset viewer.
