Changeset 367 for trunk/NEMO/OPA_SRC/OBC
- Timestamp:
- 2005-12-28T10:25:10+01:00 (18 years ago)
- Location:
- trunk/NEMO/OPA_SRC/OBC
- Files:
-
- 2 added
- 8 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/OBC/obc_oce.F90
r353 r367 40 40 !!-------------------------------------- 41 41 INTEGER :: & !: * namelist ??? * 42 nbobc = 1, & !: number of open boundaries ( 1=< nbobc =< 4 )43 nobc_dta = 0 , &!: = 0 use the initial state as obc data42 nbobc = 2 , & !: number of open boundaries ( 1=< nbobc =< 4 ) 43 nobc_dta = 0 !: = 0 use the initial state as obc data 44 44 ! ! = 1 read obc data in obcxxx.dta files 45 45 46 46 LOGICAL :: ln_obc_clim = .true. !: obc data files are climatological 47 LOGICAL :: ln_obc_fla = .false. !: Flather open boundary condition not used 48 LOGICAL :: ln_vol_cst = .true. !: Conservation of the whole volume 47 49 48 50 REAL(wp) :: & !!: open boundary namelist (namobc) … … 117 119 118 120 REAL(wp), DIMENSION(jpjed:jpjef) :: & !: 119 bfoe !: now climatology of the east boundary barotropic stream function 121 bfoe, & !: now climatology of the east boundary barotropic stream function 122 sshfoe, & !: now climatology of the east boundary sea surface height 123 ubtfoe,vbtfoe !: now climatology of the east boundary barotropic transport 120 124 121 125 REAL(wp), DIMENSION(jpj,jpk) :: & !: … … 124 128 uclie !: baroclinic componant of the zonal velocity after radiation 125 129 ! ! in the obcdyn.F90 routine 130 131 REAL(wp), DIMENSION(jpjed:jpjef,jpj) :: & !: 132 sshfoe_b !: east boundary ssh correction averaged over the barotropic loop 133 !: (if Flather's algoritm applied at open boundary) 134 135 REAL(wp), DIMENSION(jpjed:jpjef,0:jptobc+1) :: & !: 136 sshedta, ubtedta !: array used for interpolating monthly data on the east boundary 126 137 127 138 REAL(wp), DIMENSION(jpjed:jpjef,jpk,jptobc) :: & !: … … 168 179 169 180 REAL(wp), DIMENSION(jpjwd:jpjwf) :: & !: 170 bfow !: now climatology of the west boundary barotropic stream function 181 bfow, & !: now climatology of the west boundary barotropic stream function 182 sshfow, & !: now climatology of the west boundary sea surface height 183 ubtfow,vbtfow !: now climatology of the west boundary barotropic transport 171 184 172 185 REAL(wp), DIMENSION(jpj,jpk) :: & !: … … 175 188 ucliw !: baroclinic componant of the zonal velocity after the radiation 176 189 ! ! in the obcdyn.F90 routine 190 191 REAL(wp), DIMENSION(jpjwd:jpjwf,jpj) :: & !: 192 sshfow_b !: west boundary ssh correction averaged over the barotropic loop 193 !: (if Flather's algoritm applied at open boundary) 194 195 REAL(wp), DIMENSION(jpjwd:jpjwf,0:jptobc+1) :: & !: 196 sshwdta, ubtwdta !: array used for interpolating monthly data on the west boundary 177 197 178 198 REAL(wp), DIMENSION(jpjwd:jpjwf,jpk,jptobc) :: & !: … … 220 240 221 241 REAL(wp), DIMENSION(jpind:jpinf) :: & !: 222 bfon !: now climatology of the north boundary barotropic stream function 242 bfon, & !: now climatology of the north boundary barotropic stream function 243 sshfon, & !: now climatology of the north boundary sea surface height 244 ubtfon,vbtfon !: now climatology of the north boundary barotropic transport 223 245 224 246 REAL(wp), DIMENSION(jpi,jpk) :: & !: … … 227 249 vclin !: baroclinic componant of the meridian velocity after the radiation 228 250 ! ! in yhe obcdyn.F90 routine 251 252 REAL(wp), DIMENSION(jpind:jpinf,jpj) :: & !: 253 sshfon_b !: north boundary ssh correction averaged over the barotropic loop 254 !: (if Flather's algoritm applied at open boundary) 255 256 REAL(wp), DIMENSION(jpind:jpinf,0:jptobc+1) :: & !: 257 sshndta, vbtndta !: array used for interpolating monthly data on the north boundary 229 258 230 259 REAL(wp), DIMENSION(jpind:jpinf,jpk,jptobc) :: & !: … … 271 300 272 301 REAL(wp), DIMENSION(jpisd:jpisf) :: & !: 273 bfos !: now climatology of the south boundary barotropic stream function 302 bfos, & !: now climatology of the south boundary barotropic stream function 303 sshfos, & !: now climatology of the south boundary sea surface height 304 ubtfos,vbtfos !: now climatology of the south boundary barotropic transport 274 305 275 306 REAL(wp), DIMENSION(jpi,jpk) :: & !: … … 278 309 vclis !: baroclinic componant of the meridian velocity after the radiation 279 310 ! ! in the obcdyn.F90 routine 311 312 REAL(wp), DIMENSION(jpisd:jpisf,jpj) :: & !: 313 sshfos_b !: south boundary ssh correction averaged over the barotropic loop 314 !: (if Flather's algoritm applied at open boundary) 315 316 REAL(wp), DIMENSION(jpisd:jpisf,0:jptobc+1) :: & !: 317 sshsdta, vbtsdta !: array used for interpolating monthly data on the south boundary 280 318 281 319 REAL(wp), DIMENSION(jpisd:jpisf,jpk,jptobc) :: & !: -
trunk/NEMO/OPA_SRC/OBC/obccli.F90
r247 r367 4 4 !! Ocean dynamics: Baroclinic componant of velocities on each open boundary 5 5 !!=================================================================================== 6 #if defined key_obc && ! defined key_dynspg_fsc6 #if defined key_obc && defined key_dynspg_rl 7 7 !!----------------------------------------------------------------------------------- 8 8 !! 'key_obc' and 9 !! 'key_dynspg_ fsc'9 !! 'key_dynspg_rl' 10 10 !!----------------------------------------------------------------------------------- 11 11 !! obc_cli_dyn : Compute the baroclinic componant after the radiation phase -
trunk/NEMO/OPA_SRC/OBC/obcdta.F90
r353 r367 20 20 USE in_out_manager ! I/O logical units 21 21 USE lib_mpp ! distributed memory computing 22 USE dynspg_ rl !22 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 23 23 USE ioipsl 24 25 26 # if ! defined key_dynspg_fsc 24 # if defined key_dynspg_rl 27 25 USE obccli 28 26 # endif … … 31 29 PRIVATE 32 30 33 !! * Accessibility31 !! * Accessibility 34 32 PUBLIC obc_dta ! routines called by step.F90 33 PUBLIC obc_dta_bt ! routines called by dynspg_ts.F90 35 34 36 35 !! * Shared module variables 37 36 INTEGER :: & 38 nlecto = 0, & ! switch for the first read 39 ntobc1 , & ! first record used 40 ntobc2 ! second record used 41 37 nlecto, & ! switch for the first read 38 ntobc1, & ! first record used 39 ntobc2, & ! second record used 40 itobc ! number of time steps in OBC files 41 42 REAL(wp), DIMENSION(:), ALLOCATABLE :: ztcobc ! time_counter variable of BCs 43 42 44 !! * Substitutions 45 # include "domzgr_substitute.h90" 43 46 # include "obc_vectopt_loop_substitute.h90" 44 47 !!--------------------------------------------------------------------------------- 45 48 !! OPA 9.0 , LODYC-IPSL (2003) 49 !! $Header$ 50 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 46 51 !!--------------------------------------------------------------------------------- 47 52 … … 82 87 INTEGER :: isrel ! number of seconds since 1/1/1992 83 88 INTEGER, SAVE :: itobce, itobcw, & ! number of time steps in OBC files 84 itobcs, itobcn, & ! " " " " 85 itobc 89 itobcs, itobcn ! " " " " 86 90 INTEGER :: ikprint ! frequency for printouts. 87 91 INTEGER :: fid_e, fid_w, fid_n, fid_s, fid ! file identifiers … … 91 95 start, & ! starting index read 92 96 count ! number of indices to be read 93 ! time_counter variable of BCs94 REAL(wp),DIMENSION(:),ALLOCATABLE :: ztcobc95 97 96 98 CHARACTER(LEN=25) :: f_name,v_name … … 112 114 IF( kt == nit000 ) THEN 113 115 116 nlecto = 0 117 114 118 IF(lwp) WRITE(numout,*) 115 119 IF(lwp) WRITE(numout,*) 'obc_dta : find boundary data' … … 219 223 ! 1.1 Tangential velocities set to zero 220 224 ! -------------------------------------- 221 IF( lp_obc_east ) vfoe = 0. 0222 IF( lp_obc_west ) vfow = 0. 0223 IF( lp_obc_south ) ufos = 0. 0224 IF( lp_obc_north ) ufon = 0. 0225 IF( lp_obc_east ) vfoe = 0.e0 226 IF( lp_obc_west ) vfow = 0.e0 227 IF( lp_obc_south ) ufos = 0.e0 228 IF( lp_obc_north ) ufon = 0.e0 225 229 226 230 ! 1.2 Data temperature, salinity, normal velocities set to zero … … 344 348 itimo = imois 345 349 ELSE 346 IF(lwp) WRITE(numout,*) 'data other than constant or monthly not written yet' 347 STOP 350 IF(lwp) WRITE(numout,*) 'data other than constant or monthly',kt 351 iman = itobc 352 itimo = FLOOR( kt*rdt / (ztcobc(2)-ztcobc(1)) ) 353 isrel = kt*rdt 348 354 ENDIF 349 355 ENDIF … … 370 376 ENDIF 371 377 ELSE 372 !!!!!!!!!!!!!ATTENTION el: A verifier en fction de la convention choisie pour 373 !!!!!!!!!!!!! le codage de nyear, pour les runs interannuels !!!!!!!!!!!!!! 374 !!! attention if ln_obc_clim is true, go back to jan 1st after december 31st 375 iyrel=nyear-1991 376 IF( ( iyrel < 1 ) .OR. ( iyrel > 13 ) ) THEN 377 IF( lwp ) WRITE(numout,*) 'Pb OBCDTA : iyrel' 378 STOP 379 ENDIF 380 ! Compute nb of seconds from 1/1/1992 00:00 : 381 isrel=(365*(iyrel-1)+nday_year)*86400 382 IF( lwp ) THEN 383 WRITE(numout,*)'Nbre de secondes ecoulees depuis le 1/1/1992:' 384 WRITE(numout,*) isrel 385 ENDIF 386 387 ! need to calculate here ntobc1 and ntobc2, the two time steps to be read 388 378 isrel=kt*rdt 379 ntobc1 = itimo ! first file record used 380 ntobc2 = ntobc1 + 1 ! last file record used 381 ntobc1 = MOD( ntobc1, iman ) 382 IF( ntobc1 == 0 ) ntobc1 = iman 383 ntobc2 = MOD( ntobc2, iman ) 384 IF( ntobc2 == 0 ) ntobc2 = iman 385 IF(lwp) WRITE(numout,*) ' read obc first record file used ntobc1 ', ntobc1 386 IF(lwp) WRITE(numout,*) ' read obc last record file used ntobc2 ', ntobc2 389 387 ENDIF 390 388 ! ======================= ! … … 395 393 ! ... initialise the sedta, tedta, uedta arrays 396 394 CALL flioopfd ('obceast_TS.nc',fid_e) 397 CALL obc_dta_gv (fid_e,'y','vosaline', sedta(:,:,1),jpjef-jpjed+1,jpk,ntobc1)398 CALL obc_dta_gv (fid_e,'y','vosaline', sedta(:,:,2),jpjef-jpjed+1,jpk,ntobc2)399 CALL obc_dta_gv (fid_e,'y','votemper', tedta(:,:,1),jpjef-jpjed+1,jpk,ntobc1)400 CALL obc_dta_gv (fid_e,'y','votemper', tedta(:,:,2),jpjef-jpjed+1,jpk,ntobc2)401 CALL flioclo (fid_e) 402 403 CALL flioopfd ('obceast_U.nc',fid_e) 404 CALL obc_dta_gv (fid_e,'y','vozocrtx', uedta(:,:,1),jpjef-jpjed+1,jpk,ntobc1)405 CALL obc_dta_gv (fid_e,'y','vozocrtx', uedta(:,:,2),jpjef-jpjed+1,jpk,ntobc2)395 CALL obc_dta_gv (fid_e,'y','vosaline',jpjef-jpjed+1,ntobc1,pdta_3D=sedta(:,:,1)) 396 CALL obc_dta_gv (fid_e,'y','vosaline',jpjef-jpjed+1,ntobc2,pdta_3D=sedta(:,:,2)) 397 CALL obc_dta_gv (fid_e,'y','votemper',jpjef-jpjed+1,ntobc1,pdta_3D=tedta(:,:,1)) 398 CALL obc_dta_gv (fid_e,'y','votemper',jpjef-jpjed+1,ntobc2,pdta_3D=tedta(:,:,2)) 399 CALL flioclo (fid_e) 400 401 CALL flioopfd ('obceast_U.nc',fid_e) 402 CALL obc_dta_gv (fid_e,'y','vozocrtx',jpjef-jpjed+1,ntobc1,pdta_3D=uedta(:,:,1)) 403 CALL obc_dta_gv (fid_e,'y','vozocrtx',jpjef-jpjed+1,ntobc2,pdta_3D=uedta(:,:,2)) 406 404 CALL flioclo (fid_e) 407 405 ! Usually printout is done only once at kt = nit000, … … 429 427 ! ... initialise the swdta, twdta, uwdta arrays 430 428 CALL flioopfd ('obcwest_TS.nc',fid_w) 431 CALL obc_dta_gv (fid_w,'y','vosaline', swdta(:,:,1),jpjwf-jpjwd+1,jpk,ntobc1)432 CALL obc_dta_gv (fid_w,'y','vosaline', swdta(:,:,2),jpjwf-jpjwd+1,jpk,ntobc2)433 CALL obc_dta_gv (fid_w,'y','votemper', twdta(:,:,1),jpjwf-jpjwd+1,jpk,ntobc1)434 CALL obc_dta_gv (fid_w,'y','votemper', twdta(:,:,2),jpjwf-jpjwd+1,jpk,ntobc2)435 CALL flioclo (fid_w) 436 437 CALL flioopfd ('obcwest_U.nc',fid_w) 438 CALL obc_dta_gv (fid_w,'y','vozocrtx', uwdta(:,:,1),jpjwf-jpjwd+1,jpk,ntobc1)439 CALL obc_dta_gv (fid_w,'y','vozocrtx', uwdta(:,:,2),jpjwf-jpjwd+1,jpk,ntobc2)429 CALL obc_dta_gv (fid_w,'y','vosaline',jpjwf-jpjwd+1,ntobc1,pdta_3D=swdta(:,:,1)) 430 CALL obc_dta_gv (fid_w,'y','vosaline',jpjwf-jpjwd+1,ntobc2,pdta_3D=swdta(:,:,2)) 431 CALL obc_dta_gv (fid_w,'y','votemper',jpjwf-jpjwd+1,ntobc1,pdta_3D=twdta(:,:,1)) 432 CALL obc_dta_gv (fid_w,'y','votemper',jpjwf-jpjwd+1,ntobc2,pdta_3D=twdta(:,:,2)) 433 CALL flioclo (fid_w) 434 435 CALL flioopfd ('obcwest_U.nc',fid_w) 436 CALL obc_dta_gv (fid_w,'y','vozocrtx',jpjwf-jpjwd+1,ntobc1,pdta_3D=uwdta(:,:,1)) 437 CALL obc_dta_gv (fid_w,'y','vozocrtx',jpjwf-jpjwd+1,ntobc2,pdta_3D=uwdta(:,:,2)) 440 438 CALL flioclo (fid_w) 441 439 … … 460 458 IF( lp_obc_north ) THEN 461 459 CALL flioopfd ('obcnorth_TS.nc',fid_n) 462 CALL obc_dta_gv (fid_n,'x','vosaline', sndta(:,:,1),jpinf-jpind+1,jpk,ntobc1)463 CALL obc_dta_gv (fid_n,'x','vosaline', sndta(:,:,2),jpinf-jpind+1,jpk,ntobc2)464 CALL obc_dta_gv (fid_n,'x','votemper', tndta(:,:,1),jpinf-jpind+1,jpk,ntobc1)465 CALL obc_dta_gv (fid_n,'x','votemper', tndta(:,:,2),jpinf-jpind+1,jpk,ntobc2)466 CALL flioclo (fid_n) 467 468 CALL flioopfd ('obcnorth_V.nc',fid_n) 469 CALL obc_dta_gv (fid_n,'x','vomecrty', vndta(:,:,1),jpinf-jpind+1,jpk,ntobc1)470 CALL obc_dta_gv (fid_n,'x','vomecrty', vndta(:,:,2),jpinf-jpind+1,jpk,ntobc2)460 CALL obc_dta_gv (fid_n,'x','vosaline',jpinf-jpind+1,ntobc1,pdta_3D=sndta(:,:,1)) 461 CALL obc_dta_gv (fid_n,'x','vosaline',jpinf-jpind+1,ntobc2,pdta_3D=sndta(:,:,2)) 462 CALL obc_dta_gv (fid_n,'x','votemper',jpinf-jpind+1,ntobc1,pdta_3D=tndta(:,:,1)) 463 CALL obc_dta_gv (fid_n,'x','votemper',jpinf-jpind+1,ntobc2,pdta_3D=tndta(:,:,2)) 464 CALL flioclo (fid_n) 465 466 CALL flioopfd ('obcnorth_V.nc',fid_n) 467 CALL obc_dta_gv (fid_n,'x','vomecrty',jpinf-jpind+1,ntobc1,pdta_3D=vndta(:,:,1)) 468 CALL obc_dta_gv (fid_n,'x','vomecrty',jpinf-jpind+1,ntobc2,pdta_3D=vndta(:,:,2)) 471 469 CALL flioclo (fid_n) 472 470 … … 491 489 IF( lp_obc_south ) THEN 492 490 CALL flioopfd ('obcsouth_TS.nc',fid_s) 493 CALL obc_dta_gv (fid_s,'x','vosaline', ssdta(:,:,1),jpisf-jpisd+1,jpk,ntobc1)494 CALL obc_dta_gv (fid_s,'x','vosaline', ssdta(:,:,2),jpisf-jpisd+1,jpk,ntobc2)495 CALL obc_dta_gv (fid_s,'x','votemper', tsdta(:,:,1),jpisf-jpisd+1,jpk,ntobc1)496 CALL obc_dta_gv (fid_s,'x','votemper', tsdta(:,:,2),jpisf-jpisd+1,jpk,ntobc2)497 CALL flioclo (fid_s) 498 499 CALL flioopfd ('obcsouth_V.nc',fid_s) 500 CALL obc_dta_gv (fid_s,'x','vomecrty', vsdta(:,:,1),jpisf-jpisd+1,jpk,ntobc1)501 CALL obc_dta_gv (fid_s,'x','vomecrty', vsdta(:,:,2),jpisf-jpisd+1,jpk,ntobc2)491 CALL obc_dta_gv (fid_s,'x','vosaline',jpisf-jpisd+1,ntobc1,pdta_3D=ssdta(:,:,1)) 492 CALL obc_dta_gv (fid_s,'x','vosaline',jpisf-jpisd+1,ntobc2,pdta_3D=ssdta(:,:,2)) 493 CALL obc_dta_gv (fid_s,'x','votemper',jpisf-jpisd+1,ntobc1,pdta_3D=tsdta(:,:,1)) 494 CALL obc_dta_gv (fid_s,'x','votemper',jpisf-jpisd+1,ntobc2,pdta_3D=tsdta(:,:,2)) 495 CALL flioclo (fid_s) 496 497 CALL flioopfd ('obcsouth_V.nc',fid_s) 498 CALL obc_dta_gv (fid_s,'x','vomecrty',jpisf-jpisd+1,ntobc1,pdta_3D=vsdta(:,:,1)) 499 CALL obc_dta_gv (fid_s,'x','vomecrty',jpisf-jpisd+1,ntobc2,pdta_3D=vsdta(:,:,2)) 502 500 CALL flioclo (fid_s) 503 501 … … 519 517 ENDIF 520 518 ENDIF 521 522 ENDIF ! end of the test on the condition to read or not the files 519 520 ELSE 521 522 nlecto = 0 ! no reading of OBC barotropic data 523 524 ENDIF ! end of the test on the condition to read or not the files 523 525 524 526 ! 3. Call at every time step : … … 596 598 END SUBROUTINE obc_dta 597 599 598 # if defined key_dynspg_ fsc600 # if defined key_dynspg_rl 599 601 !!----------------------------------------------------------------------------- 600 !! 'key_dynspg_fsc' free surface with constant volume 601 !!----------------------------------------------------------------------------- 602 SUBROUTINE obc_dta_psi ( kt ) ! Empty routine 603 !! * Arguments 604 INTEGER,INTENT(in) :: kt 605 WRITE(*,*) 'obc_dta_psi: You should not have seen this print! error?', kt 606 END SUBROUTINE obc_dta_psi 607 #else 608 !!----------------------------------------------------------------------------- 609 !! Default option Rigid-lid 602 !! Rigid-lid 610 603 !!----------------------------------------------------------------------------- 611 604 … … 636 629 !! ! 97-08 (G. Madec, J.M. Molines) 637 630 !! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90 631 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization 638 632 !!---------------------------------------------------------------------------- 639 633 !! * Arguments … … 684 678 IF( nbobc > 1 ) THEN 685 679 DO jnic = 1,nbobc - 1 686 gcbic(jnic) = 0. 680 gcbic(jnic) = 0.e0 687 681 ip=mnic(0,jnic) 688 682 DO jip = 1,ip … … 742 736 IF( lpsouthobc) THEN 743 737 744 IF( kt == nit000 .OR.kt <= kbsfstart ) THEN738 IF( kt == nit000 .OR. kt <= kbsfstart ) THEN 745 739 OPEN(inum,file='obcsouthbsf.dta') 746 740 READ(inum,*) … … 759 753 760 754 IF( lpnorthobc) THEN 761 IF( kt == nit000 .OR.kt <= kbsfstart ) THEN755 IF( kt == nit000 .OR. kt <= kbsfstart ) THEN 762 756 OPEN(inum,file='obcnorthbsf.dta') 763 757 READ(inum,*) … … 776 770 777 771 END SUBROUTINE obc_dta_psi 778 772 #else 773 !!----------------------------------------------------------------------------- 774 !! Default option 775 !!----------------------------------------------------------------------------- 776 SUBROUTINE obc_dta_psi ( kt ) ! Empty routine 777 !! * Arguments 778 INTEGER,INTENT(in) :: kt 779 WRITE(*,*) 'obc_dta_psi: You should not have seen this print! error?', kt 780 END SUBROUTINE obc_dta_psi 779 781 # endif 780 782 781 SUBROUTINE obc_dta_gv (ifid,cldim,clobc,pdta,kobcij,kobck,ktobc) 783 784 #if defined key_dynspg_ts || defined key_dynspg_exp 785 SUBROUTINE obc_dta_bt( kt, kbt ) 786 !!--------------------------------------------------------------------------- 787 !! *** SUBROUTINE obc_dta *** 788 !! 789 !! ** Purpose : time interpolation of barotropic data for time-splitting scheme 790 !! Data at the boundary must be in m2/s 791 !! 792 !! History : 793 !! 9.0 ! 05-11 (V. garnier) Original code 794 !!--------------------------------------------------------------------------- 795 !! * Arguments 796 INTEGER, INTENT( in ) :: kt ! ocean time-step index 797 INTEGER, INTENT( in ) :: kbt ! barotropic ocean time-step index 798 799 !! * Local declarations 800 INTEGER :: ji, jj, jk, ii, ij ! dummy loop indices 801 INTEGER :: fid_e, fid_w, fid_n, fid_s, fid ! file identifiers 802 INTEGER :: itimo, iman, imois, i15 803 INTEGER :: ntobcm, ntobcp, itimom, itimop 804 REAL(wp) :: zxy 805 INTEGER :: isrel, ikt ! number of seconds since 1/1/1992 806 INTEGER :: ikprint ! frequency for printouts. 807 808 !!--------------------------------------------------------------------------- 809 810 ! 1. First call: check time frames available in files. 811 ! ------------------------------------------------------- 812 813 IF( kt == nit000 ) THEN 814 815 ! 1.1 Barotropic tangential velocities set to zero 816 ! ------------------------------------------------- 817 IF( lp_obc_east ) vbtfoe(:) = 0.e0 818 IF( lp_obc_west ) vbtfow(:) = 0.e0 819 IF( lp_obc_south ) ubtfos(:) = 0.e0 820 IF( lp_obc_north ) ubtfon(:) = 0.e0 821 822 ! 1.2 Sea surface height and normal barotropic velocities set to zero 823 ! or initial conditions if nobc_dta == 0 824 ! -------------------------------------------------------------------- 825 826 IF( lp_obc_east ) THEN 827 ! initialisation to zero 828 sshedta(:,:) = 0.e0 829 ubtedta(:,:) = 0.e0 830 ! ! ================== ! 831 IF( nobc_dta == 0 ) THEN ! initial state used ! 832 ! ! ================== ! 833 ! Fills sedta, tedta, uedta (global arrays) 834 ! Remark: this works for njzoom = 1. Should the definition of ij include njzoom? 835 DO ji = nie0, nie1 836 DO jj = nje0p1, nje1m1 837 ij = jj -1 + njmpp 838 sshedta(ij,1) = sshn(ji+1,jj) * tmask(ji+1,jj,1) 839 END DO 840 END DO 841 ENDIF 842 ENDIF 843 844 IF( lp_obc_west) THEN 845 ! initialisation to zero 846 sshwdta(:,:) = 0.e0 847 ubtwdta(:,:) = 0.e0 848 ! ! ================== ! 849 IF( nobc_dta == 0 ) THEN ! initial state used ! 850 ! ! ================== ! 851 ! Fills swdta, twdta, uwdta (global arrays) 852 ! Remark: this works for njzoom = 1. Should the definition of ij include njzoom? 853 DO ji = niw0, niw1 854 DO jj = njw0p1, njw1m1 855 ij = jj -1 + njmpp 856 sshwdta(ij,1) = sshn(ji,jj) * tmask(ji,jj,1) 857 END DO 858 END DO 859 ENDIF 860 ENDIF 861 862 IF( lp_obc_north) THEN 863 ! initialisation to zero 864 sshndta(:,:) = 0.e0 865 vbtndta(:,:) = 0.e0 866 ! ! ================== ! 867 IF( nobc_dta == 0 ) THEN ! initial state used ! 868 ! ! ================== ! 869 ! Fills sndta, tndta, vndta (global arrays) 870 ! Remark: this works for njzoom = 1. Should the definition of ij include njzoom? 871 DO jj = njn0, njn1 872 DO ji = nin0p1, nin1m1 873 DO jk = 1, jpkm1 874 ii = ji -1 + nimpp 875 vbtndta(ii,1) = vbtndta(ii,1) + vndta(ii,jk,1)*fse3v(ji,jj,jk) 876 END DO 877 sshndta(ii,1) = sshn(ii,jj+1) * tmask(ji,jj+1,1) 878 END DO 879 END DO 880 ENDIF 881 ENDIF 882 883 IF( lp_obc_south) THEN 884 ! initialisation to zero 885 ssdta(:,:,:) = 0.e0 886 tsdta(:,:,:) = 0.e0 887 vsdta(:,:,:) = 0.e0 888 sshsdta(:,:) = 0.e0 889 vbtsdta(:,:) = 0.e0 890 ! ! ================== ! 891 IF( nobc_dta == 0 ) THEN ! initial state used ! 892 ! ! ================== ! 893 ! Fills ssdta, tsdta, vsdta (global arrays) 894 ! Remark: this works for njzoom = 1. Should the definition of ij include njzoom? 895 DO jj = njs0, njs1 896 DO ji = nis0p1, nis1m1 897 DO jk = 1, jpkm1 898 ii = ji -1 + nimpp 899 vbtsdta(ii,1) = vbtsdta(ii,1) + vsdta(ii,jk,1)*fse3v(ji,jj,jk) 900 END DO 901 sshsdta(ii,1) = sshn(ji,jj) * tmask(ii,jj,1) 902 END DO 903 END DO 904 ENDIF 905 ENDIF 906 907 ENDIF ! END IF kt == nit000 908 909 !!------------------------------------------------------------------------------------ 910 ! 2. Initialize the time we are at. Does this every time the routine is called, 911 ! excepted when nobc_dta = 0 912 ! 913 IF( nobc_dta == 0) THEN 914 itimo = 1 915 zxy = 0 916 ELSE 917 IF(itobc == 1) THEN 918 itimo = 1 919 ELSE IF (itobc == 12) THEN ! BC are monthly 920 ! we assume we have climatology in that case 921 iman = 12 922 i15 = nday / 16 923 imois = nmonth + i15 - 1 924 IF( imois == 0 ) imois = iman 925 itimo = imois 926 ELSE 927 IF(lwp) WRITE(numout,*) 'data other than constant or monthly',kt 928 iman = itobc 929 itimo = FLOOR( kt*rdt / ztcobc(1)) 930 isrel=kt*rdt 931 ENDIF 932 ENDIF 933 934 ! 2. Read two records in the file if necessary 935 ! --------------------------------------------- 936 937 IF( nobc_dta == 1 .AND. nlecto == 1 ) THEN 938 939 IF( lp_obc_east ) THEN 940 ! ... Read datafile and set sea surface height and barotropic velocity 941 ! ... initialise the sshedta, ubtedta arrays 942 sshedta(:,0) = sshedta(:,1) 943 ubtedta(:,0) = ubtedta(:,1) 944 CALL flioopfd ('obceast_TS.nc',fid_e) 945 CALL obc_dta_gv (fid_e,'y','vossurfh',jpjef-jpjed+1,ntobc1,pdta_2D=sshedta(:,1)) 946 CALL obc_dta_gv (fid_e,'y','vossurfh',jpjef-jpjed+1,ntobc2,pdta_2D=sshedta(:,2)) 947 IF( lk_dynspg_ts ) THEN 948 CALL obc_dta_gv (fid_e,'y','vossurfh',jpjef-jpjed+1,ntobc2+1,pdta_2D=sshedta(:,3)) 949 ENDIF 950 CALL flioclo (fid_e) 951 952 CALL flioopfd ('obceast_U.nc',fid_e) 953 CALL obc_dta_gv (fid_e,'y','vozoubt',jpjef-jpjed+1,ntobc1,pdta_2D=ubtedta(:,1)) 954 CALL obc_dta_gv (fid_e,'y','vozoubt',jpjef-jpjed+1,ntobc2,pdta_2D=ubtedta(:,2)) 955 IF( lk_dynspg_ts ) THEN 956 CALL obc_dta_gv (fid_e,'y','vozoubt',jpjef-jpjed+1,ntobc2+1,pdta_2D=ubtedta(:,3)) 957 ENDIF 958 CALL flioclo (fid_e) 959 960 ! ... Usually printout is done only once at kt = nit000, unless nprint (namelist) > 1 961 IF( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN 962 WRITE(numout,*) 963 WRITE(numout,*) ' Read East OBC barotropic data records ', ntobc1, ntobc2 964 ikprint = (jpjef-jpjed+1)/20 +1 965 WRITE(numout,*) 966 WRITE(numout,*) ' Sea surface height record 1' 967 CALL prihre( sshedta(:,1), jpjef-jpjed+1, 1, 1, jpjef-jpjed+1, ikprint, 1, 1, -3, 1., numout ) 968 WRITE(numout,*) 969 WRITE(numout,*) ' Normal transport (m2/s) record 1',ikprint 970 CALL prihre( ubtedta(:,1), jpjef-jpjed+1, 1, 1, jpjef-jpjed+1, ikprint, 1, 1, -3, 1., numout ) 971 ENDIF 972 ENDIF 973 974 IF( lp_obc_west ) THEN 975 ! ... Read datafile and set temperature, salinity and normal velocity 976 ! ... initialise the swdta, twdta, uwdta arrays 977 sshwdta(:,0) = sshwdta(:,1) 978 ubtwdta(:,0) = ubtwdta(:,1) 979 CALL flioopfd ('obcwest_TS.nc',fid_w) 980 CALL obc_dta_gv (fid_w,'y','vossurfh',jpjwf-jpjwd+1,ntobc1,pdta_2D=sshwdta(:,1)) 981 CALL obc_dta_gv (fid_w,'y','vossurfh',jpjwf-jpjwd+1,ntobc2,pdta_2D=sshwdta(:,2)) 982 IF( lk_dynspg_ts ) THEN 983 CALL obc_dta_gv (fid_w,'y','vossurfh',jpjwf-jpjwd+1,ntobc2+1,pdta_2D=sshwdta(:,3)) 984 ENDIF 985 CALL flioclo (fid_w) 986 987 CALL flioopfd ('obcwest_U.nc',fid_w) 988 CALL obc_dta_gv (fid_w,'y','vozoubt',jpjwf-jpjwd+1,ntobc1,pdta_2D=ubtwdta(:,1)) 989 CALL obc_dta_gv (fid_w,'y','vozoubt',jpjwf-jpjwd+1,ntobc2,pdta_2D=ubtwdta(:,2)) 990 IF( lk_dynspg_ts ) THEN 991 CALL obc_dta_gv (fid_w,'y','vozoubt',jpjwf-jpjwd+1,ntobc2+1,pdta_2D=ubtwdta(:,3)) 992 ENDIF 993 CALL flioclo (fid_w) 994 995 ! ... Usually printout is done only once at kt = nit000, unless nprint (namelist) > 1 996 IF( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN 997 WRITE(numout,*) 998 WRITE(numout,*) ' Read West OBC barotropic data records ', ntobc1, ntobc2 999 ikprint = (jpjwf-jpjwd+1)/20 +1 1000 WRITE(numout,*) 1001 WRITE(numout,*) ' Sea surface height record 1 - printout surface level' 1002 CALL prihre( sshwdta(:,1), jpjwf-jpjwd+1, 1, 1, jpjwf-jpjwd+1, ikprint, 1, 1, -3, 1., numout ) 1003 WRITE(numout,*) 1004 WRITE(numout,*) ' Normal transport (m2/s) record 1' 1005 CALL prihre( ubtwdta(:,1), jpjwf-jpjwd+1, 1, 1, jpjwf-jpjwd+1, ikprint, 1, 1, -3, 1., numout ) 1006 ENDIF 1007 ENDIF 1008 1009 IF( lp_obc_north) THEN 1010 ! ... Read datafile and set sea surface height and barotropic velocity 1011 ! ... initialise the sshndta, ubtndta arrays 1012 sshndta(:,0) = sshndta(:,1) 1013 vbtndta(:,0) = vbtndta(:,1) 1014 CALL flioopfd ('obcnorth_TS.nc',fid_n) 1015 CALL obc_dta_gv (fid_n,'x','vossurfh',jpinf-jpind+1,ntobc1,pdta_2D=sshndta(:,1)) 1016 CALL obc_dta_gv (fid_n,'x','vossurfh',jpinf-jpind+1,ntobc2,pdta_2D=sshndta(:,2)) 1017 IF( lk_dynspg_ts ) THEN 1018 CALL obc_dta_gv (fid_n,'x','vossurfh',jpinf-jpind+1,ntobc2+1,pdta_2D=sshndta(:,3)) 1019 ENDIF 1020 CALL flioclo (fid_n) 1021 1022 CALL flioopfd ('obcnorth_V.nc',fid_n) 1023 CALL obc_dta_gv (fid_n,'x','vomevbt',jpinf-jpind+1,ntobc1,pdta_2D=vbtndta(:,1)) 1024 CALL obc_dta_gv (fid_n,'x','vomevbt',jpinf-jpind+1,ntobc2,pdta_2D=vbtndta(:,2)) 1025 IF( lk_dynspg_ts ) THEN 1026 CALL obc_dta_gv (fid_n,'x','vomevbt',jpinf-jpind+1,ntobc2+1,pdta_2D=vbtndta(:,3)) 1027 ENDIF 1028 CALL flioclo (fid_n) 1029 1030 ! ... Usually printout is done only once at kt = nit000, unless nprint (namelist) > 1 1031 IF( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN 1032 WRITE(numout,*) 1033 WRITE(numout,*) ' Read North OBC barotropic data records ', ntobc1, ntobc2 1034 ikprint = (jpinf-jpind+1)/20 +1 1035 WRITE(numout,*) 1036 WRITE(numout,*) ' Sea surface height record 1 - printout surface level' 1037 CALL prihre( sshndta(:,1), jpinf-jpind+1, 1, 1, jpinf-jpind+1, ikprint, 1, 1, -3, 1., numout ) 1038 WRITE(numout,*) 1039 WRITE(numout,*) ' Normal transport (m2/s) record 1' 1040 CALL prihre( vbtndta(:,1), jpinf-jpind+1, 1, 1, jpinf-jpind+1, ikprint, 1, 1, -3, 1., numout ) 1041 ENDIF 1042 ENDIF 1043 1044 IF( lp_obc_south) THEN 1045 ! ... Read datafile and set sea surface height and barotropic velocity 1046 ! ... initialise the sshsdta, ubtsdta arrays 1047 sshsdta(:,0) = sshsdta(:,1) 1048 vbtsdta(:,0) = vbtsdta(:,1) 1049 CALL flioopfd ('obcsouth_TS.nc',fid_s) 1050 CALL obc_dta_gv (fid_s,'x','vossurfh',jpisf-jpisd+1,ntobc1,pdta_2D=sshsdta(:,1)) 1051 CALL obc_dta_gv (fid_s,'x','vossurfh',jpisf-jpisd+1,ntobc2,pdta_2D=sshsdta(:,2)) 1052 IF( lk_dynspg_ts ) THEN 1053 CALL obc_dta_gv (fid_s,'x','vossurfh',jpisf-jpisd+1,ntobc2+1,pdta_2D=sshsdta(:,3)) 1054 ENDIF 1055 CALL flioclo (fid_s) 1056 1057 CALL flioopfd ('obcsouth_V.nc',fid_s) 1058 CALL obc_dta_gv (fid_s,'x','vomevbt',jpisf-jpisd+1,ntobc1,pdta_2D=vbtsdta(:,1)) 1059 CALL obc_dta_gv (fid_s,'x','vomevbt',jpisf-jpisd+1,ntobc2,pdta_2D=vbtsdta(:,2)) 1060 IF( lk_dynspg_ts ) THEN 1061 CALL obc_dta_gv (fid_s,'x','vomevbt',jpisf-jpisd+1,ntobc2+1,pdta_2D=vbtsdta(:,3)) 1062 ENDIF 1063 CALL flioclo (fid_s) 1064 1065 ! ... Usually printout is done only once at kt = nit000, unless nprint (namelist) > 1 1066 IF( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN 1067 WRITE(numout,*) 1068 WRITE(numout,*) ' Read South OBC barotropic data records ', ntobc1, ntobc2 1069 ikprint = (jpisf-jpisd+1)/20 +1 1070 WRITE(numout,*) 1071 WRITE(numout,*) ' Sea surface height record 1 - printout surface level' 1072 CALL prihre( sshsdta(:,1), jpisf-jpisd+1, 1, 1, jpisf-jpisd+1, ikprint, 1, 1, -3, 1., numout ) 1073 WRITE(numout,*) 1074 WRITE(numout,*) ' Normal transport (m2/s) record 1' 1075 CALL prihre( vbtsdta(:,1), jpisf-jpisd+1, 1, 1, jpisf-jpisd+1, ikprint, 1, 1, -3, 1., numout ) 1076 ENDIF 1077 ENDIF 1078 1079 ENDIF ! end of the test on the condition to read or not the files 1080 1081 ! 3. Call at every time step : Linear interpolation of BCs to current time step 1082 ! ---------------------------------------------------------------------- 1083 1084 IF( lk_dynspg_ts ) THEN 1085 isrel = (kt-1)*rdt + kbt*rdtbt 1086 1087 IF( nobc_dta == 1 ) THEN 1088 isrel = (kt-1)*rdt + kbt*rdtbt 1089 itimo = FLOOR( kt*rdt / (ztcobc(2)-ztcobc(1)) ) 1090 itimom = FLOOR( (kt-1)*rdt / (ztcobc(2)-ztcobc(1)) ) 1091 itimop = FLOOR( (kt+1)*rdt / (ztcobc(2)-ztcobc(1)) ) 1092 IF( itimom == itimo .AND. itimop == itimo ) THEN 1093 ntobcm = ntobc1 1094 ntobcp = ntobc2 1095 1096 ELSEIF ( itimom <= itimo .AND. itimop == itimo ) THEN 1097 IF( FLOOR( isrel / (ztcobc(2)-ztcobc(1)) ) < itimo ) THEN 1098 ntobcm = ntobc1-1 1099 ntobcp = ntobc2-1 1100 ELSE 1101 ntobcm = ntobc1 1102 ntobcp = ntobc2 1103 ENDIF 1104 1105 ELSEIF ( itimom == itimo .AND. itimop >= itimo ) THEN 1106 IF( FLOOR( isrel / (ztcobc(2)-ztcobc(1)) ) < itimop ) THEN 1107 ntobcm = ntobc1 1108 ntobcp = ntobc2 1109 ELSE 1110 ntobcm = ntobc1+1 1111 ntobcp = ntobc2+1 1112 ENDIF 1113 1114 ELSEIF ( itimom == itimo-1 .AND. itimop == itimo+1 ) THEN 1115 IF( FLOOR( isrel / (ztcobc(2)-ztcobc(1)) ) < itimo ) THEN 1116 ntobcm = ntobc1-1 1117 ntobcp = ntobc2-1 1118 ELSEIF ( FLOOR( isrel / (ztcobc(2)-ztcobc(1)) ) < itimop ) THEN 1119 ntobcm = ntobc1 1120 ntobcp = ntobc2 1121 ELSEIF ( FLOOR( isrel / (ztcobc(2)-ztcobc(1)) ) == itimop ) THEN 1122 ntobcm = ntobc1+1 1123 ntobcp = ntobc2+2 1124 ELSE 1125 IF(lwp) WRITE(numout, *) 'obc_dta_bt: You should not have seen this print! error 1?' 1126 ENDIF 1127 ELSE 1128 IF(lwp) WRITE(numout, *) 'obc_dta_bt: You should not have seen this print! error 2?' 1129 ENDIF 1130 1131 ENDIF 1132 1133 ELSE IF( lk_dynspg_exp ) THEN 1134 isrel=kt*rdt 1135 ntobcm = ntobc1 1136 ntobcp = ntobc2 1137 ENDIF 1138 1139 IF( itobc == 1 .OR. nobc_dta == 0 ) THEN 1140 zxy = 0.e0 1141 ELSE IF( itobc == 12 ) THEN 1142 zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 1143 ELSE 1144 zxy = (ztcobc(ntobcm)-FLOAT(isrel)) / (ztcobc(ntobcm)-ztcobc(ntobcp)) 1145 ENDIF 1146 1147 IF( lp_obc_east ) THEN ! fills sshfoe, ubtfoe (local to each processor) 1148 DO jj = nje0p1, nje1m1 1149 ij = jj -1 + njmpp 1150 sshfoe(jj) = ( zxy * sshedta(ij,2) + (1.-zxy) * sshedta(ij,1) ) * temsk(jj,1) 1151 ubtfoe(jj) = ( zxy * ubtedta(ij,2) + (1.-zxy) * ubtedta(ij,1) ) * uemsk(jj,1) 1152 END DO 1153 ENDIF 1154 1155 IF( lp_obc_west) THEN ! fills sshfow, ubtfow (local to each processor) 1156 DO jj = njw0p1, njw1m1 1157 ij = jj -1 + njmpp 1158 sshfow(jj) = ( zxy * sshwdta(ij,2) + (1.-zxy) * sshwdta(ij,1) ) * twmsk(jj,1) 1159 ubtfow(jj) = ( zxy * ubtwdta(ij,2) + (1.-zxy) * ubtwdta(ij,1) ) * uwmsk(jj,1) 1160 END DO 1161 ENDIF 1162 1163 IF( lp_obc_north) THEN ! fills sshfon, vbtfon (local to each processor) 1164 DO ji = nin0p1, nin1m1 1165 ii = ji -1 + nimpp 1166 sshfon(ji) = ( zxy * sshndta(ii,2) + (1.-zxy) * sshndta(ii,1) ) * tnmsk(ji,1) 1167 vbtfon(ji) = ( zxy * vbtndta(ii,2) + (1.-zxy) * vbtndta(ii,1) ) * vnmsk(ji,1) 1168 END DO 1169 ENDIF 1170 1171 IF( lp_obc_south) THEN ! fills sshfos, vbtfos (local to each processor) 1172 DO ji = nis0p1, nis1m1 1173 ii = ji -1 + nimpp 1174 sshfos(ji) = ( zxy * sshsdta(ii,2) + (1.-zxy) * sshsdta(ii,1) ) * tsmsk(ji,1) 1175 vbtfos(ji) = ( zxy * vbtsdta(ii,2) + (1.-zxy) * vbtsdta(ii,1) ) * vsmsk(ji,1) 1176 END DO 1177 ENDIF 1178 1179 END SUBROUTINE obc_dta_bt 1180 1181 #else 1182 !!----------------------------------------------------------------------------- 1183 !! Default option 1184 !!----------------------------------------------------------------------------- 1185 SUBROUTINE obc_dta_bt ( kt, kbt ) ! Empty routine 1186 !! * Arguments 1187 INTEGER,INTENT(in) :: kt 1188 INTEGER, INTENT( in ) :: kbt ! barotropic ocean time-step index 1189 WRITE(*,*) 'obc_dta_bt: You should not have seen this print! error?', kt 1190 END SUBROUTINE obc_dta_bt 1191 #endif 1192 1193 1194 SUBROUTINE obc_dta_gv (ifid,cldim,clobc,kobcij,ktobc,pdta_2D,pdta_3D) 782 1195 !!----------------------------------------------------------------------------- 783 1196 !! *** SUBROUTINE obc_dta_gv *** 784 1197 !! 785 !! ** Purpose : Read a OBC forcing field from netcdf file1198 !! ** Purpose : Read an OBC forcing field from netcdf file 786 1199 !! Input file are supposed to be 3D e.g. 787 1200 !! - for a South or North OB : longitude x depth x time … … 794 1207 !! * Arguments 795 1208 INTEGER, INTENT(IN) :: & 796 ifid ,& ! netcdf file name identifier1209 ifid , & ! netcdf file name identifier 797 1210 kobcij, & ! Horizontal (i or j) dimension of the array 798 kobck, & ! vertical dimension799 1211 ktobc ! starting time index read 800 1212 CHARACTER(LEN=*), INTENT(IN) :: & 801 1213 cldim, & ! dimension along which is the open boundary ('x' or 'y') 802 1214 clobc ! name of the netcdf variable read 803 REAL, DIMENSION(kobcij,kobck,1), INTENT(OUT) :: & 804 pdta ! 3D array of OBC forcing field 1215 REAL, DIMENSION(kobcij,jpk,1), INTENT(OUT), OPTIONAL :: & 1216 pdta_3D ! 3D array of OBC forcing field 1217 REAL, DIMENSION(kobcij,1), INTENT(OUT), OPTIONAL :: & 1218 pdta_2D ! 3D array of OBC forcing field 805 1219 806 1220 !! * Local declarations … … 814 1228 IF( l_exv ) THEN 815 1229 ! checks the number of dimensions 816 IF( indim == 3 ) THEN 817 istart(1:3) = (/ 1, 1, ktobc /) 818 icount(1:3) = (/ kobcij, kobck, 1 /) 819 CALL fliogetv (ifid,TRIM(clobc),pdta,start=istart(1:3),count=icount(1:3)) 1230 IF( indim == 2 ) THEN 1231 istart(1:2) = (/ 1 , ktobc /) 1232 icount(1:2) = (/ kobcij, 1 /) 1233 CALL fliogetv (ifid,TRIM(clobc),pdta_2D,start=istart(1:2),count=icount(1:2)) 1234 ELSE IF( indim == 3 ) THEN 1235 istart(1:3) = (/ 1 , 1 , ktobc /) 1236 icount(1:3) = (/ kobcij, jpk , 1 /) 1237 CALL fliogetv (ifid,TRIM(clobc),pdta_3D,start=istart(1:3),count=icount(1:3)) 820 1238 ELSE IF( indim == 4 ) THEN 821 1239 istart(1:4) = (/ 1, 1, 1, ktobc /) 822 1240 IF( TRIM(cldim) == 'y' ) THEN 823 icount(1:4) = (/ 1 , kobcij, kobck, 1 /)1241 icount(1:4) = (/ 1 , kobcij, jpk , 1 /) 824 1242 ELSE 825 icount(1:4) = (/ kobcij, 1 , kobck, 1 /)1243 icount(1:4) = (/ kobcij, 1 , jpk , 1 /) 826 1244 ENDIF 827 1245 ALLOCATE (v_tmp_4(icount(1),icount(2),icount(3),icount(4))) 828 1246 CALL fliogetv (ifid,TRIM(clobc),v_tmp_4,start=istart(1:4),count=icount(1:4)) 829 1247 IF( TRIM(cldim) == 'y' ) THEN 830 pdta (1:kobcij,1:kobck,1:1) = v_tmp_4(1,1:kobcij,1:kobck,1:1)1248 pdta_3D(1:kobcij,1:jpk,1:1) = v_tmp_4(1,1:kobcij,1:jpk,1:1) 831 1249 ELSE 832 pdta (1:kobcij,1:kobck,1:1) = v_tmp_4(1:kobcij,1,1:kobck,1:1)1250 pdta_3D(1:kobcij,1:jpk,1:1) = v_tmp_4(1:kobcij,1,1:jpk,1:1) 833 1251 ENDIF 834 1252 DEALLOCATE (v_tmp_4) -
trunk/NEMO/OPA_SRC/OBC/obcdyn.F90
r247 r367 22 22 USE lbclnk ! ??? 23 23 USE lib_mpp ! ??? 24 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 24 25 USE obccli ! ocean open boundary conditions: climatology 25 26 USE in_out_manager ! I/O manager … … 29 30 30 31 !! * Accessibility 31 PUBLIC obc_dyn ! routine called in dynspg_f sc(free surface case)32 PUBLIC obc_dyn ! routine called in dynspg_flt (free surface case) 32 33 ! routine called in dynnxt.F90 (rigid lid case) 33 34 … … 57 58 !! ** Purpose : 58 59 !! Compute dynamics (u,v) at the open boundaries. 59 !! if defined key_dynspg_f sc:60 !! this routine is called by dynspg_f scand updates60 !! if defined key_dynspg_flt: 61 !! this routine is called by dynspg_flt and updates 61 62 !! ua, va which are the actual velocities (not trends) 62 63 !! else (rigid lid case) , … … 74 75 !! ! 97-07 (G. Madec, J.-M. Molines) addition 75 76 !! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90 77 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization 76 78 !!---------------------------------------------------------------------- 77 79 !! * Arguments … … 132 134 !! ! 00-06 (J.-M. Molines) 133 135 !! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90 136 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization 134 137 !!------------------------------------------------------------------------------ 135 138 !! * Arguments … … 144 147 ! -------------------------------------------------------- 145 148 146 IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbceast ) THEN149 IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbceast .OR. lk_dynspg_exp ) THEN 147 150 148 151 ! 1.1 U zonal velocity … … 151 154 DO jk = 1, jpkm1 152 155 DO jj = 1, jpj 153 # if defined key_dynspg_fsc 154 ua(ji,jj,jk) = ua(ji,jj,jk) * (1.-uemsk(jj,jk)) + & 155 uemsk(jj,jk)*ufoe(jj,jk) 156 # else 156 # if defined key_dynspg_rl 157 157 ua(ji,jj,jk) = ua(ji,jj,jk) * (1.-uemsk(jj,jk)) + & 158 158 uemsk(jj,jk)*( ufoe(jj,jk) - hur (ji,jj) / e2u (ji,jj) & 159 159 * ( bsfn(ji,jj) - bsfn(ji,jj-1) ) ) 160 # else 161 ua(ji,jj,jk) = ua(ji,jj,jk) * (1.-uemsk(jj,jk)) + & 162 uemsk(jj,jk)*ufoe(jj,jk) 160 163 # endif 161 164 END DO … … 220 223 END DO 221 224 END DO 222 # if ! defined key_dynspg_fsc225 # if defined key_dynspg_rl 223 226 ! ... ua must be a baroclinic velocity uclie() 224 227 CALL obc_cli( ua, uclie, nie0, nie1, 0, jpj ) … … 294 297 !! ! 00-06 (J.-M. Molines) 295 298 !! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90 299 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization 296 300 !!------------------------------------------------------------------------------ 297 301 !! * Arguments … … 306 310 ! -------------------------------------------------------- 307 311 308 IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcwest ) THEN312 IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcwest .OR. lk_dynspg_exp ) THEN 309 313 310 314 ! 1.1 U zonal velocity … … 313 317 DO jk = 1, jpkm1 314 318 DO jj = 1, jpj 315 # if defined key_dynspg_fsc 316 ua(ji,jj,jk) = ua(ji,jj,jk) * (1.-uwmsk(jj,jk)) + & 317 uwmsk(jj,jk)*ufow(jj,jk) 318 # else 319 # if defined key_dynspg_rl 319 320 ua(ji,jj,jk) = ua(ji,jj,jk) * (1.-uwmsk(jj,jk)) + & 320 321 uwmsk(jj,jk)*( ufow(jj,jk) - hur (ji,jj) / e2u (ji,jj) & 321 322 * ( bsfn(ji,jj) - bsfn(ji,jj-1) ) ) 323 # else 324 ua(ji,jj,jk) = ua(ji,jj,jk) * (1.-uwmsk(jj,jk)) + & 325 uwmsk(jj,jk)*ufow(jj,jk) 322 326 # endif 323 327 END DO … … 381 385 END DO 382 386 END DO 383 # if ! defined key_dynspg_fsc387 # if defined key_dynspg_rl 384 388 ! ... ua must be a baroclinic velocity ucliw() 385 389 CALL obc_cli( ua, ucliw, niw0, niw1, 0, jpj ) … … 454 458 !! ! 00-06 (J.-M. Molines) 455 459 !! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90 460 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization 456 461 !!------------------------------------------------------------------------------ 457 462 !! * Arguments … … 466 471 ! --------------------------------------------------------- 467 472 468 IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcnorth ) THEN473 IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcnorth .OR. lk_dynspg_exp ) THEN 469 474 470 475 ! 1.1 U zonal velocity … … 484 489 DO jk = 1, jpkm1 485 490 DO ji = 1, jpi 486 # if defined key_dynspg_fsc 487 va(ji,jj,jk)= va(ji,jj,jk) * (1.-vnmsk(ji,jk)) + & 488 vfon(ji,jk)*vnmsk(ji,jk) 489 # else 491 # if defined key_dynspg_rl 490 492 va(ji,jj,jk)= va(ji,jj,jk) * (1.-vnmsk(ji,jk)) + & 491 493 vnmsk(ji,jk) * ( vfon(ji,jk) + hvr (ji,jj) / e1v (ji,jj) & 492 494 * ( bsfn(ji,jj) - bsfn(ji-1,jj) ) ) 495 # else 496 va(ji,jj,jk)= va(ji,jj,jk) * (1.-vnmsk(ji,jk)) + & 497 vfon(ji,jk)*vnmsk(ji,jk) 493 498 # endif 494 499 END DO … … 590 595 END DO 591 596 END DO 592 # if ! defined key_dynspg_fsc597 # if defined key_dynspg_rl 593 598 ! ... va must be a baroclinic velocity vclin() 594 599 CALL obc_cli( va, vclin, njn0, njn1, 1, jpi ) … … 625 630 !! ! 00-06 (J.-M. Molines) 626 631 !! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90 632 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization 627 633 !!------------------------------------------------------------------------------ 628 634 !! * Arguments … … 640 646 ! --------------------------------------------------------- 641 647 642 IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcsouth ) THEN648 IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcsouth .OR. lk_dynspg_exp ) THEN 643 649 644 650 ! 1.1 U zonal velocity … … 658 664 DO jk = 1, jpkm1 659 665 DO ji = 1, jpi 660 # if defined key_dynspg_fsc 661 va(ji,jj,jk)= va(ji,jj,jk) * (1.-vsmsk(ji,jk)) + & 662 vsmsk(ji,jk) * vfos(ji,jk) 663 # else 666 # if defined key_dynspg_rl 664 667 va(ji,jj,jk)= va(ji,jj,jk) * (1.-vsmsk(ji,jk)) + & 665 668 vsmsk(ji,jk) * (vfos(ji,jk) + hvr (ji,jj) / e1v (ji,jj) & 666 669 * ( bsfn(ji,jj) - bsfn(ji-1,jj) ) ) 670 # else 671 va(ji,jj,jk)= va(ji,jj,jk) * (1.-vsmsk(ji,jk)) + & 672 vsmsk(ji,jk) * vfos(ji,jk) 667 673 # endif 668 674 END DO … … 758 764 END DO 759 765 END DO 760 # if ! defined key_dynspg_fsc766 # if defined key_dynspg_rl 761 767 ! ... va must be a baroclinic velocity vclis() 762 768 CALL obc_cli( va, vclis, njs0, njs1, 1, jpi ) -
trunk/NEMO/OPA_SRC/OBC/obcini.F90
r353 r367 55 55 !! ! 97-11 (J.M. Molines) 56 56 !! 8.5 ! 02-11 (C. Talandier, A-M. Treguier) Free surface, F90 57 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization 57 58 !!---------------------------------------------------------------------- 58 59 !! * Modules used … … 69 70 & rdpeob, rdpwob, rdpnob, rdpsob, & 70 71 & zbsic1, zbsic2, zbsic3, & 71 & nbic, volemp, nobc_dta, ln_obc_clim 72 & nbic, volemp, nobc_dta, & 73 & ln_obc_clim, ln_vol_cst, ln_obc_fla 72 74 !!---------------------------------------------------------------------- 73 75 … … 135 137 IF(lwp) WRITE(numout,*) ' initial state used (=0) ' 136 138 IF(lwp) WRITE(numout,*) ' climatology (true) or not:', ln_obc_clim 139 IF(lwp) WRITE(numout,*) ' ' 140 IF(lwp) WRITE(numout,*) ' WARNING ' 141 IF(lwp) WRITE(numout,*) ' Flather"s algorithm is applied with explicit free surface scheme ' 142 IF(lwp) WRITE(numout,*) ' or with free surface time-splitting scheme ' 143 IF(lwp) WRITE(numout,*) ' Nor radiation neither relaxation is allowed with explicit free surface scheme: ' 144 IF(lwp) WRITE(numout,*) ' Radiation and/or relaxation is allowed with free surface time-splitting scheme ' 145 IF(lwp) WRITE(numout,*) ' depending of the choice of rdpXin = rdpXob = 0. for open boundaries ' 146 IF(lwp) WRITE(numout,*) ' ' 147 IF(lwp) WRITE(numout,*) ' For the rigid-lid case or the filtered free surface case, ' 148 IF(lwp) WRITE(numout,*) ' radiation, relaxation or presciption of data can be applied ' 137 149 IF( lwp.AND.lp_obc_east ) THEN 138 150 WRITE(numout,*) ' East open boundary :' … … 317 329 !... (jpjed,jpjefm1),jpieob 318 330 DO jj = nje0, nje1m1 319 # if defined key_dynspg_fsc 331 # if defined key_dynspg_rl 332 DO ji = nie0, nie1 333 # else 320 334 DO ji = nie0p1, nie1p1 321 # else322 DO ji = nie0, nie1323 335 # endif 324 336 bmask(ji,jj) = 0.e0 … … 368 380 IF( lp_obc_north ) THEN 369 381 ! ... jpjnob,(jpind,jpisfm1) 370 # if defined key_dynspg_fsc 382 # if defined key_dynspg_rl 383 DO jj = njn0, njn1 384 # else 371 385 DO jj = njn0p1, njn1p1 372 # else373 DO jj = njn0, njn1374 386 # endif 375 387 DO ji = nin0, nin1m1 … … 418 430 END IF 419 431 420 # if defined key_dynspg_f sc432 # if defined key_dynspg_flt 421 433 422 434 ! ... Initialize obcumask and obcvmask for the Force filtering 423 ! boundary condition in dynspg_f sc435 ! boundary condition in dynspg_flt 424 436 obcumask(:,:) = umask(:,:,1) 425 437 obcvmask(:,:) = vmask(:,:,1) … … 502 514 END IF 503 515 504 ! 3.1 Total lateral surface for each open boundary 505 ! ------------------------------------------------ 506 507 obcsurftot = 0.e0 508 509 IF( lp_obc_west ) THEN ! ... West open boundary vertical surface 510 DO ji = niw0, niw1 511 DO jj = 1, jpj 512 obcsurftot = obcsurftot+hu(ji,jj)*e2u(ji,jj)*uwmsk(jj,1) 513 END DO 514 END DO 515 END IF 516 517 IF( lp_obc_east ) THEN ! ... East open boundary vertical surface 518 DO ji = nie0, nie1 519 DO jj = 1, jpj 520 obcsurftot = obcsurftot+hu(ji,jj)*e2u(ji,jj)*uemsk(jj,1) 521 END DO 522 END DO 523 END IF 524 525 IF( lp_obc_north ) THEN ! ... North open boundary vertical surface 526 DO jj = njn0, njn1 527 DO ji = 1, jpi 528 obcsurftot = obcsurftot+hv(ji,jj)*e1v(ji,jj)*vnmsk(ji,1) 529 END DO 530 END DO 531 END IF 532 533 IF( lp_obc_south ) THEN ! ... South open boundary vertical surface 534 DO jj = njs0, njs1 535 DO ji = 1, jpi 536 obcsurftot = obcsurftot+hv(ji,jj)*e1v(ji,jj)*vsmsk(ji,1) 537 END DO 538 END DO 539 END IF 540 IF( lk_mpp ) CALL mpp_sum( obcsurftot ) ! sum over the global domain 541 516 # endif 517 518 # if ! defined key_dynspg_rl 519 520 IF ( ln_vol_cst ) THEN 521 522 ! 3.1 Total lateral surface for each open boundary 523 ! ------------------------------------------------ 524 525 ! ... West open boundary surface 526 IF( lp_obc_west ) THEN 527 DO ji = niw0, niw1 528 DO jj = 1, jpj 529 obcsurftot = obcsurftot+hu(ji,jj)*e2u(ji,jj)*uwmsk(jj,1) 530 END DO 531 END DO 532 END IF 533 534 ! ... East open boundary surface 535 IF( lp_obc_east ) THEN 536 DO ji = nie0, nie1 537 DO jj = 1, jpj 538 obcsurftot = obcsurftot+hu(ji,jj)*e2u(ji,jj)*uemsk(jj,1) 539 END DO 540 END DO 541 END IF 542 543 ! ... North open boundary vertical surface 544 IF( lp_obc_north ) THEN 545 DO jj = njn0, njn1 546 DO ji = 1, jpi 547 obcsurftot = obcsurftot+hv(ji,jj)*e1v(ji,jj)*vnmsk(ji,1) 548 END DO 549 END DO 550 END IF 551 552 ! ... South open boundary vertical surface 553 IF( lp_obc_south ) THEN 554 DO jj = njs0, njs1 555 DO ji = 1, jpi 556 obcsurftot = obcsurftot+hv(ji,jj)*e1v(ji,jj)*vsmsk(ji,1) 557 END DO 558 END DO 559 END IF 560 IF( lk_mpp ) CALL mpp_sum( obcsurftot ) ! sum over the global domain 561 ENDIF 542 562 # endif 543 563 … … 712 732 END IF 713 733 714 # if ! defined key_dynspg_fsc734 # if defined key_dynspg_rl 715 735 ! 7. Isolated coastline arrays initialization (rigid lid case only) 716 736 ! ----------------------------------------------------------------- -
trunk/NEMO/OPA_SRC/OBC/obcrad.F90
r247 r367 134 134 ! ... fields nit <== now (kt+1) 135 135 ! ... Total or baroclinic velocity at b, bm and bm2 136 # if ! defined key_dynspg_fsc136 # if defined key_dynspg_rl 137 137 zucb = uclie(jj,jk) 138 138 # else 139 139 zucb = un(ji,jj,jk) 140 140 # endif 141 # if ! defined key_dynspg_fsc141 # if defined key_dynspg_rl 142 142 zucbm = un(ji-1,jj,jk) + hur(ji-1,jj) / e2u(ji-1,jj) & 143 143 * ( bsfn(ji-1,jj) - bsfn(ji-1,jj-1) ) … … 145 145 zucbm = un(ji-1,jj,jk) 146 146 # endif 147 # if ! defined key_dynspg_fsc147 # if defined key_dynspg_rl 148 148 zucbm2 = un(ji-2,jj,jk) + hur(ji-2,jj) / e2u(ji-2,jj) & 149 149 * ( bsfn(ji-2,jj) - bsfn(ji-2,jj-1) ) … … 412 412 uwbnd(jj,jk,nibm2,nitm) = uwbnd(jj,jk,nibm2,nit)*uwmsk(jj,jk) 413 413 ! ... total or baroclinic velocity at b, bm and bm2 414 # if ! defined key_dynspg_fsc414 # if defined key_dynspg_rl 415 415 zucb = ucliw(jj,jk) 416 416 # else 417 417 zucb = un (ji,jj,jk) 418 418 # endif 419 # if ! defined key_dynspg_fsc419 # if defined key_dynspg_rl 420 420 zucbm = un (ji+1,jj,jk) + hur (ji+1,jj) / e2u (ji+1,jj) & 421 421 * ( bsfn(ji+1,jj) - bsfn(ji+1,jj-1) ) … … 423 423 zucbm = un (ji+1,jj,jk) 424 424 # endif 425 # if ! defined key_dynspg_fsc425 # if defined key_dynspg_rl 426 426 zucbm2 = un (ji+2,jj,jk) + hur (ji+2,jj) / e2u (ji+2,jj) & 427 427 * ( bsfn(ji+2,jj) - bsfn(ji+2,jj-1) ) … … 738 738 ! ... fields nit <== now (kt+1) 739 739 ! ... total or baroclinic velocity at b, bm and bm2 740 # if ! defined key_dynspg_fsc740 # if defined key_dynspg_rl 741 741 zvcb = vclin(ji,jk) 742 742 # else 743 743 zvcb = vn (ji,jj,jk) 744 744 # endif 745 # if ! defined key_dynspg_fsc745 # if defined key_dynspg_rl 746 746 zvcbm = vn (ji,jj-1,jk) - hvr (ji,jj-1) / e1v (ji,jj-1) & 747 747 * ( bsfn(ji,jj-1) - bsfn(ji-1,jj-1) ) … … 749 749 zvcbm = vn (ji,jj-1,jk) 750 750 # endif 751 # if ! defined key_dynspg_fsc751 # if defined key_dynspg_rl 752 752 zvcbm2 = vn (ji,jj-2,jk) - hvr (ji,jj-2) / e1v (ji,jj-2) & 753 753 * ( bsfn(ji,jj-2) - bsfn(ji-1,jj-2) ) … … 1026 1026 vsbnd(ji,jk,nibm2,nitm) = vsbnd(ji,jk,nibm2,nit)*vsmsk(ji,jk) 1027 1027 ! ... total or baroclinic velocity at b, bm and bm2 1028 # if ! defined key_dynspg_fsc1028 # if defined key_dynspg_rl 1029 1029 zvcb = vclis(ji,jk) 1030 1030 # else 1031 1031 zvcb = vn (ji,jj,jk) 1032 1032 # endif 1033 # if ! defined key_dynspg_fsc1033 # if defined key_dynspg_rl 1034 1034 zvcbm = vn (ji,jj+1,jk) - hvr (ji,jj+1) / e1v (ji,jj+1) & 1035 1035 * ( bsfn(ji,jj+1) - bsfn(ji-1,jj+1) ) … … 1037 1037 zvcbm = vn (ji,jj+1,jk) 1038 1038 # endif 1039 # if ! defined key_dynspg_fsc1039 # if defined key_dynspg_rl 1040 1040 zvcbm2 = vn (ji,jj+2,jk) - hvr (ji,jj+2) / e1v (ji,jj+2) & 1041 1041 * ( bsfn(ji,jj+2) - bsfn(ji-1,jj+2) ) -
trunk/NEMO/OPA_SRC/OBC/obcrst.F90
r247 r367 130 130 PRINT *,'Narea =',narea,' write jrec =2 east' 131 131 WRITE(inum,REC=jrec) & 132 # if ! defined key_dynspg_fsc132 # if defined key_dynspg_rl 133 133 (( bebnd(jfoe, jb,jt), jb=1,3),jt=1,3), & 134 134 # endif … … 145 145 jrec = 2 + jj + njmpp -1 -jpjed 146 146 WRITE (inum,REC=jrec) & 147 # if ! defined key_dynspg_fsc147 # if defined key_dynspg_rl 148 148 (( bebnd(jfoe, jb,jt), jb=1,3),jt=1,3), & 149 149 # endif … … 175 175 PRINT *,'Narea =',narea,' write jrec =',jrec,' west' 176 176 WRITE (inum,REC=jrec) & 177 # if ! defined key_dynspg_fsc177 # if defined key_dynspg_rl 178 178 (( bwbnd(jfow, jb,jt), jb=1,3),jt=1,3), & 179 179 # endif … … 190 190 jrec = 3 + jpjef -jpjed + jj + njmpp -1 -jpjwd 191 191 WRITE (inum,REC=jrec) & 192 # if ! defined key_dynspg_fsc192 # if defined key_dynspg_rl 193 193 (( bwbnd(jfow, jb,jt), jb=1,3),jt=1,3), & 194 194 # endif … … 219 219 ifon = jpind -nimpp +1 220 220 WRITE (inum,REC=jrec) & 221 # if ! defined key_dynspg_fsc221 # if defined key_dynspg_rl 222 222 (( bnbnd(ifon, jb,jt), jb=1,3),jt=1,3), & 223 223 # endif … … 234 234 jrec = 4 + jpjef -jpjed + jpjwf -jpjwd +ji + nimpp -1 -jpind 235 235 WRITE (inum,REC=jrec) & 236 # if ! defined key_dynspg_fsc236 # if defined key_dynspg_rl 237 237 (( bnbnd(ifon, jb,jt), jb=1,3),jt=1,3), & 238 238 # endif … … 264 264 ifos = jpisd -nimpp + 1 265 265 WRITE (inum,REC=jrec) & 266 # if ! defined key_dynspg_fsc266 # if defined key_dynspg_rl 267 267 (( bsbnd(ifos, jb,jt), jb=1,3),jt=1,3), & 268 268 # endif … … 280 280 ji + nimpp -1 -jpisd 281 281 WRITE (inum,REC=jrec) & 282 # if ! defined key_dynspg_fsc282 # if defined key_dynspg_rl 283 283 (( bsbnd(ifos, jb,jt), jb=1,3),jt=1,3), & 284 284 # endif … … 520 520 jfoe = jpjed -njmpp + 1 521 521 READ (inum,REC=jrec) & 522 # if ! defined key_dynspg_fsc522 # if defined key_dynspg_rl 523 523 (( bebnd(jfoe, jb,jt), jb=1,3),jt=1,3), & 524 524 # endif … … 535 535 jrec = 2 + jj + njmpp -1 -jpjed 536 536 READ (inum,REC=jrec) & 537 # if ! defined key_dynspg_fsc537 # if defined key_dynspg_rl 538 538 (( bebnd(jfoe, jb,jt), jb=1,3),jt=1,3), & 539 539 # endif … … 562 562 jfow = jpjwd -njmpp + 1 563 563 READ (inum,REC=jrec) & 564 # if ! defined key_dynspg_fsc564 # if defined key_dynspg_rl 565 565 (( bwbnd(jfow, jb,jt), jb=1,3),jt=1,3), & 566 566 # endif … … 577 577 jrec = 3 + jpjef -jpjed + jj + njmpp -1 -jpjwd 578 578 READ (inum,REC=jrec) & 579 # if ! defined key_dynspg_fsc579 # if defined key_dynspg_rl 580 580 (( bwbnd(jfow, jb,jt), jb=1,3),jt=1,3), & 581 581 # endif … … 604 604 ifon = jpind -nimpp +1 605 605 READ (inum,REC=jrec) & 606 # if ! defined key_dynspg_fsc606 # if defined key_dynspg_rl 607 607 (( bnbnd(ifon, jb,jt), jb=1,3),jt=1,3), & 608 608 # endif … … 619 619 jrec = 4 + jpjef -jpjed + jpjwf -jpjwd +ji + nimpp -1 -jpind 620 620 READ (inum,REC=jrec) & 621 # if ! defined key_dynspg_fsc621 # if defined key_dynspg_rl 622 622 (( bnbnd(ifon, jb,jt), jb=1,3),jt=1,3), & 623 623 # endif … … 646 646 ifos = jpisd -nimpp + 1 647 647 READ (inum,REC=jrec) & 648 # if ! defined key_dynspg_fsc648 # if defined key_dynspg_rl 649 649 (( bsbnd(ifos, jb,jt), jb=1,3),jt=1,3), & 650 650 # endif … … 662 662 ji + nimpp -1 -jpisd 663 663 READ (inum,REC=jrec) & 664 # if ! defined key_dynspg_fsc664 # if defined key_dynspg_rl 665 665 (( bsbnd(ifos, jb,jt), jb=1,3),jt=1,3), & 666 666 # endif … … 680 680 IF( lk_mpp ) THEN 681 681 IF( lp_obc_east ) THEN 682 # if ! defined key_dynspg_fsc682 # if defined key_dynspg_rl 683 683 CALL mppobc(bebnd,jpjed,jpjef,jpieob,3*3,2,jpj) 684 684 # endif … … 689 689 ENDIF 690 690 IF( lp_obc_west ) THEN 691 # if ! defined key_dynspg_fsc691 # if defined key_dynspg_rl 692 692 CALL mppobc(bwbnd,jpjwd,jpjwf,jpiwob,3*3,2,jpj) 693 693 # endif … … 698 698 ENDIF 699 699 IF( lp_obc_north ) THEN 700 # if ! defined key_dynspg_fsc700 # if defined key_dynspg_rl 701 701 CALL mppobc(bnbnd,jpind,jpinf,jpjnob ,3*3 ,1,jpi) 702 702 # endif … … 707 707 ENDIF 708 708 IF( lp_obc_south ) THEN 709 # if ! defined key_dynspg_fsc709 # if defined key_dynspg_rl 710 710 CALL mppobc(bsbnd,jpisd,jpisf,jpjsob, 3*3,1,jpi) 711 711 # endif -
trunk/NEMO/OPA_SRC/OBC/obcvol.F90
r247 r367 4 4 !! Ocean dynamic : Volume constraint when OBC and Free surface are used 5 5 !!================================================================================= 6 #if defined key_obc && defined key_dynspg_fsc6 #if defined key_obc && ! defined key_dynspg_rl 7 7 !!--------------------------------------------------------------------------------- 8 8 !! 'key_obc' and open boundary conditions 9 !! 'key_dynspg_f sc' constant volume free surface9 !! 'key_dynspg_flt' constant volume free surface 10 10 !!--------------------------------------------------------------------------------- 11 11 !! * Modules used … … 22 22 23 23 !! * Accessibility 24 PUBLIC obc_vol ! routine called by dynspg_f sc.h9024 PUBLIC obc_vol ! routine called by dynspg_flt 25 25 26 26 !! * Substitutions … … 40 40 !! 41 41 !! ** Purpose : 42 !! This routine is called in dynspg_f scto control42 !! This routine is called in dynspg_flt to control 43 43 !! the volume of the system. A correction velocity is calculated 44 44 !! to correct the total transport through the OBC.
Note: See TracChangeset
for help on using the changeset viewer.