Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcdta.F90
- Timestamp:
- 2011-03-30T17:58:35+02:00 (13 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcdta.F90 (modified) (13 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcdta.F90
r2528 r2715 4 4 !! Open boundary data : read the data for the open boundaries. 5 5 !!============================================================================== 6 !! History : OPA ! 1998-05 (J.M. Molines) Original code 7 !! 8.5 ! 2002-10 (C. Talandier, A-M. Treguier) Free surface, F90 8 !! NEMO 1.0 ! 2004-06 (F. Durand, A-M. Treguier) Netcdf BC files on input 9 !! 3.0 ! 2007-2008 (C. Langlais, P. Mathiot, J.M. Molines) high frequency boundaries data 10 !!------------------------------------------------------------------------------ 6 11 #if defined key_obc 7 12 !!------------------------------------------------------------------------------ … … 10 15 !! obc_dta : read u, v, t, s data along each open boundary 11 16 !!------------------------------------------------------------------------------ 12 !! * Modules used13 17 USE oce ! ocean dynamics and tracers 14 18 USE dom_oce ! ocean space and time domain … … 19 23 USE in_out_manager ! I/O logical units 20 24 USE lib_mpp ! distributed memory computing 21 USE dynspg_oce 25 USE dynspg_oce ! ocean: surface pressure gradient 22 26 USE ioipsl ! now only for ymds2ju function 23 27 USE iom ! … … 26 30 PRIVATE 27 31 28 !! * Accessibility 29 PUBLIC obc_dta ! routines called by step.F90 30 PUBLIC obc_dta_bt ! routines called by dynspg_ts.F90 31 32 !! * Shared module variables 33 REAL(wp), DIMENSION(2) :: zjcnes_obc ! 34 REAL(wp), DIMENSION(:), ALLOCATABLE :: ztcobc 32 PUBLIC obc_dta ! routine called by step.F90 33 PUBLIC obc_dta_bt ! routine called by dynspg_ts.F90 34 PUBLIC obc_dta_alloc ! function called by obcini.F90 35 36 REAL(wp), DIMENSION(2) :: zjcnes_obc ! 37 REAL(wp), DIMENSION(:), ALLOCATABLE :: ztcobc 35 38 REAL(wp) :: rdt_obc 36 39 REAL(wp) :: zjcnes … … 39 42 INTEGER :: itobce, itobcw, itobcs, itobcn, itobc_b ! number of time steps in OBC files 40 43 41 INTEGER :: & 42 ntobc , & !: where we are in the obc file 43 ntobc_b , & !: first record used 44 ntobc_a !: second record used 45 46 CHARACTER (len=40) :: & ! name of data files 47 cl_obc_eTS , cl_obc_eU, & 48 cl_obc_wTS , cl_obc_wU, & 49 cl_obc_nTS , cl_obc_nV, & 50 cl_obc_sTS , cl_obc_sV 51 52 # if defined key_dynspg_ts 44 INTEGER :: ntobc ! where we are in the obc file 45 INTEGER :: ntobc_b ! first record used 46 INTEGER :: ntobc_a ! second record used 47 48 CHARACTER (len=40) :: cl_obc_eTS, cl_obc_eU ! name of data files 49 CHARACTER (len=40) :: cl_obc_wTS, cl_obc_wU ! - - 50 CHARACTER (len=40) :: cl_obc_nTS, cl_obc_nV ! - - 51 CHARACTER (len=40) :: cl_obc_sTS, cl_obc_sV ! - - 52 53 53 ! bt arrays for interpolating time dependent data on the boundaries 54 INTEGER :: nt_m=0, ntobc_m55 REAL(wp), DIMENSION(jpj,0:jptobc) :: ubtedta, vbtedta, sshedta! East56 REAL(wp), DIMENSION(jpj,0:jptobc) :: ubtwdta, vbtwdta, sshwdta! West57 REAL(wp), DIMENSION(jpi,0:jptobc) :: ubtndta, vbtndta, sshndta! North58 REAL(wp), DIMENSION(jpi,0:jptobc) :: ubtsdta, vbtsdta, sshsdta! South54 INTEGER :: nt_m=0, ntobc_m 55 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ubtedta, vbtedta, sshedta ! East 56 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ubtwdta, vbtwdta, sshwdta ! West 57 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ubtndta, vbtndta, sshndta ! North 58 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ubtsdta, vbtsdta, sshsdta ! South 59 59 ! arrays used for interpolating time dependent data on the boundaries 60 REAL(wp), DIMENSION(jpj,jpk,0:jptobc) :: uedta, vedta, tedta, sedta ! East 61 REAL(wp), DIMENSION(jpj,jpk,0:jptobc) :: uwdta, vwdta, twdta, swdta ! West 62 REAL(wp), DIMENSION(jpi,jpk,0:jptobc) :: undta, vndta, tndta, sndta ! North 63 REAL(wp), DIMENSION(jpi,jpk,0:jptobc) :: usdta, vsdta, tsdta, ssdta ! South 64 # else 65 ! bt arrays for interpolating time dependent data on the boundaries 66 REAL(wp), DIMENSION(jpj,jptobc) :: ubtedta, vbtedta, sshedta ! East 67 REAL(wp), DIMENSION(jpj,jptobc) :: ubtwdta, vbtwdta, sshwdta ! West 68 REAL(wp), DIMENSION(jpi,jptobc) :: ubtndta, vbtndta, sshndta ! North 69 REAL(wp), DIMENSION(jpi,jptobc) :: ubtsdta, vbtsdta, sshsdta ! South 70 ! arrays used for interpolating time dependent data on the boundaries 71 REAL(wp), DIMENSION(jpj,jpk,jptobc) :: uedta, vedta, tedta, sedta ! East 72 REAL(wp), DIMENSION(jpj,jpk,jptobc) :: uwdta, vwdta, twdta, swdta ! West 73 REAL(wp), DIMENSION(jpi,jpk,jptobc) :: undta, vndta, tndta, sndta ! North 74 REAL(wp), DIMENSION(jpi,jpk,jptobc) :: usdta, vsdta, tsdta, ssdta ! South 75 # endif 76 LOGICAL, DIMENSION (jpj,jpk ) :: ltemsk=.TRUE., luemsk=.TRUE., lvemsk=.TRUE. ! boolean msks 77 LOGICAL, DIMENSION (jpj,jpk ) :: ltwmsk=.TRUE., luwmsk=.TRUE., lvwmsk=.TRUE. ! used for outliers 78 LOGICAL, DIMENSION (jpi,jpk ) :: ltnmsk=.TRUE., lunmsk=.TRUE., lvnmsk=.TRUE. ! checks 79 LOGICAL, DIMENSION (jpi,jpk ) :: ltsmsk=.TRUE., lusmsk=.TRUE., lvsmsk=.TRUE. 60 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uedta, vedta, tedta, sedta ! East 61 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uwdta, vwdta, twdta, swdta ! West 62 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: undta, vndta, tndta, sndta ! North 63 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: usdta, vsdta, tsdta, ssdta ! South 64 65 ! Masks set to .TRUE. after successful allocation below 66 LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:) :: ltemsk, luemsk, lvemsk ! boolean msks 67 LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:) :: ltwmsk, luwmsk, lvwmsk ! used for outliers 68 LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:) :: ltnmsk, lunmsk, lvnmsk ! checks 69 LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:) :: ltsmsk, lusmsk, lvsmsk 80 70 81 71 !! * Substitutions … … 85 75 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 86 76 !! $Id$ 87 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)77 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 88 78 !!---------------------------------------------------------------------- 89 90 79 CONTAINS 80 81 INTEGER FUNCTION obc_dta_alloc() 82 !!------------------------------------------------------------------- 83 !! *** ROUTINE obc_dta_alloc *** 84 !!------------------------------------------------------------------- 85 INTEGER :: ierr(2) 86 !!------------------------------------------------------------------- 87 # if defined key_dynspg_ts 88 ALLOCATE( & ! time-splitting : 0:jptobc 89 ! bt arrays for interpolating time dependent data on the boundaries 90 & ubtedta (jpj,0:jptobc) , vbtedta (jpj,0:jptobc) , sshedta (jpj,0:jptobc) , & 91 & ubtwdta (jpj,0:jptobc) , vbtwdta (jpj,0:jptobc) , sshwdta (jpj,0:jptobc) , & 92 & ubtndta (jpi,0:jptobc) , vbtndta (jpi,0:jptobc) , sshndta (jpi,0:jptobc) , & 93 & ubtsdta (jpi,0:jptobc) , vbtsdta (jpi,0:jptobc) , sshsdta (jpi,0:jptobc) , & 94 ! arrays used for interpolating time dependent data on the boundaries 95 & uedta(jpj,jpk,0:jptobc) , vedta(jpj,jpk,0:jptobc) , & 96 & tedta(jpj,jpk,0:jptobc) , sedta(jpj,jpk,0:jptobc) , & 97 & uwdta(jpj,jpk,0:jptobc) , vwdta(jpj,jpk,0:jptobc) , & 98 & twdta(jpj,jpk,0:jptobc) , swdta(jpj,jpk,0:jptobc) , & 99 & undta(jpi,jpk,0:jptobc) , vndta(jpi,jpk,0:jptobc) , & 100 & tndta(jpi,jpk,0:jptobc) , sndta(jpi,jpk,0:jptobc) , & 101 & usdta(jpi,jpk,0:jptobc) , vsdta(jpi,jpk,0:jptobc) , & 102 & tsdta(jpi,jpk,0:jptobc) , ssdta(jpi,jpk,0:jptobc) , STAT=ierr(1) ) 103 # else 104 ALLOCATE( & ! no time splitting : 1:jptobc 105 ! bt arrays for interpolating time dependent data on the boundaries 106 & ubtedta (jpj,jptobc) , vbtedta (jpj,jptobc) , sshedta (jpj,jptobc) , & 107 & ubtwdta (jpj,jptobc) , vbtwdta (jpj,jptobc) , sshwdta (jpj,jptobc) , & 108 & ubtndta (jpi,jptobc) , vbtndta (jpi,jptobc) , sshndta (jpi,jptobc) , & 109 & ubtsdta (jpi,jptobc) , vbtsdta (jpi,jptobc) , sshsdta (jpi,jptobc) , & 110 ! arrays used for interpolating time dependent data on the boundaries 111 & uedta(jpj,jpk,jptobc) , vedta(jpj,jpk,jptobc) , & 112 & tedta(jpj,jpk,jptobc) , sedta(jpj,jpk,jptobc) , & 113 & uwdta(jpj,jpk,jptobc) , vwdta(jpj,jpk,jptobc) , & 114 & twdta(jpj,jpk,jptobc) , swdta(jpj,jpk,jptobc) , & 115 & undta(jpi,jpk,jptobc) , vndta(jpi,jpk,jptobc) , & 116 & tndta(jpi,jpk,jptobc) , sndta(jpi,jpk,jptobc) , & 117 & usdta(jpi,jpk,jptobc) , vsdta(jpi,jpk,jptobc) , & 118 & tsdta(jpi,jpk,jptobc) , ssdta(jpi,jpk,jptobc) , STAT=ierr(1) ) 119 # endif 120 121 ALLOCATE( ltemsk(jpj,jpk) , luemsk(jpj,jpk) , lvemsk(jpj,jpk) , & 122 & ltwmsk(jpj,jpk) , luwmsk(jpj,jpk) , lvwmsk(jpj,jpk) , & 123 & ltnmsk(jpj,jpk) , lunmsk(jpj,jpk) , lvnmsk(jpj,jpk) , & 124 & ltsmsk(jpj,jpk) , lusmsk(jpj,jpk) , lvsmsk(jpj,jpk) , STAT=ierr(2) ) 125 126 obc_dta_alloc = MAXVAL( ierr ) 127 IF( lk_mpp ) CALL mpp_sum( obc_dta_alloc ) 128 129 IF( obc_dta_alloc == 0 ) THEN ! Initialise mask values following successful allocation 130 ! east ! west ! north ! south ! 131 ltemsk(:,:) = .TRUE. ; ltwmsk(:,:) = .TRUE. ; ltnmsk(:,:) = .TRUE. ; ltsmsk(:,:) = .TRUE. 132 luemsk(:,:) = .TRUE. ; luwmsk(:,:) = .TRUE. ; lunmsk(:,:) = .TRUE. ; lusmsk(:,:) = .TRUE. 133 lvemsk(:,:) = .TRUE. ; lvwmsk(:,:) = .TRUE. ; lvnmsk(:,:) = .TRUE. ; lvsmsk(:,:) = .TRUE. 134 END IF 135 ! 136 END FUNCTION obc_dta_alloc 137 91 138 92 139 SUBROUTINE obc_dta( kt ) … … 106 153 !! attribute of variable time_counter). 107 154 !! 108 !!109 !! History :110 !! ! 98-05 (J.M. Molines) Original code111 !! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90112 !!113 !! 9.0 ! 04-06 (F. Durand, A-M. Treguier) Netcdf BC files on input114 !! ! 2007-2008 (C. Langlais, P. Mathiot, J.M. Molines) high frequency boundaries data115 155 !!--------------------------------------------------------------------------- 116 !! * Arguments117 156 INTEGER, INTENT( in ) :: kt ! ocean time-step index 118 119 !! * Local declarations 157 ! 120 158 INTEGER, SAVE :: immfile, iyyfile ! 121 159 INTEGER :: nt ! record indices (incrementation) 122 160 REAL(wp) :: zsec, zxy, znum, zden ! time interpolation weight 123 124 161 !!--------------------------------------------------------------------------- 125 162 … … 227 264 228 265 229 SUBROUTINE obc_dta_ini (kt)266 SUBROUTINE obc_dta_ini( kt ) 230 267 !!----------------------------------------------------------------------------- 231 268 !! *** SUBROUTINE obc_dta_ini *** 232 269 !! 233 !! ** Purpose : 234 !! When obc_dta first call, realize some data initialization 235 !! 236 !! ** Method : 237 !! 238 !! History : 239 !! 9.0 ! 07-10 (J.M. Molines ) 270 !! ** Purpose : When obc_dta first call, realize some data initialization 240 271 !!---------------------------------------------------------------------------- 241 !! * Argument242 272 INTEGER, INTENT(in) :: kt ! ocean time-step index 243 244 !! * Local declarations 273 ! 245 274 INTEGER :: ji, jj ! dummy loop indices 246 275 INTEGER, SAVE :: immfile, iyyfile ! … … 521 550 !! Data at the boundary must be in m2/s 522 551 !! 523 !! History : 524 !! 9.0 ! 05-11 (V. garnier) Original code 552 !! History : 9.0 ! 05-11 (V. garnier) Original code 525 553 !!--------------------------------------------------------------------------- 526 !! * Arguments527 554 INTEGER, INTENT( in ) :: kt ! ocean time-step index 528 555 INTEGER, INTENT( in ) :: kbt ! barotropic ocean time-step index 529 530 !! * Local declarations 556 ! 531 557 INTEGER :: ji, jj ! dummy loop indices 532 558 INTEGER :: i15 … … 534 560 REAL(wp) :: zxy 535 561 INTEGER :: isrel ! number of seconds since 1/1/1992 536 537 562 !!--------------------------------------------------------------------------- 538 563 … … 1096 1121 END SUBROUTINE obc_read 1097 1122 1123 1098 1124 INTEGER FUNCTION nrecbef() 1099 1125 !!----------------------------------------------------------------------- … … 1127 1153 END FUNCTION nrecbef 1128 1154 1129 !!============================================================================== 1155 1130 1156 SUBROUTINE obc_depth_average(nt_x) 1131 1157 !!----------------------------------------------------------------------- … … 1212 1238 END SUBROUTINE obc_dta 1213 1239 #endif 1240 !!============================================================================== 1214 1241 END MODULE obcdta
Note: See TracChangeset
for help on using the changeset viewer.
