Changeset 2209
- Timestamp:
- 2010-10-12T11:51:26+02:00 (14 years ago)
- Location:
- branches/devmercator2010_1/NEMO
- Files:
-
- 19 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/devmercator2010_1/NEMO/LIM_SRC_2/limtrp_2.F90
r2137 r2209 134 134 !!gm this has been changed in the reference to become odd and even ice time step 135 135 136 IF( MOD( nday , 2 ) == 0) THEN136 IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0) THEN !== odd ice time step: adv_x then adv_y ==! 137 137 DO jk = 1,initad 138 138 CALL lim_adv_x_2( zusnit, zui_u, rone , zsm, zs0ice, sxice, sxxice, syice, syyice, sxyice ) -
branches/devmercator2010_1/NEMO/OFF_SRC/IOM/iom_ioipsl.F90
r1749 r2209 81 81 iln = INDEX( cdname, '.nc' ) 82 82 IF( ldwrt ) THEN ! the file should be open in write mode so we create it... 83 IF( llclobber ) THEN ; clstatus = 'REPLACE '84 ELSE ; clstatus = 'NEW '83 IF( llclobber ) THEN ; clstatus = 'REPLACE 64' 84 ELSE ; clstatus = 'NEW 64' 85 85 ENDIF 86 86 IF( jpnij > 1 ) THEN -
branches/devmercator2010_1/NEMO/OFF_SRC/IOM/iom_nf90.F90
r1749 r2209 94 94 IF(lwp) WRITE(numout,*) TRIM(clinfo)//' create new file: '//TRIM(cdname)//' in WRITE mode' 95 95 96 IF( llclobber ) THEN ; imode = NF90_CLOBBER97 ELSE ; imode = NF90_NOCLOBBER96 IF( llclobber ) THEN ; imode = IOR( NF90_64BIT_OFFSET, NF90_CLOBBER ) 97 ELSE ; imode = IOR( NF90_64BIT_OFFSET, NF90_NOCLOBBER ) 98 98 ENDIF 99 99 CALL iom_nf90_check(NF90_CREATE( TRIM(cdname), imode, if90id, chunksize = ichunk ), clinfo) -
branches/devmercator2010_1/NEMO/OPA_SRC/DIA/diawri.F90
r2137 r2209 492 492 493 493 ! Write fields on T grid 494 CALL histwrite( nid_T, "votemper", it, t _dta, ndim_T , ndex_T ) ! temperature495 CALL histwrite( nid_T, "vosaline", it, s _dta, ndim_T , ndex_T ) ! salinity494 CALL histwrite( nid_T, "votemper", it, tn , ndim_T , ndex_T ) ! temperature 495 CALL histwrite( nid_T, "vosaline", it, sn , ndim_T , ndex_T ) ! salinity 496 496 CALL histwrite( nid_T, "sosstsst", it, tn(:,:,1) , ndim_hT, ndex_hT ) ! sea surface temperature 497 497 CALL histwrite( nid_T, "sosaline", it, sn(:,:,1) , ndim_hT, ndex_hT ) ! sea surface salinity -
branches/devmercator2010_1/NEMO/OPA_SRC/DOM/daymod.F90
r2131 r2209 258 258 ENDIF 259 259 260 IF( lrst_oce ) CALL day_rst( kt, 'WRITE' ) 260 CALL rst_opn( kt ) ! Open the restart file if needed and control lrst_oce 261 IF( lrst_oce ) CALL day_rst( kt, 'WRITE' ) ! write day restart information 261 262 ! 262 263 END SUBROUTINE day -
branches/devmercator2010_1/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r1779 r2209 595 595 vn_b (:,:) = vn_b(:,:) * hvr(:,:) 596 596 ENDIF 597 IF( iom_varid( numror, 'sshn_b', ldstop = .FALSE. ) > 0 ) THEN 598 CALL iom_get( numror, jpdom_autoglo, 'sshn_b' , sshn_b (:,:) ) ! filtered extrenal ssh 599 ELSE 600 sshn_b(:,:)=sshb(:,:) ! if not in restart set previous time mean to current baroclinic before value 601 ENDIF 597 602 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN 598 CALL iom_rstput( kt, nitrst, numrow, 'un_b' , un_b (:,:) ) ! external velocity issued 599 CALL iom_rstput( kt, nitrst, numrow, 'vn_b' , vn_b (:,:) ) ! from barotropic loop 603 CALL iom_rstput( kt, nitrst, numrow, 'un_b' , un_b (:,:) ) ! external velocity and ssh 604 CALL iom_rstput( kt, nitrst, numrow, 'vn_b' , vn_b (:,:) ) ! issued from barotropic loop 605 CALL iom_rstput( kt, nitrst, numrow, 'sshn_b' , sshn_b(:,:) ) ! 600 606 ENDIF 601 607 ! -
branches/devmercator2010_1/NEMO/OPA_SRC/IOM/iom_ioipsl.F90
r1488 r2209 81 81 iln = INDEX( cdname, '.nc' ) 82 82 IF( ldwrt ) THEN ! the file should be open in write mode so we create it... 83 IF( llclobber ) THEN ; clstatus = 'REPLACE '84 ELSE ; clstatus = 'NEW '83 IF( llclobber ) THEN ; clstatus = 'REPLACE 64' 84 ELSE ; clstatus = 'NEW 64' 85 85 ENDIF 86 86 IF( jpnij > 1 ) THEN -
branches/devmercator2010_1/NEMO/OPA_SRC/IOM/iom_nf90.F90
r1488 r2209 94 94 IF(lwp) WRITE(numout,*) TRIM(clinfo)//' create new file: '//TRIM(cdname)//' in WRITE mode' 95 95 96 IF( llclobber ) THEN ; imode = NF90_CLOBBER97 ELSE ; imode = NF90_NOCLOBBER96 IF( llclobber ) THEN ; imode = IOR( NF90_64BIT_OFFSET, NF90_CLOBBER ) 97 ELSE ; imode = IOR( NF90_64BIT_OFFSET, NF90_NOCLOBBER ) 98 98 ENDIF 99 99 CALL iom_nf90_check(NF90_CREATE( TRIM(cdname), imode, if90id, chunksize = ichunk ), clinfo) -
branches/devmercator2010_1/NEMO/OPA_SRC/LDF/ldfdyn_c1d.h90
r1152 r2209 27 27 28 28 !! * Local variables 29 INTEGER :: jk ! dummy loop indice 29 30 REAL(wp) :: zdam, zwam, zm00, zm01, zmhf, zmhs 30 31 REAL(wp) :: zahmf, zahms -
branches/devmercator2010_1/NEMO/OPA_SRC/OBC/obc_oce.F90
r2137 r2209 87 87 INTEGER :: nje1m2, nje0m1 !: do loop index in mpp case for jpjefm1-1,jpjed 88 88 89 REAL(wp), DIMENSION(jpj ed:jpjef) :: & !:89 REAL(wp), DIMENSION(jpj) :: & !: 90 90 sshfoe, & !: now climatology of the east boundary sea surface height 91 91 ubtfoe,vbtfoe !: now climatology of the east boundary barotropic transport … … 97 97 ! ! in the obcdyn.F90 routine 98 98 99 REAL(wp), DIMENSION(jp jed:jpjef,jpj) :: sshfoe_b !: east boundary ssh correction averaged over the barotropic loop100 ! 99 REAL(wp), DIMENSION(jpi,jpj) :: sshfoe_b !: east boundary ssh correction averaged over the barotropic loop 100 ! ! (if Flather's algoritm applied at open boundary) 101 101 102 102 !!------------------------------- … … 124 124 INTEGER :: njw1m2, njw0m1 !: do loop index in mpp case for jpjwfm2,jpjwd 125 125 126 REAL(wp), DIMENSION(jpj wd:jpjwf) :: & !:126 REAL(wp), DIMENSION(jpj) :: & !: 127 127 sshfow, & !: now climatology of the west boundary sea surface height 128 128 ubtfow,vbtfow !: now climatology of the west boundary barotropic transport … … 134 134 ! ! in the obcdyn.F90 routine 135 135 136 REAL(wp), DIMENSION(jp jwd:jpjwf,jpj) :: sshfow_b !: west boundary ssh correction averaged over the barotropic loop137 ! 136 REAL(wp), DIMENSION(jpi,jpj) :: sshfow_b !: west boundary ssh correction averaged over the barotropic loop 137 ! ! (if Flather's algoritm applied at open boundary) 138 138 139 139 !!------------------------------- … … 162 162 INTEGER :: njn0m1, njn1m1 !: do loop index in mpp case for jpnob-1 163 163 164 REAL(wp), DIMENSION(jpi nd:jpinf) :: & !:164 REAL(wp), DIMENSION(jpi) :: & !: 165 165 sshfon, & !: now climatology of the north boundary sea surface height 166 166 ubtfon,vbtfon !: now climatology of the north boundary barotropic transport … … 172 172 ! ! in yhe obcdyn.F90 routine 173 173 174 REAL(wp), DIMENSION(jpi nd:jpinf,jpj) :: sshfon_b !: north boundary ssh correction averaged over the barotropic loop175 ! 174 REAL(wp), DIMENSION(jpi,jpj) :: sshfon_b !: north boundary ssh correction averaged over the barotropic loop 175 ! ! (if Flather's algoritm applied at open boundary) 176 176 177 177 !!-------------------------------- … … 199 199 INTEGER :: njs0p1, njs1p1 !: do loop index in mpp case for jpsob+1 200 200 201 REAL(wp), DIMENSION(jpi sd:jpisf) :: & !:201 REAL(wp), DIMENSION(jpi) :: & !: 202 202 sshfos, & !: now climatology of the south boundary sea surface height 203 203 ubtfos,vbtfos !: now climatology of the south boundary barotropic transport … … 209 209 ! ! in the obcdyn.F90 routine 210 210 211 REAL(wp), DIMENSION(jpi sd:jpisf,jpj) :: sshfos_b !: south boundary ssh correction averaged over the barotropic loop212 ! 211 REAL(wp), DIMENSION(jpi,jpj) :: sshfos_b !: south boundary ssh correction averaged over the barotropic loop 212 ! ! (if Flather's algoritm applied at open boundary) 213 213 214 214 !!-------------------------------- -
branches/devmercator2010_1/NEMO/OPA_SRC/OBC/obcdta.F90
r2137 r2209 1 1 MODULE obcdta 2 !!==============================================================================3 !! *** MODULE obcdta ***4 !! Open boundary data : read the data for the open boundaries.5 !!==============================================================================2 !!============================================================================== 3 !! *** MODULE obcdta *** 4 !! Open boundary data : read the data for the open boundaries. 5 !!============================================================================== 6 6 #if defined key_obc 7 !!------------------------------------------------------------------------------ 8 !! 'key_obc' : Open Boundary Conditions 9 !!------------------------------------------------------------------------------ 10 !! obc_dta : read u, v, t, s data along each open boundary 11 !!------------------------------------------------------------------------------ 12 !! * Modules used 13 USE oce ! ocean dynamics and tracers 14 USE dom_oce ! ocean space and time domain 15 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 16 USE phycst ! physical constants 17 USE obc_oce ! ocean open boundary conditions 18 USE in_out_manager ! I/O logical units 19 USE lib_mpp ! distributed memory computing 20 USE dynspg_oce 21 USE ioipsl ! now only for ymds2ju function 22 USE iom ! 23 24 IMPLICIT NONE 25 PRIVATE 26 27 !! * Accessibility 28 PUBLIC obc_dta ! routines called by step.F90 29 PUBLIC obc_dta_bt ! routines called by dynspg_ts.F90 7 !!------------------------------------------------------------------------------ 8 !! 'key_obc' : Open Boundary Conditions 9 !!------------------------------------------------------------------------------ 10 !! obc_dta : read u, v, t, s data along each open boundary 11 !!------------------------------------------------------------------------------ 12 !! * Modules used 13 USE oce ! ocean dynamics and tracers 14 USE dom_oce ! ocean space and time domain 15 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 16 USE phycst ! physical constants 17 USE obc_par ! ocean open boundary conditions 18 USE obc_oce ! ocean open boundary conditions 19 USE in_out_manager ! I/O logical units 20 USE lib_mpp ! distributed memory computing 21 USE dynspg_oce 22 USE ioipsl ! now only for ymds2ju function 23 USE iom ! 24 25 IMPLICIT NONE 26 PRIVATE 27 28 !! * Accessibility 29 PUBLIC obc_dta ! routines called by step.F90 30 PUBLIC obc_dta_bt ! routines called by dynspg_ts.F90 30 31 31 32 !! * Shared module variables … … 40 41 INTEGER :: itobce, itobcw, itobcs, itobcn, itobc_b ! number of time steps in OBC files 41 42 42 INTEGER :: & 43 ntobc , & !: where we are in the obc file 44 ntobc_b , & !: first record used 45 ntobc_a !: second record used 46 47 CHARACTER (len=40) :: & ! name of data files 48 cl_obc_eTS , cl_obc_eU, & 49 cl_obc_wTS , cl_obc_wU, & 50 cl_obc_nTS , cl_obc_nV, & 51 cl_obc_sTS , cl_obc_sV 52 53 ! arrays used for interpolating time dependent data on the boundaries 54 REAL(wp), DIMENSION(jpj,jpk,jptobc) :: uedta, vedta, tedta, sedta ! East 55 REAL(wp), DIMENSION(jpj,jpk,jptobc) :: uwdta, vwdta, twdta, swdta ! West 56 REAL(wp), DIMENSION(jpi,jpk,jptobc) :: undta, vndta, tndta, sndta ! North 57 REAL(wp), DIMENSION(jpi,jpk,jptobc) :: usdta, vsdta, tsdta, ssdta ! South 58 59 LOGICAL, DIMENSION (jpj,jpk ) :: ltemsk=.TRUE., luemsk=.TRUE., lvemsk=.TRUE. ! boolean msks 60 LOGICAL, DIMENSION (jpj,jpk ) :: ltwmsk=.TRUE., luwmsk=.TRUE., lvwmsk=.TRUE. ! used for outliers 61 LOGICAL, DIMENSION (jpi,jpk ) :: ltnmsk=.TRUE., lunmsk=.TRUE., lvnmsk=.TRUE. ! checks 62 LOGICAL, DIMENSION (jpi,jpk ) :: ltsmsk=.TRUE., lusmsk=.TRUE., lvsmsk=.TRUE. 63 64 !! * Substitutions 43 INTEGER :: & 44 ntobc , & !: where we are in the obc file 45 ntobc_b , & !: first record used 46 ntobc_a !: second record used 47 48 CHARACTER (len=40) :: & ! name of data files 49 cl_obc_eTS , cl_obc_eU, & 50 cl_obc_wTS , cl_obc_wU, & 51 cl_obc_nTS , cl_obc_nV, & 52 cl_obc_sTS , cl_obc_sV 53 54 # if defined key_dynspg_ts 55 ! bt arrays for interpolating time dependent data on the boundaries 56 INTEGER :: nt_m=0, ntobc_m 57 REAL(wp), DIMENSION(jpj,0:jptobc) :: ubtedta, vbtedta, sshedta ! East 58 REAL(wp), DIMENSION(jpj,0:jptobc) :: ubtwdta, vbtwdta, sshwdta ! West 59 REAL(wp), DIMENSION(jpi,0:jptobc) :: ubtndta, vbtndta, sshndta ! North 60 REAL(wp), DIMENSION(jpi,0:jptobc) :: ubtsdta, vbtsdta, sshsdta ! South 61 ! arrays used for interpolating time dependent data on the boundaries 62 REAL(wp), DIMENSION(jpj,jpk,0:jptobc) :: uedta, vedta, tedta, sedta ! East 63 REAL(wp), DIMENSION(jpj,jpk,0:jptobc) :: uwdta, vwdta, twdta, swdta ! West 64 REAL(wp), DIMENSION(jpi,jpk,0:jptobc) :: undta, vndta, tndta, sndta ! North 65 REAL(wp), DIMENSION(jpi,jpk,0:jptobc) :: usdta, vsdta, tsdta, ssdta ! South 66 # else 67 ! bt arrays for interpolating time dependent data on the boundaries 68 REAL(wp), DIMENSION(jpj,jptobc) :: ubtedta, vbtedta, sshedta ! East 69 REAL(wp), DIMENSION(jpj,jptobc) :: ubtwdta, vbtwdta, sshwdta ! West 70 REAL(wp), DIMENSION(jpi,jptobc) :: ubtndta, vbtndta, sshndta ! North 71 REAL(wp), DIMENSION(jpi,jptobc) :: ubtsdta, vbtsdta, sshsdta ! South 72 ! arrays used for interpolating time dependent data on the boundaries 73 REAL(wp), DIMENSION(jpj,jpk,jptobc) :: uedta, vedta, tedta, sedta ! East 74 REAL(wp), DIMENSION(jpj,jpk,jptobc) :: uwdta, vwdta, twdta, swdta ! West 75 REAL(wp), DIMENSION(jpi,jpk,jptobc) :: undta, vndta, tndta, sndta ! North 76 REAL(wp), DIMENSION(jpi,jpk,jptobc) :: usdta, vsdta, tsdta, ssdta ! South 77 # endif 78 LOGICAL, DIMENSION (jpj,jpk ) :: ltemsk=.TRUE., luemsk=.TRUE., lvemsk=.TRUE. ! boolean msks 79 LOGICAL, DIMENSION (jpj,jpk ) :: ltwmsk=.TRUE., luwmsk=.TRUE., lvwmsk=.TRUE. ! used for outliers 80 LOGICAL, DIMENSION (jpi,jpk ) :: ltnmsk=.TRUE., lunmsk=.TRUE., lvnmsk=.TRUE. ! checks 81 LOGICAL, DIMENSION (jpi,jpk ) :: ltsmsk=.TRUE., lusmsk=.TRUE., lvsmsk=.TRUE. 82 83 !! * Substitutions 65 84 # include "obc_vectopt_loop_substitute.h90" 85 # include "domzgr_substitute.h90" 66 86 !!---------------------------------------------------------------------- 67 87 !! OPA 9.0 , LOCEAN-IPSL (2006) … … 72 92 CONTAINS 73 93 74 SUBROUTINE obc_dta( kt ) 75 !!--------------------------------------------------------------------------- 76 !! *** SUBROUTINE obc_dta *** 77 !! 78 !! ** Purpose : Find the climatological boundary arrays for the specified date, 79 !! The boundary arrays are netcdf files. Three possible cases: 80 !! - one time frame only in the file (time dimension = 1). 81 !! in that case the boundary data does not change in time. 82 !! - many time frames. In that case, if we have 12 frames 83 !! we assume monthly fields. 84 !! Else, we assume that time_counter is in seconds 85 !! since the beginning of either the current year or a reference 86 !! year given in the namelist. 87 !! (no check is done so far but one would have to check the "unit" 88 !! attribute of variable time_counter). 89 !! 90 !! 91 !! History : 92 !! ! 98-05 (J.M. Molines) Original code 93 !! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90 94 !! 95 !! 9.0 ! 04-06 (F. Durand, A-M. Treguier) Netcdf BC files on input 96 !! ! 2007-2008 (C. Langlais, P. Mathiot, J.M. Molines) high frequency boundaries data 97 !!--------------------------------------------------------------------------- 98 !! * Arguments 99 INTEGER, INTENT( in ) :: kt ! ocean time-step index 100 101 !! * Local declarations 102 INTEGER :: ji, jj, jk, ii, ij ,it ! dummy loop indices 103 INTEGER :: ikprint ! frequency for printouts. 104 INTEGER, SAVE :: immfile, iyyfile ! 105 INTEGER :: nt ! record indices (incrementation) 106 INTEGER :: istop ! local error check 107 108 REAL(wp) :: zxy, znum, zden ! time interpolation weight 109 110 ! variables for the julian day calculation 111 INTEGER :: iyear, imonth, iday 112 REAL(wp) :: zsec , zjulian, zjuliancnes 113 114 ! IOM STUFF 115 INTEGER :: idvar, id_e, id_w, id_n, id_s, id_x ! file identifiers 116 INTEGER, DIMENSION(1) :: itmp 117 CHARACTER(LEN=25) :: cl_vname 118 119 !!--------------------------------------------------------------------------- 120 121 ! 0. initialisation : 122 ! -------------------- 123 IF ( kt == nit000 ) CALL obc_dta_ini ( kt ) 124 IF ( nobc_dta == 0 ) RETURN ! already done in obc_dta_ini 125 IF ( itobc == 1 ) RETURN ! case of only one time frame in file done in obc_dta_ini 126 127 ! in the following code, we assume that obc data are read from files, with more than 1 time frame in it 128 129 iyyfile=iyy ; immfile = 00 ! set component of the current file name 130 IF ( cffile /= 'annual') immfile = imm ! 131 IF ( ln_obc_clim ) iyyfile = 0000 ! assume that climatological files are labeled y0000 132 133 ! 1. Synchronize time of run with time of data files 134 !--------------------------------------------------- 135 ! nday_year is the day number in the current year ( 1 for 01/01 ) 136 zsec=MOD( (kt-nit000)*rdt - (nday_year - nday_year0 )*rday, rday ) ! number of seconds in the current day 137 IF (ln_obc_clim) THEN 138 zjcnes = nday_year - 1 + zsec/rday 139 ELSE 140 zjcnes = zjcnes + rdt/rday 141 ENDIF 142 143 ! look for 'before' record number in the current file 144 ntobc = nrecbef () ! this function return the record number for 'before', relative to zjcnes 145 146 IF (MOD(kt-1,10)==0) THEN 147 IF (lwp) WRITE(numout,*) 'kt= ',kt,' zjcnes =', zjcnes,' ndastp =',ndastp, 'mm =',imm 148 END IF 149 150 ! 2. read a new data if necessary 151 !-------------------------------- 152 IF ( ntobc /= ntobc_b ) THEN 153 ! we need to read the 'after' record 154 ! swap working index: 155 nt=nt_b ; nt_b=nt_a ; nt_a=nt 156 ntobc_b = ntobc 157 158 ! new record number : 159 ntobc_a = ntobc_a + 1 160 161 ! all tricky things related to record number, changing files etc... are managed by obc_read 162 163 CALL obc_read (kt, nt_a, ntobc_a, iyyfile, immfile ) 164 165 ! update zjcnes_obc 166 zjcnes_obc(nt_b)= ztcobc(ntobc_b) 167 zjcnes_obc(nt_a)= ztcobc(ntobc_a) 168 ENDIF 169 170 ! 3. interpolation at each time step 171 ! ------------------------------------ 172 IF ( ln_obc_clim) THEN 173 znum= MOD(zjcnes - zjcnes_obc(nt_b), REAL(nyear_len(1),wp) ) ; IF ( znum < 0 ) znum = znum + REAL(nyear_len(1),wp) 174 zden= MOD(zjcnes_obc(nt_a) - zjcnes_obc(nt_b), REAL(nyear_len(1),wp) ) ; IF ( zden < 0 ) zden = zden + REAL(nyear_len(1),wp) 175 ELSE 176 znum= zjcnes - zjcnes_obc(nt_b) 177 zden= zjcnes_obc(nt_a) - zjcnes_obc(nt_b) 178 ENDIF 179 zxy = znum / zden 180 181 IF( lp_obc_east ) THEN 182 ! fills sfoe, tfoe, ufoe ,vfoe 183 sfoe(:,:) = zxy * sedta (:,:,nt_a) + (1. - zxy)*sedta(:,:,nt_b) 184 tfoe(:,:) = zxy * tedta (:,:,nt_a) + (1. - zxy)*tedta(:,:,nt_b) 185 ufoe(:,:) = zxy * uedta (:,:,nt_a) + (1. - zxy)*uedta(:,:,nt_b) 186 vfoe(:,:) = zxy * vedta (:,:,nt_a) + (1. - zxy)*vedta(:,:,nt_b) 187 ENDIF 188 189 IF( lp_obc_west) THEN 190 ! fills sfow, tfow, ufow ,vfow 191 sfow(:,:) = zxy * swdta (:,:,nt_a) + (1. - zxy)*swdta(:,:,nt_b) 192 tfow(:,:) = zxy * twdta (:,:,nt_a) + (1. - zxy)*twdta(:,:,nt_b) 193 ufow(:,:) = zxy * uwdta (:,:,nt_a) + (1. - zxy)*uwdta(:,:,nt_b) 194 vfow(:,:) = zxy * vwdta (:,:,nt_a) + (1. - zxy)*vwdta(:,:,nt_b) 195 ENDIF 196 197 IF( lp_obc_north) THEN 198 ! fills sfon, tfon, ufon ,vfon 199 sfon(:,:) = zxy * sndta (:,:,nt_a) + (1. - zxy)*sndta(:,:,nt_b) 200 tfon(:,:) = zxy * tndta (:,:,nt_a) + (1. - zxy)*tndta(:,:,nt_b) 201 ufon(:,:) = zxy * undta (:,:,nt_a) + (1. - zxy)*undta(:,:,nt_b) 202 vfon(:,:) = zxy * vndta (:,:,nt_a) + (1. - zxy)*vndta(:,:,nt_b) 203 ENDIF 204 205 IF( lp_obc_south) THEN 206 ! fills sfos, tfos, ufos ,vfos 207 sfos(:,:) = zxy * ssdta (:,:,nt_a) + (1. - zxy)*ssdta(:,:,nt_b) 208 tfos(:,:) = zxy * tsdta (:,:,nt_a) + (1. - zxy)*tsdta(:,:,nt_b) 209 ufos(:,:) = zxy * usdta (:,:,nt_a) + (1. - zxy)*usdta(:,:,nt_b) 210 vfos(:,:) = zxy * vsdta (:,:,nt_a) + (1. - zxy)*vsdta(:,:,nt_b) 211 ENDIF 212 END SUBROUTINE obc_dta 213 214 215 SUBROUTINE obc_dta_ini (kt) 216 !!----------------------------------------------------------------------------- 217 !! *** SUBROUTINE obc_dta_ini *** 218 !! 219 !! ** Purpose : 220 !! When obc_dta first call, realize some data initialization 221 !! 222 !! ** Method : 223 !! 224 !! History : 225 !! 9.0 ! 07-10 (J.M. Molines ) 226 !!---------------------------------------------------------------------------- 227 !! * Argument 228 INTEGER, INTENT(in) :: kt ! ocean time-step index 229 230 !! * Local declarations 231 INTEGER :: ji,jj, it ! dummy loop indices 232 233 REAL(wp) :: zxy ! time interpolation weight 234 235 INTEGER :: ikprint ! frequency for printouts. 236 237 INTEGER, SAVE :: immfile, iyyfile ! 238 INTEGER :: nt ! record indices (incrementation) 239 INTEGER :: istop ! local error check 240 241 ! variables for the julian day calculation 242 INTEGER :: iyear, imonth, iday 243 REAL(wp) :: zsec , zjulian, zjuliancnes 244 245 ! IOM STUFF 246 INTEGER :: idvar, id_e, id_w, id_n, id_s, id_x ! file identifiers 247 INTEGER, DIMENSION(1) :: itmp 248 CHARACTER(LEN=25) :: cl_vname 249 250 IF(lwp) WRITE(numout,*) 251 IF(lwp) WRITE(numout,*) 'obc_dta : find boundary data' 252 IF(lwp) WRITE(numout,*) '~~~~~~~' 253 IF (lwp) THEN 254 IF ( nobc_dta == 0 ) THEN 255 WRITE(numout,*) ' OBC data taken from initial conditions.' 256 ELSE 257 WRITE(numout,*) ' OBC data taken from netcdf files.' 258 ENDIF 259 ENDIF 260 nday_year0 = nday_year ! to remember the day when kt=nit000 261 262 sedta(:,:,:) = 0.e0 ; tedta(:,:,:) = 0.e0 ; uedta(:,:,:) = 0.e0 ; vedta(:,:,:) = 0.e0 ! East 263 swdta(:,:,:) = 0.e0 ; twdta(:,:,:) = 0.e0 ; uwdta(:,:,:) = 0.e0 ; vwdta(:,:,:) = 0.e0 ! West 264 sndta(:,:,:) = 0.e0 ; tndta(:,:,:) = 0.e0 ; undta(:,:,:) = 0.e0 ; vndta(:,:,:) = 0.e0 ! North 265 ssdta(:,:,:) = 0.e0 ; tsdta(:,:,:) = 0.e0 ; usdta(:,:,:) = 0.e0 ; vsdta(:,:,:) = 0.e0 ! South 266 267 sfoe(:,:) = 0.e0 ; tfoe(:,:) = 0.e0 ; ufoe(:,:) = 0.e0 ; vfoe(:,:) = 0.e0 ! East 268 sfow(:,:) = 0.e0 ; tfow(:,:) = 0.e0 ; ufow(:,:) = 0.e0 ; vfow(:,:) = 0.e0 ! West 269 sfon(:,:) = 0.e0 ; tfon(:,:) = 0.e0 ; ufon(:,:) = 0.e0 ; vfon(:,:) = 0.e0 ! North 270 sfos(:,:) = 0.e0 ; tfos(:,:) = 0.e0 ; ufos(:,:) = 0.e0 ; vfos(:,:) = 0.e0 ! South 271 272 IF (nobc_dta == 0 ) THEN ! boundary data are the initial data of this run (set only at nit000) 273 IF (lp_obc_east) THEN ! East 274 DO ji = nie0 , nie1 275 sfoe(nje0p1:nje1m1,:) = temsk(nje0p1:nje1m1,:) * sn (ji+1 , nje0p1:nje1m1 , :) 276 tfoe(nje0p1:nje1m1,:) = temsk(nje0p1:nje1m1,:) * tn (ji+1 , nje0p1:nje1m1 , :) 277 ufoe(nje0p1:nje1m1,:) = uemsk(nje0p1:nje1m1,:) * un (ji , nje0p1:nje1m1 , :) 278 vfoe(nje0p1:nje1m1,:) = vemsk(nje0p1:nje1m1,:) * vn (ji+1 , nje0p1:nje1m1 , :) 279 END DO 280 ENDIF 281 282 IF (lp_obc_west) THEN ! West 283 DO ji = niw0 , niw1 284 sfow(njw0p1:njw1m1,:) = twmsk(njw0p1:njw1m1,:) * sn (ji , njw0p1:njw1m1 , :) 285 tfow(njw0p1:njw1m1,:) = twmsk(njw0p1:njw1m1,:) * tn (ji , njw0p1:njw1m1 , :) 286 ufow(njw0p1:njw1m1,:) = uwmsk(njw0p1:njw1m1,:) * un (ji , njw0p1:njw1m1 , :) 287 vfow(njw0p1:njw1m1,:) = vwmsk(njw0p1:njw1m1,:) * vn (ji , njw0p1:njw1m1 , :) 288 END DO 289 ENDIF 290 291 IF (lp_obc_north) THEN ! North 292 DO jj = njn0 , njn1 293 sfon(nin0p1:nin1m1,:) = tnmsk(nin0p1:nin1m1,:) * sn (nin0p1:nin1m1 , jj+1 , :) 294 tfon(nin0p1:nin1m1,:) = tnmsk(nin0p1:nin1m1,:) * tn (nin0p1:nin1m1 , jj+1 , :) 295 ufon(nin0p1:nin1m1,:) = unmsk(nin0p1:nin1m1,:) * un (nin0p1:nin1m1 , jj+1 , :) 296 vfon(nin0p1:nin1m1,:) = vnmsk(nin0p1:nin1m1,:) * vn (nin0p1:nin1m1 , jj , :) 297 END DO 298 ENDIF 299 300 IF (lp_obc_south) THEN ! South 301 DO jj = njs0 , njs1 302 sfos(nis0p1:nis1m1,:) = tsmsk(nis0p1:nis1m1,:) * sn (nis0p1:nis1m1 , jj , :) 303 tfos(nis0p1:nis1m1,:) = tsmsk(nis0p1:nis1m1,:) * tn (nis0p1:nis1m1 , jj , :) 304 ufos(nis0p1:nis1m1,:) = usmsk(nis0p1:nis1m1,:) * un (nis0p1:nis1m1 , jj , :) 305 vfos(nis0p1:nis1m1,:) = vsmsk(nis0p1:nis1m1,:) * vn (nis0p1:nis1m1 , jj , :) 306 END DO 307 ENDIF 308 RETURN ! exit the routine all is done 309 ENDIF ! nobc_dta = 0 94 SUBROUTINE obc_dta( kt ) 95 !!--------------------------------------------------------------------------- 96 !! *** SUBROUTINE obc_dta *** 97 !! 98 !! ** Purpose : Find the climatological boundary arrays for the specified date, 99 !! The boundary arrays are netcdf files. Three possible cases: 100 !! - one time frame only in the file (time dimension = 1). 101 !! in that case the boundary data does not change in time. 102 !! - many time frames. In that case, if we have 12 frames 103 !! we assume monthly fields. 104 !! Else, we assume that time_counter is in seconds 105 !! since the beginning of either the current year or a reference 106 !! year given in the namelist. 107 !! (no check is done so far but one would have to check the "unit" 108 !! attribute of variable time_counter). 109 !! 110 !! 111 !! History : 112 !! ! 98-05 (J.M. Molines) Original code 113 !! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90 114 !! 115 !! 9.0 ! 04-06 (F. Durand, A-M. Treguier) Netcdf BC files on input 116 !! ! 2007-2008 (C. Langlais, P. Mathiot, J.M. Molines) high frequency boundaries data 117 !!--------------------------------------------------------------------------- 118 !! * Arguments 119 INTEGER, INTENT( in ) :: kt ! ocean time-step index 120 121 !! * Local declarations 122 INTEGER, SAVE :: immfile, iyyfile ! 123 INTEGER :: nt ! record indices (incrementation) 124 REAL(wp) :: zsec, zxy, znum, zden ! time interpolation weight 125 126 !!--------------------------------------------------------------------------- 127 128 ! 0. initialisation : 129 ! -------------------- 130 IF ( kt == nit000 ) CALL obc_dta_ini ( kt ) 131 IF ( nobc_dta == 0 ) RETURN ! already done in obc_dta_ini 132 IF ( itobc == 1 ) RETURN ! case of only one time frame in file done in obc_dta_ini 133 134 ! in the following code, we assume that obc data are read from files, with more than 1 time frame in it 135 136 iyyfile=iyy ; immfile = 00 ! set component of the current file name 137 IF ( cffile /= 'annual') immfile = imm ! 138 IF ( ln_obc_clim ) iyyfile = 0000 ! assume that climatological files are labeled y0000 139 140 ! 1. Synchronize time of run with time of data files 141 !--------------------------------------------------- 142 ! nday_year is the day number in the current year ( 1 for 01/01 ) 143 zsec=MOD( (kt-nit000)*rdt - (nday_year - nday_year0 )*rday, rday ) ! number of seconds in the current day 144 IF (ln_obc_clim) THEN 145 zjcnes = nday_year - 1 + zsec/rday 146 ELSE 147 zjcnes = zjcnes + rdt/rday 148 ENDIF 149 150 ! look for 'before' record number in the current file 151 ntobc = nrecbef () ! this function return the record number for 'before', relative to zjcnes 152 153 IF (MOD(kt-1,10)==0) THEN 154 IF (lwp) WRITE(numout,*) 'kt= ',kt,' zjcnes =', zjcnes,' ndastp =',ndastp, 'mm =',imm 155 END IF 156 157 ! 2. read a new data if necessary 158 !-------------------------------- 159 IF ( ntobc /= ntobc_b ) THEN 160 ! we need to read the 'after' record 161 ! swap working index: 162 # if defined key_dynspg_ts 163 nt=nt_m ; nt_m=nt_b ; nt_b=nt 164 # endif 165 nt=nt_b ; nt_b=nt_a ; nt_a=nt 166 ntobc_b = ntobc 167 168 ! new record number : 169 ntobc_a = ntobc_a + 1 170 171 ! all tricky things related to record number, changing files etc... are managed by obc_read 172 173 CALL obc_read (kt, nt_a, ntobc_a, iyyfile, immfile ) 174 175 ! update zjcnes_obc 176 # if defined key_dynspg_ts 177 ntobc_m=mod(ntobc_b-2+itobc,itobc)+1 178 zjcnes_obc(nt_m)= ztcobc(ntobc_m) 179 # endif 180 zjcnes_obc(nt_b)= ztcobc(ntobc_b) 181 zjcnes_obc(nt_a)= ztcobc(ntobc_a) 182 ENDIF 183 184 ! 3. interpolation at each time step 185 ! ------------------------------------ 186 IF( ln_obc_clim) THEN 187 znum= MOD(zjcnes - zjcnes_obc(nt_b), REAL(nyear_len(1),wp) ) 188 IF( znum < 0 ) znum = znum + REAL(nyear_len(1),wp) 189 zden= MOD(zjcnes_obc(nt_a) - zjcnes_obc(nt_b), REAL(nyear_len(1),wp) ) 190 IF( zden < 0 ) zden = zden + REAL(nyear_len(1),wp) 191 ELSE 192 znum= zjcnes - zjcnes_obc(nt_b) 193 zden= zjcnes_obc(nt_a) - zjcnes_obc(nt_b) 194 ENDIF 195 zxy = znum / zden 196 197 IF( lp_obc_east ) THEN 198 ! fills sfoe, tfoe, ufoe ,vfoe 199 sfoe(:,:) = zxy * sedta (:,:,nt_a) + (1. - zxy)*sedta(:,:,nt_b) 200 tfoe(:,:) = zxy * tedta (:,:,nt_a) + (1. - zxy)*tedta(:,:,nt_b) 201 ufoe(:,:) = zxy * uedta (:,:,nt_a) + (1. - zxy)*uedta(:,:,nt_b) 202 vfoe(:,:) = zxy * vedta (:,:,nt_a) + (1. - zxy)*vedta(:,:,nt_b) 203 ENDIF 204 205 IF( lp_obc_west) THEN 206 ! fills sfow, tfow, ufow ,vfow 207 sfow(:,:) = zxy * swdta (:,:,nt_a) + (1. - zxy)*swdta(:,:,nt_b) 208 tfow(:,:) = zxy * twdta (:,:,nt_a) + (1. - zxy)*twdta(:,:,nt_b) 209 ufow(:,:) = zxy * uwdta (:,:,nt_a) + (1. - zxy)*uwdta(:,:,nt_b) 210 vfow(:,:) = zxy * vwdta (:,:,nt_a) + (1. - zxy)*vwdta(:,:,nt_b) 211 ENDIF 212 213 IF( lp_obc_north) THEN 214 ! fills sfon, tfon, ufon ,vfon 215 sfon(:,:) = zxy * sndta (:,:,nt_a) + (1. - zxy)*sndta(:,:,nt_b) 216 tfon(:,:) = zxy * tndta (:,:,nt_a) + (1. - zxy)*tndta(:,:,nt_b) 217 ufon(:,:) = zxy * undta (:,:,nt_a) + (1. - zxy)*undta(:,:,nt_b) 218 vfon(:,:) = zxy * vndta (:,:,nt_a) + (1. - zxy)*vndta(:,:,nt_b) 219 ENDIF 220 221 IF( lp_obc_south) THEN 222 ! fills sfos, tfos, ufos ,vfos 223 sfos(:,:) = zxy * ssdta (:,:,nt_a) + (1. - zxy)*ssdta(:,:,nt_b) 224 tfos(:,:) = zxy * tsdta (:,:,nt_a) + (1. - zxy)*tsdta(:,:,nt_b) 225 ufos(:,:) = zxy * usdta (:,:,nt_a) + (1. - zxy)*usdta(:,:,nt_b) 226 vfos(:,:) = zxy * vsdta (:,:,nt_a) + (1. - zxy)*vsdta(:,:,nt_b) 227 ENDIF 228 END SUBROUTINE obc_dta 229 230 231 SUBROUTINE obc_dta_ini (kt) 232 !!----------------------------------------------------------------------------- 233 !! *** SUBROUTINE obc_dta_ini *** 234 !! 235 !! ** Purpose : 236 !! When obc_dta first call, realize some data initialization 237 !! 238 !! ** Method : 239 !! 240 !! History : 241 !! 9.0 ! 07-10 (J.M. Molines ) 242 !!---------------------------------------------------------------------------- 243 !! * Argument 244 INTEGER, INTENT(in) :: kt ! ocean time-step index 245 246 !! * Local declarations 247 INTEGER :: ji, jj ! dummy loop indices 248 INTEGER, SAVE :: immfile, iyyfile ! 249 250 ! variables for the julian day calculation 251 INTEGER :: iyear, imonth, iday 252 REAL(wp) :: zsec , zjulian, zjuliancnes 253 254 IF(lwp) WRITE(numout,*) 255 IF(lwp) WRITE(numout,*) 'obc_dta : find boundary data' 256 IF(lwp) WRITE(numout,*) '~~~~~~~' 257 IF (lwp) THEN 258 IF ( nobc_dta == 0 ) THEN 259 WRITE(numout,*) ' OBC data taken from initial conditions.' 260 ELSE 261 WRITE(numout,*) ' OBC data taken from netcdf files.' 262 ENDIF 263 ENDIF 264 nday_year0 = nday_year ! to remember the day when kt=nit000 265 266 sedta(:,:,:) = 0.e0 ; tedta(:,:,:) = 0.e0 ; uedta(:,:,:) = 0.e0 ; vedta(:,:,:) = 0.e0 ! East 267 swdta(:,:,:) = 0.e0 ; twdta(:,:,:) = 0.e0 ; uwdta(:,:,:) = 0.e0 ; vwdta(:,:,:) = 0.e0 ! West 268 sndta(:,:,:) = 0.e0 ; tndta(:,:,:) = 0.e0 ; undta(:,:,:) = 0.e0 ; vndta(:,:,:) = 0.e0 ! North 269 ssdta(:,:,:) = 0.e0 ; tsdta(:,:,:) = 0.e0 ; usdta(:,:,:) = 0.e0 ; vsdta(:,:,:) = 0.e0 ! South 270 271 sfoe(:,:) = 0.e0 ; tfoe(:,:) = 0.e0 ; ufoe(:,:) = 0.e0 ; vfoe(:,:) = 0.e0 ! East 272 sfow(:,:) = 0.e0 ; tfow(:,:) = 0.e0 ; ufow(:,:) = 0.e0 ; vfow(:,:) = 0.e0 ! West 273 sfon(:,:) = 0.e0 ; tfon(:,:) = 0.e0 ; ufon(:,:) = 0.e0 ; vfon(:,:) = 0.e0 ! North 274 sfos(:,:) = 0.e0 ; tfos(:,:) = 0.e0 ; ufos(:,:) = 0.e0 ; vfos(:,:) = 0.e0 ! South 275 276 IF (nobc_dta == 0 ) THEN ! boundary data are the initial data of this run (set only at nit000) 277 IF (lp_obc_east) THEN ! East 278 DO ji = nie0 , nie1 279 sfoe(nje0:nje1,:) = temsk(nje0:nje1,:) * sn (ji+1 , nje0:nje1 , :) * tmask(ji+1,nje0:nje1 , :) 280 tfoe(nje0:nje1,:) = temsk(nje0:nje1,:) * tn (ji+1 , nje0:nje1 , :) * tmask(ji+1,nje0:nje1 , :) 281 ufoe(nje0:nje1,:) = uemsk(nje0:nje1,:) * un (ji , nje0:nje1 , :) * umask(ji, nje0:nje1 , :) 282 vfoe(nje0:nje1,:) = vemsk(nje0:nje1,:) * vn (ji+1 , nje0:nje1 , :) * vmask(ji+1,nje0:nje1 , :) 283 END DO 284 ENDIF 285 286 IF (lp_obc_west) THEN ! West 287 DO ji = niw0 , niw1 288 sfow(njw0:njw1,:) = twmsk(njw0:njw1,:) * sn (ji , njw0:njw1 , :) * tmask(ji , njw0:njw1 , :) 289 tfow(njw0:njw1,:) = twmsk(njw0:njw1,:) * tn (ji , njw0:njw1 , :) * tmask(ji , njw0:njw1 , :) 290 ufow(njw0:njw1,:) = uwmsk(njw0:njw1,:) * un (ji , njw0:njw1 , :) * umask(ji , njw0:njw1 , :) 291 vfow(njw0:njw1,:) = vwmsk(njw0:njw1,:) * vn (ji , njw0:njw1 , :) * vmask(ji , njw0:njw1 , :) 292 END DO 293 ENDIF 294 295 IF (lp_obc_north) THEN ! North 296 DO jj = njn0 , njn1 297 sfon(nin0:nin1,:) = tnmsk(nin0:nin1,:) * sn (nin0:nin1 , jj+1 , :) * tmask(nin0:nin1 , jj+1 , :) 298 tfon(nin0:nin1,:) = tnmsk(nin0:nin1,:) * tn (nin0:nin1 , jj+1 , :) * tmask(nin0:nin1 , jj+1 , :) 299 ufon(nin0:nin1,:) = unmsk(nin0:nin1,:) * un (nin0:nin1 , jj+1 , :) * umask(nin0:nin1 , jj+1 , :) 300 vfon(nin0:nin1,:) = vnmsk(nin0:nin1,:) * vn (nin0:nin1 , jj , :) * vmask(nin0:nin1 , jj , :) 301 END DO 302 ENDIF 303 304 IF (lp_obc_south) THEN ! South 305 DO jj = njs0 , njs1 306 sfos(nis0:nis1,:) = tsmsk(nis0:nis1,:) * sn (nis0:nis1 , jj , :) * tmask(nis0:nis1 , jj , :) 307 tfos(nis0:nis1,:) = tsmsk(nis0:nis1,:) * tn (nis0:nis1 , jj , :) * tmask(nis0:nis1 , jj , :) 308 ufos(nis0:nis1,:) = usmsk(nis0:nis1,:) * un (nis0:nis1 , jj , :) * umask(nis0:nis1 , jj , :) 309 vfos(nis0:nis1,:) = vsmsk(nis0:nis1,:) * vn (nis0:nis1 , jj , :) * vmask(nis0:nis1 , jj , :) 310 END DO 311 ENDIF 312 RETURN ! exit the routine all is done 313 ENDIF ! nobc_dta = 0 310 314 311 315 !!!! In the following OBC data are read from files. 312 ! all logical-mask are initialzed to true when declared 313 WHERE ( temsk == 0 ) ltemsk=.FALSE. 314 WHERE ( uemsk == 0 ) luemsk=.FALSE. 315 WHERE ( vemsk == 0 ) lvemsk=.FALSE. 316 317 WHERE ( twmsk == 0 ) ltwmsk=.FALSE. 318 WHERE ( uwmsk == 0 ) luwmsk=.FALSE. 319 WHERE ( vwmsk == 0 ) lvwmsk=.FALSE. 320 321 WHERE ( tnmsk == 0 ) ltnmsk=.FALSE. 322 WHERE ( unmsk == 0 ) lunmsk=.FALSE. 323 WHERE ( vnmsk == 0 ) lvnmsk=.FALSE. 324 325 WHERE ( tsmsk == 0 ) ltsmsk=.FALSE. 326 WHERE ( usmsk == 0 ) lusmsk=.FALSE. 327 WHERE ( vsmsk == 0 ) lvsmsk=.FALSE. 328 329 iyear=1950; imonth=01; iday=01; zsec=0. 330 ! zjuliancnes : julian day corresonding to 01/01/1950 331 CALL ymds2ju(iyear, imonth, iday,zsec , zjuliancnes) 332 333 !current year and curent month 334 iyy=INT(ndastp/10000) ; imm=INT((ndastp -iyy*10000)/100) ; idd=(ndastp-iyy*10000-imm*100) 335 IF (iyy < 1900) iyy = iyy+1900 ! always assume that years are on 4 digits. 336 CALL ymds2ju(iyy, imm, idd ,zsec , zjulian) 337 ndate0_cnes = zjulian - zjuliancnes ! jcnes day when call to obc_dta_ini 338 339 iyyfile=iyy ; immfile=0 ! set component of the current file name 340 IF ( cffile /= 'annual') immfile=imm 341 IF ( ln_obc_clim) iyyfile = 0 ! assume that climatological files are labeled y0000 342 343 CALL obc_dta_chktime ( iyyfile, immfile ) 344 345 IF ( itobc == 1 ) THEN 346 ! in this case we will provide boundary data only once. 347 nt_a=1 ; ntobc_a=1 348 CALL obc_read (nit000, nt_a, ntobc_a, iyyfile, immfile) 349 IF( lp_obc_east ) THEN 350 ! fills sfoe, tfoe, ufoe ,vfoe 351 sfoe(:,:) = sedta (:,:,1) ; tfoe(:,:) = tedta (:,:,1) 352 ufoe(:,:) = uedta (:,:,1) ; vfoe(:,:) = vedta (:,:,1) 353 ENDIF 354 355 IF( lp_obc_west) THEN 356 ! fills sfow, tfow, ufow ,vfow 357 sfow(:,:) = swdta (:,:,1) ; tfow(:,:) = twdta (:,:,1) 358 ufow(:,:) = uwdta (:,:,1) ; vfow(:,:) = vwdta (:,:,1) 359 ENDIF 360 361 IF( lp_obc_north) THEN 362 ! fills sfon, tfon, ufon ,vfon 363 sfon(:,:) = sndta (:,:,1) ; tfon(:,:) = tndta (:,:,1) 364 ufon(:,:) = undta (:,:,1) ; vfon(:,:) = vndta (:,:,1) 365 ENDIF 366 367 IF( lp_obc_south) THEN 368 ! fills sfos, tfos, ufos ,vfos 369 sfos(:,:) = ssdta (:,:,1) ; tfos(:,:) = tsdta (:,:,1) 370 ufos(:,:) = usdta (:,:,1) ; vfos(:,:) = vsdta (:,:,1) 371 ENDIF 372 RETURN ! we go out of obc_dta_ini -------------------------------------->>>>> 373 ENDIF 374 375 ! nday_year is the day number in the current year ( 1 for 01/01 ) 376 ! we suppose that we always start from the begining of a day 377 ! zsec=MOD( (kt-nit000)*rdt - (nday_year - nday_year0 )*rday, rday ) ! number of seconds in the current day 378 zsec=0.e0 ! here, kt=nit000, nday_year = ndat_year0 379 380 IF (ln_obc_clim) THEN 381 zjcnes = nday_year - 1 + zsec/rday ! for clim file time is in days in a year 382 ELSE 383 zjcnes = ndate0_cnes + (nday_year - nday_year0 ) + zsec/rday 384 ENDIF 385 386 ! look for 'before' record number in the current file 387 ntobc = nrecbef () 388 389 IF (lwp) WRITE(numout,*) 'obc files frequency :',cffile 390 IF (lwp) WRITE(numout,*) ' zjcnes0 =',zjcnes,' ndastp0 =',ndastp 391 IF (lwp) WRITE(numout,*) ' annee0 ',iyy,' month0 ', imm,' day0 ', idd 392 IF (lwp) WRITE(numout,*) 'first file open :',cl_obc_nTS 393 394 ! record initialisation 395 !-------------------- 396 nt_b = 1 ; nt_a = 2 397 398 ntobc_a = ntobc + 1 399 ntobc_b = ntobc 400 401 CALL obc_read (kt, nt_b, ntobc_b, iyyfile, immfile) ! read 'before' fields 402 CALL obc_read (kt, nt_a, ntobc_a, iyyfile, immfile) ! read 'after' fields 403 404 zjcnes_obc(nt_b)= ztcobc(ntobc_b) 405 zjcnes_obc(nt_a)= ztcobc(ntobc_a) 406 ! 407 END SUBROUTINE obc_dta_ini 408 409 410 SUBROUTINE obc_dta_chktime (kyyfile, kmmfile) 411 ! 412 ! check the number of time steps in the files and read ztcobc 413 ! 414 ! * Arguments 415 INTEGER, INTENT(in) :: kyyfile, kmmfile 416 ! * local variables 417 INTEGER :: istop ! error control 418 INTEGER :: ji ! dummy loop index 419 420 INTEGER :: idvar, id_e, id_w, id_n, id_s, id_x ! file identifiers 421 INTEGER, DIMENSION(1) :: itmp 422 CHARACTER(LEN=25) :: cl_vname 423 424 ntobc_a = 0; itobce =0 ; itobcw = 0; itobcn = 0; itobcs = 0 425 ! build file name 426 WRITE(cl_obc_eTS ,'("obc_east_TS_y",i4.4,"m",i2.2,".nc")' ) kyyfile,kmmfile 427 WRITE(cl_obc_wTS ,'("obc_west_TS_y",i4.4,"m",i2.2,".nc")' ) kyyfile,kmmfile 428 WRITE(cl_obc_nTS ,'("obc_north_TS_y",i4.4,"m",i2.2,".nc")' ) kyyfile,kmmfile 429 WRITE(cl_obc_sTS ,'("obc_south_TS_y",i4.4,"m",i2.2,".nc")' ) kyyfile,kmmfile 430 431 cl_vname = 'time_counter' 432 IF ( lp_obc_east ) THEN 433 CALL iom_open ( cl_obc_eTS , id_e ) 434 idvar = iom_varid( id_e, cl_vname, kdimsz = itmp ); itobce=itmp(1) 435 ENDIF 436 IF ( lp_obc_west ) THEN 437 CALL iom_open ( cl_obc_wTS , id_w ) 438 idvar = iom_varid( id_w, cl_vname, kdimsz = itmp ) ; itobcw=itmp(1) 439 ENDIF 440 IF ( lp_obc_north ) THEN 441 CALL iom_open ( cl_obc_nTS , id_n ) 442 idvar = iom_varid( id_n, cl_vname, kdimsz = itmp ) ; itobcn=itmp(1) 443 ENDIF 444 IF ( lp_obc_south ) THEN 445 CALL iom_open ( cl_obc_sTS , id_s ) 446 idvar = iom_varid( id_s, cl_vname, kdimsz = itmp ) ; itobcs=itmp(1) 447 ENDIF 448 449 itobc = MAX( itobce, itobcw, itobcn, itobcs ) 450 istop = 0 451 IF ( lp_obc_east .AND. itobce /= itobc ) istop = istop+1 452 IF ( lp_obc_west .AND. itobcw /= itobc ) istop = istop+1 453 IF ( lp_obc_north .AND. itobcn /= itobc ) istop = istop+1 454 IF ( lp_obc_south .AND. itobcs /= itobc ) istop = istop+1 455 nstop = nstop + istop 456 457 IF ( istop /= 0 ) THEN 458 WRITE(ctmp1,*) ' east, west, north, south: ', itobce, itobcw, itobcn, itobcs 459 CALL ctl_stop( 'obcdta : all files must have the same number of time steps', ctmp1 ) 460 ENDIF 461 462 IF ( itobc == 1 ) THEN 463 IF (lwp) THEN 464 WRITE(numout,*) ' obcdta found one time step only in the OBC files' 465 IF (ln_obc_clim) THEN 466 ! OK no problem 467 ELSE 468 ln_obc_clim=.true. 469 WRITE(numout,*) ' we force ln_obc_clim to T' 470 ENDIF 471 ENDIF 472 ELSE 473 IF ( ALLOCATED(ztcobc) ) DEALLOCATE ( ztcobc ) 474 ALLOCATE (ztcobc(itobc)) 475 DO ji=1,1 ! use a dummy loop to read ztcobc only once 476 IF ( lp_obc_east ) THEN 477 CALL iom_gettime ( id_e, ztcobc, cl_vname ) ; CALL iom_close (id_e) ; EXIT 478 ENDIF 479 IF ( lp_obc_west ) THEN 480 CALL iom_gettime ( id_w, ztcobc, cl_vname ) ; CALL iom_close (id_w) ; EXIT 481 ENDIF 482 IF ( lp_obc_north ) THEN 483 CALL iom_gettime ( id_n, ztcobc, cl_vname ) ; CALL iom_close (id_n) ; EXIT 484 ENDIF 485 IF ( lp_obc_south ) THEN 486 CALL iom_gettime ( id_s, ztcobc, cl_vname ) ; CALL iom_close (id_s) ; EXIT 487 ENDIF 488 END DO 489 rdt_obc = ztcobc(2)-ztcobc(1) ! just an information, not used for any computation 490 IF (lwp) WRITE(numout,*) ' obcdta found', itobc,' time steps in the OBC files' 491 IF (lwp) WRITE(numout,*) ' time step of obc data :', rdt_obc,' days' 492 ENDIF 493 zjcnes = zjcnes - rdt/rday ! trick : zcnes is always incremented by rdt/rday in obc_dta! 494 END SUBROUTINE obc_dta_chktime 495 496 497 #if defined key_dynspg_ts || defined key_dynspg_exp 498 SUBROUTINE obc_dta_bt( kt, kbt ) 499 !!--------------------------------------------------------------------------- 500 !! *** SUBROUTINE obc_dta *** 501 !! 502 !! ** Purpose : time interpolation of barotropic data for time-splitting scheme 503 !! Data at the boundary must be in m2/s 504 !! 505 !! History : 506 !! 9.0 ! 05-11 (V. garnier) Original code 507 !!--------------------------------------------------------------------------- 508 !! * Arguments 509 INTEGER, INTENT( in ) :: kt ! ocean time-step index 510 INTEGER, INTENT( in ) :: kbt ! barotropic ocean time-step index 511 512 !! * Local declarations 513 INTEGER :: ji, jj, jk, ii, ij ! dummy loop indices 514 INTEGER :: id_e, id_w, id_n, id_s, fid ! file identifiers 515 INTEGER :: itimo, iman, imois, i15 516 INTEGER :: itobcm, itobcp, itimom, itimop 517 REAL(wp) :: zxy 518 INTEGER :: isrel, ikt ! number of seconds since 1/1/1992 519 INTEGER :: iprint ! frequency for printouts. 520 521 !!--------------------------------------------------------------------------- 522 523 ! 1. First call: check time frames available in files. 524 ! ------------------------------------------------------- 525 526 IF( kt == nit000 ) THEN 527 528 ! 1.1 Barotropic tangential velocities set to zero 529 ! ------------------------------------------------- 530 IF( lp_obc_east ) vbtfoe(:) = 0.e0 531 IF( lp_obc_west ) vbtfow(:) = 0.e0 532 IF( lp_obc_south ) ubtfos(:) = 0.e0 533 IF( lp_obc_north ) ubtfon(:) = 0.e0 534 535 ! 1.2 Sea surface height and normal barotropic velocities set to zero 536 ! or initial conditions if nobc_dta == 0 537 ! -------------------------------------------------------------------- 538 539 IF( lp_obc_east ) THEN 540 ! initialisation to zero 541 sshedta(:,:) = 0.e0 542 ubtedta(:,:) = 0.e0 543 ! ! ================== ! 544 IF( nobc_dta == 0 ) THEN ! initial state used ! 545 ! ! ================== ! 546 ! Fills sedta, tedta, uedta (global arrays) 547 ! Remark: this works for njzoom = 1. Should the definition of ij include njzoom? 548 DO ji = nie0, nie1 549 DO jj = nje0p1, nje1m1 550 ij = jj -1 + njmpp 551 sshedta(ij,1) = sshn(ji+1,jj) * tmask(ji+1,jj,1) 552 END DO 553 END DO 554 ENDIF 555 ENDIF 556 557 IF( lp_obc_west) THEN 558 ! initialisation to zero 559 sshwdta(:,:) = 0.e0 560 ubtwdta(:,:) = 0.e0 561 ! ! ================== ! 562 IF( nobc_dta == 0 ) THEN ! initial state used ! 563 ! ! ================== ! 564 ! Fills swdta, twdta, uwdta (global arrays) 565 ! Remark: this works for njzoom = 1. Should the definition of ij include njzoom? 566 DO ji = niw0, niw1 567 DO jj = njw0p1, njw1m1 568 ij = jj -1 + njmpp 569 sshwdta(ij,1) = sshn(ji,jj) * tmask(ji,jj,1) 570 END DO 571 END DO 572 ENDIF 573 ENDIF 574 575 IF( lp_obc_north) THEN 576 ! initialisation to zero 577 sshndta(:,:) = 0.e0 578 vbtndta(:,:) = 0.e0 579 ! ! ================== ! 580 IF( nobc_dta == 0 ) THEN ! initial state used ! 581 ! ! ================== ! 582 ! Fills sndta, tndta, vndta (global arrays) 583 ! Remark: this works for njzoom = 1. Should the definition of ij include njzoom? 584 DO jj = njn0, njn1 585 DO ji = nin0p1, nin1m1 586 DO jk = 1, jpkm1 587 ii = ji -1 + nimpp 588 vbtndta(ii,1) = vbtndta(ii,1) + vndta(ii,jk,1)*fse3v(ji,jj,jk) 589 END DO 590 sshndta(ii,1) = sshn(ii,jj+1) * tmask(ji,jj+1,1) 591 END DO 592 END DO 593 ENDIF 594 ENDIF 595 596 IF( lp_obc_south) THEN 597 ! initialisation to zero 598 ssdta(:,:,:) = 0.e0 599 tsdta(:,:,:) = 0.e0 600 vsdta(:,:,:) = 0.e0 601 sshsdta(:,:) = 0.e0 602 vbtsdta(:,:) = 0.e0 603 ! ! ================== ! 604 IF( nobc_dta == 0 ) THEN ! initial state used ! 605 ! ! ================== ! 606 ! Fills ssdta, tsdta, vsdta (global arrays) 607 ! Remark: this works for njzoom = 1. Should the definition of ij include njzoom? 608 DO jj = njs0, njs1 609 DO ji = nis0p1, nis1m1 610 DO jk = 1, jpkm1 611 ii = ji -1 + nimpp 612 vbtsdta(ii,1) = vbtsdta(ii,1) + vsdta(ii,jk,1)*fse3v(ji,jj,jk) 613 END DO 614 sshsdta(ii,1) = sshn(ji,jj) * tmask(ii,jj,1) 615 END DO 616 END DO 617 ENDIF 618 ENDIF 619 620 ENDIF ! END IF kt == nit000 621 622 !!------------------------------------------------------------------------------------ 623 ! 2. Initialize the time we are at. Does this every time the routine is called, 624 ! excepted when nobc_dta = 0 625 ! 626 IF( nobc_dta == 0) THEN 627 itimo = 1 628 zxy = 0 629 ELSE 630 IF(ntobc == 1) THEN 631 itimo = 1 632 ELSE IF (ntobc == 12) THEN ! BC are monthly 633 ! we assume we have climatology in that case 634 iman = 12 635 i15 = nday / 16 636 imois = nmonth + i15 - 1 637 IF( imois == 0 ) imois = iman 638 itimo = imois 639 ELSE 640 IF(lwp) WRITE(numout,*) 'data other than constant or monthly',kt 641 iman = ntobc 642 itimo = FLOOR( kt*rdt / tcobc(1)) 643 isrel=kt*rdt 644 ENDIF 645 ENDIF 646 647 ! 2. Read two records in the file if necessary 648 ! --------------------------------------------- 649 650 IF( nobc_dta == 1 .AND. nlecto == 1 ) THEN 651 652 IF( lp_obc_east ) THEN 653 ! ... Read datafile and set sea surface height and barotropic velocity 654 ! ... initialise the sshedta, ubtedta arrays 655 sshedta(:,0) = sshedta(:,1) 656 ubtedta(:,0) = ubtedta(:,1) 657 CALL iom_open ( 'obceast_TS.nc', id_e ) 658 CALL iom_get ( id_e, jpdom_unknown, 'vossurfh', sshedta(:,1), ktime=ntobc1 ) 659 CALL iom_get ( id_e, jpdom_unknown, 'vossurfh', sshedta(:,2), ktime=ntobc2 ) 660 IF( lk_dynspg_ts ) THEN 661 CALL iom_get (id_e, jpdom_unknown, 'vossurfh', sshedta(:,3), ktime=ntobc2+1 ) 662 ENDIF 663 CALL iom_close ( id_e ) 664 ! 665 CALL iom_open ( 'obceast_U.nc', id_e ) 666 CALL iom_get ( id_e, jpdom_unknown, 'vozoubt', ubtedta(:,1), ktime=ntobc1 ) 667 CALL iom_get ( id_e, jpdom_unknown, 'vozoubt', ubtedta(:,2), ktime=ntobc2 ) 668 IF( lk_dynspg_ts ) THEN 669 CALL iom_get ( id_e, jpdom_unknown, 'vozoubt', ubtedta(:,3), ktime=ntobc2+1 ) 670 ENDIF 671 CALL iom_close ( id_e ) 672 ! ... Usually printout is done only once at kt = nit000, unless nprint (namelist) > 1 673 IF( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN 674 WRITE(numout,*) 675 WRITE(numout,*) ' Read East OBC barotropic data records ', ntobc1, ntobc2 676 iprint = (jpjef-jpjed+1)/20 +1 677 WRITE(numout,*) 678 WRITE(numout,*) ' Sea surface height record 1' 679 CALL prihre( sshedta(:,1), jpjef-jpjed+1, 1, 1, jpjef-jpjed+1, iprint, 1, 1, -3, 1., numout ) 680 WRITE(numout,*) 681 WRITE(numout,*) ' Normal transport (m2/s) record 1',iprint 682 CALL prihre( ubtedta(:,1), jpjef-jpjed+1, 1, 1, jpjef-jpjed+1, iprint, 1, 1, -3, 1., numout ) 683 ENDIF 684 ENDIF 685 686 IF( lp_obc_west ) THEN 687 ! ... Read datafile and set temperature, salinity and normal velocity 688 ! ... initialise the swdta, twdta, uwdta arrays 689 sshwdta(:,0) = sshwdta(:,1) 690 ubtwdta(:,0) = ubtwdta(:,1) 691 CALL iom_open ( 'obcwest_TS.nc', id_w ) 692 CALL iom_get ( id_w, jpdom_unknown, 'vossurfh', sshwdta(:,1), ktime=ntobc1 ) 693 CALL iom_get ( id_w, jpdom_unknown, 'vossurfh', sshwdta(:,2), ktime=ntobc2 ) 694 IF( lk_dynspg_ts ) THEN 695 CALL ( id_w, jpdom_unknown, 'vossurfh', sshwdta(:,3), ktime=ntobc2+1 ) 696 ENDIF 697 CALL iom_close ( id_w ) 698 ! 699 CALL iom_open ( 'obcwest_U.nc', id_w ) 700 CALL iom_get ( id_w, jpdom_unknown, 'vozoubt', ubtwdta(:,1), ktime=ntobc1 ) 701 CALL iom_get ( id_w, jpdom_unknown, 'vozoubt', ubtwdta(:,2), ktime=ntobc2 ) 702 IF( lk_dynspg_ts ) THEN 703 CALL iom_get ( id_w, jpdom_unknown, 'vozoubt', ubtwdta(:,3), ktime=ntobc2+1 ) 704 ENDIF 705 CALL iom_close ( id_w ) 706 ! ... Usually printout is done only once at kt = nit000, unless nprint (namelist) > 1 707 IF( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN 708 WRITE(numout,*) 709 WRITE(numout,*) ' Read West OBC barotropic data records ', ntobc1, ntobc2 710 iprint = (jpjwf-jpjwd+1)/20 +1 711 WRITE(numout,*) 712 WRITE(numout,*) ' Sea surface height record 1 - printout surface level' 713 CALL prihre( sshwdta(:,1), jpjwf-jpjwd+1, 1, 1, jpjwf-jpjwd+1, iprint, 1, 1, -3, 1., numout ) 714 WRITE(numout,*) 715 WRITE(numout,*) ' Normal transport (m2/s) record 1' 716 CALL prihre( ubtwdta(:,1), jpjwf-jpjwd+1, 1, 1, jpjwf-jpjwd+1, iprint, 1, 1, -3, 1., numout ) 717 ENDIF 718 ENDIF 719 720 IF( lp_obc_north) THEN 721 ! ... Read datafile and set sea surface height and barotropic velocity 722 ! ... initialise the sshndta, ubtndta arrays 723 sshndta(:,0) = sshndta(:,1) 724 vbtndta(:,0) = vbtndta(:,1) 725 CALL iom_open ( 'obcnorth_TS.nc', id_n ) 726 CALL iom_get (id_n, jpdom_unknown, 'vossurfh', sshndta(:,1), ktime=ntobc1 ) 727 CALL iom_get (id_n, jpdom_unknown, 'vossurfh', sshndta(:,2), ktime=ntobc2 ) 728 IF( lk_dynspg_ts ) THEN 729 CALL iom_get (id_n, jpdom_unknown, 'vossurfh', sshndta(:,3), ktime=ntobc2+1 ) 730 ENDIF 731 CALL iom_close ( id_n ) 732 733 CALL iom_open ( 'obcnorth_V.nc', id_n ) 734 CALL iom_get (id_n, jpdom_unknown, 'vomevbt', vbtndta(:,1), ktime=ntobc1 ) 735 CALL iom_get (id_n, jpdom_unknown, 'vomevbt', vbtndta(:,2), ktime=ntobc2 ) 736 IF( lk_dynspg_ts ) THEN 737 CALL iom_get (id_n, jpdom_unknown, 'vomevbt', vbtndta(:,3), ktime=ntobc2+1 ) 738 ENDIF 739 CALL iom_close ( id_n ) 740 741 ! ... Usually printout is done only once at kt = nit000, unless nprint (namelist) > 1 742 IF( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN 743 WRITE(numout,*) 744 WRITE(numout,*) ' Read North OBC barotropic data records ', ntobc1, ntobc2 745 iprint = (jpinf-jpind+1)/20 +1 746 WRITE(numout,*) 747 WRITE(numout,*) ' Sea surface height record 1 - printout surface level' 748 CALL prihre( sshndta(:,1), jpinf-jpind+1, 1, 1, jpinf-jpind+1, iprint, 1, 1, -3, 1., numout ) 749 WRITE(numout,*) 750 WRITE(numout,*) ' Normal transport (m2/s) record 1' 751 CALL prihre( vbtndta(:,1), jpinf-jpind+1, 1, 1, jpinf-jpind+1, iprint, 1, 1, -3, 1., numout ) 752 ENDIF 753 ENDIF 754 755 IF( lp_obc_south) THEN 756 ! ... Read datafile and set sea surface height and barotropic velocity 757 ! ... initialise the sshsdta, ubtsdta arrays 758 sshsdta(:,0) = sshsdta(:,1) 759 vbtsdta(:,0) = vbtsdta(:,1) 760 CALL iom_open ( 'obcsouth_TS.nc', id_s ) 761 CALL iom_get ( id_s, jpdom_unknown, 'vossurfh', sshsdta(:,1), ktime=ntobc1 ) 762 CALL iom_get ( id_s, jpdom_unknown, 'vossurfh', sshsdta(:,2), ktime=ntobc2 ) 763 IF( lk_dynspg_ts ) THEN 764 CALL iom_get ( id_s, jpdom_unknown, 'vossurfh', sshsdta(:,3), ktime=ntobc2+1 ) 765 ENDIF 766 CALL iom_close ( id_s ) 767 768 CALL iom_open ( 'obcsouth_V.nc', id_s ) 769 CALL iom_get ( id_s, jpdom_unknown, 'vomevbt', vbtsdta(:,1), ktime=ntobc1 ) 770 CALL iom_get ( id_s, jpdom_unknown, 'vomevbt', vbtsdta(:,2), ktime=ntobc2 ) 771 IF( lk_dynspg_ts ) THEN 772 CALL iom_get ( id_s, jpdom_unknown, 'vomevbt', vbtsdta(:,3), ktime=ntobc2+1 ) 773 ENDIF 774 CALL iom_close ( id_s ) 775 776 ! ... Usually printout is done only once at kt = nit000, unless nprint (namelist) > 1 777 IF( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN 778 WRITE(numout,*) 779 WRITE(numout,*) ' Read South OBC barotropic data records ', ntobc1, ntobc2 780 iprint = (jpisf-jpisd+1)/20 +1 781 WRITE(numout,*) 782 WRITE(numout,*) ' Sea surface height record 1 - printout surface level' 783 CALL prihre( sshsdta(:,1), jpisf-jpisd+1, 1, 1, jpisf-jpisd+1, iprint, 1, 1, -3, 1., numout ) 784 WRITE(numout,*) 785 WRITE(numout,*) ' Normal transport (m2/s) record 1' 786 CALL prihre( vbtsdta(:,1), jpisf-jpisd+1, 1, 1, jpisf-jpisd+1, iprint, 1, 1, -3, 1., numout ) 787 ENDIF 788 ENDIF 789 790 ENDIF ! end of the test on the condition to read or not the files 791 792 ! 3. Call at every time step : Linear interpolation of BCs to current time step 793 ! ---------------------------------------------------------------------- 794 795 IF( lk_dynspg_ts ) THEN 796 isrel = (kt-1)*rdt + kbt*(rdt/REAL(nn_baro,wp)) 797 798 IF( nobc_dta == 1 ) THEN 799 isrel = (kt-1)*rdt + kbt*(rdt/REAL(nn_baro,wp)) 800 itimo = FLOOR( kt*rdt / (tcobc(2)-tcobc(1)) ) 801 itimom = FLOOR( (kt-1)*rdt / (tcobc(2)-tcobc(1)) ) 802 itimop = FLOOR( (kt+1)*rdt / (tcobc(2)-tcobc(1)) ) 803 IF( itimom == itimo .AND. itimop == itimo ) THEN 804 itobcm = ntobc1 805 itobcp = ntobc2 806 807 ELSEIF ( itimom <= itimo .AND. itimop == itimo ) THEN 808 IF( FLOOR( isrel / (tcobc(2)-tcobc(1)) ) < itimo ) THEN 809 itobcm = ntobc1-1 810 itobcp = ntobc2-1 811 ELSE 812 itobcm = ntobc1 813 itobcp = ntobc2 814 ENDIF 815 816 ELSEIF ( itimom == itimo .AND. itimop >= itimo ) THEN 817 IF( FLOOR( isrel / (tcobc(2)-tcobc(1)) ) < itimop ) THEN 818 itobcm = ntobc1 819 itobcp = ntobc2 820 ELSE 821 itobcm = ntobc1+1 822 itobcp = ntobc2+1 823 ENDIF 824 825 ELSEIF ( itimom == itimo-1 .AND. itimop == itimo+1 ) THEN 826 IF( FLOOR( isrel / (tcobc(2)-tcobc(1)) ) < itimo ) THEN 827 itobcm = ntobc1-1 828 itobcp = ntobc2-1 829 ELSEIF ( FLOOR( isrel / (tcobc(2)-tcobc(1)) ) < itimop ) THEN 830 itobcm = ntobc1 831 itobcp = ntobc2 832 ELSEIF ( FLOOR( isrel / (tcobc(2)-tcobc(1)) ) == itimop ) THEN 833 itobcm = ntobc1+1 834 itobcp = ntobc2+2 835 ELSE 836 IF(lwp) WRITE(numout, *) 'obc_dta_bt: You should not have seen this print! error 1?' 837 ENDIF 838 ELSE 839 IF(lwp) WRITE(numout, *) 'obc_dta_bt: You should not have seen this print! error 2?' 840 ENDIF 841 842 ENDIF 843 844 ELSE IF( lk_dynspg_exp ) THEN 845 isrel=kt*rdt 846 itobcm = ntobc1 847 itobcp = ntobc2 848 ENDIF 849 850 IF( ntobc == 1 .OR. nobc_dta == 0 ) THEN 851 zxy = 0.e0 852 ELSE IF( ntobc == 12 ) THEN 853 zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 854 ELSE 855 zxy = (tcobc(itobcm)-FLOAT(isrel)) / (tcobc(itobcm)-tcobc(itobcp)) 856 ENDIF 857 858 IF( lp_obc_east ) THEN ! fills sshfoe, ubtfoe (local to each processor) 859 DO jj = nje0p1, nje1m1 860 ij = jj -1 + njmpp 861 sshfoe(jj) = ( zxy * sshedta(ij,2) + (1.-zxy) * sshedta(ij,1) ) * temsk(jj,1) 862 ubtfoe(jj) = ( zxy * ubtedta(ij,2) + (1.-zxy) * ubtedta(ij,1) ) * uemsk(jj,1) 863 END DO 864 ENDIF 865 866 IF( lp_obc_west) THEN ! fills sshfow, ubtfow (local to each processor) 867 DO jj = njw0p1, njw1m1 868 ij = jj -1 + njmpp 869 sshfow(jj) = ( zxy * sshwdta(ij,2) + (1.-zxy) * sshwdta(ij,1) ) * twmsk(jj,1) 870 ubtfow(jj) = ( zxy * ubtwdta(ij,2) + (1.-zxy) * ubtwdta(ij,1) ) * uwmsk(jj,1) 871 END DO 872 ENDIF 873 874 IF( lp_obc_north) THEN ! fills sshfon, vbtfon (local to each processor) 875 DO ji = nin0p1, nin1m1 876 ii = ji -1 + nimpp 877 sshfon(ji) = ( zxy * sshndta(ii,2) + (1.-zxy) * sshndta(ii,1) ) * tnmsk(ji,1) 878 vbtfon(ji) = ( zxy * vbtndta(ii,2) + (1.-zxy) * vbtndta(ii,1) ) * vnmsk(ji,1) 879 END DO 880 ENDIF 881 882 IF( lp_obc_south) THEN ! fills sshfos, vbtfos (local to each processor) 883 DO ji = nis0p1, nis1m1 884 ii = ji -1 + nimpp 885 sshfos(ji) = ( zxy * sshsdta(ii,2) + (1.-zxy) * sshsdta(ii,1) ) * tsmsk(ji,1) 886 vbtfos(ji) = ( zxy * vbtsdta(ii,2) + (1.-zxy) * vbtsdta(ii,1) ) * vsmsk(ji,1) 887 END DO 888 ENDIF 889 890 END SUBROUTINE obc_dta_bt 891 892 #else 893 !!----------------------------------------------------------------------------- 894 !! Default option 895 !!----------------------------------------------------------------------------- 896 SUBROUTINE obc_dta_bt ( kt, kbt ) ! Empty routine 897 !! * Arguments 898 INTEGER,INTENT(in) :: kt 899 INTEGER, INTENT( in ) :: kbt ! barotropic ocean time-step index 900 WRITE(*,*) 'obc_dta_bt: You should not have seen this print! error?', kt 901 WRITE(*,*) 'obc_dta_bt: You should not have seen this print! error?', kbt 902 END SUBROUTINE obc_dta_bt 903 #endif 904 905 906 !!============================================================================== 907 SUBROUTINE obc_read (kt, nt_x, ntobc_x, iyy, imm) 908 !!------------------------------------------------------------------------- 909 !! *** ROUTINE obc_read *** 910 !! 911 !! ** Purpose : Read the boundary data in files identified by iyy and imm 912 !! According to the validated open boundaries, return the 913 !! following arrays : 914 !! sedta, tedta : East OBC salinity and temperature 915 !! uedta, vedta : " " u and v velocity component 916 !! 917 !! swdta, twdta : West OBC salinity and temperature 918 !! uwdta, vwdta : " " u and v velocity component 919 !! 920 !! sndta, tndta : North OBC salinity and temperature 921 !! undta, vndta : " " u and v velocity component 922 !! 923 !! ssdta, tsdta : South OBC salinity and temperature 924 !! usdta, vsdta : " " u and v velocity component 925 !! 926 !! ** Method : These fields are read in the record ntobc_x of the files. 927 !! The number of records is already known. If ntobc_x is greater 928 !! than the number of record, this routine will look for next file, 929 !! updating the indices (case of inter-annual obcs) or loop at the 930 !! begining in case of climatological file (ln_obc_clim = true ). 931 !! ------------------------------------------------------------------------- 932 !! History: ! 2005 ( P. Mathiot, C. Langlais ) Original code 933 !! ! 2008 ( J,M, Molines ) Use IOM and cleaning 934 !!-------------------------------------------------------------------------- 935 936 ! * Arguments 937 INTEGER, INTENT( in ) :: kt, nt_x 938 INTEGER, INTENT( inout ) :: ntobc_x , iyy, imm ! yes ! inout ! 939 940 ! * Local variables 941 CHARACTER (len=40) :: & ! file names 316 ! all logical-mask are initialzed to true when declared 317 WHERE ( temsk == 0 ) ltemsk=.FALSE. 318 WHERE ( uemsk == 0 ) luemsk=.FALSE. 319 WHERE ( vemsk == 0 ) lvemsk=.FALSE. 320 321 WHERE ( twmsk == 0 ) ltwmsk=.FALSE. 322 WHERE ( uwmsk == 0 ) luwmsk=.FALSE. 323 WHERE ( vwmsk == 0 ) lvwmsk=.FALSE. 324 325 WHERE ( tnmsk == 0 ) ltnmsk=.FALSE. 326 WHERE ( unmsk == 0 ) lunmsk=.FALSE. 327 WHERE ( vnmsk == 0 ) lvnmsk=.FALSE. 328 329 WHERE ( tsmsk == 0 ) ltsmsk=.FALSE. 330 WHERE ( usmsk == 0 ) lusmsk=.FALSE. 331 WHERE ( vsmsk == 0 ) lvsmsk=.FALSE. 332 333 iyear=1950; imonth=01; iday=01; zsec=0. 334 ! zjuliancnes : julian day corresonding to 01/01/1950 335 CALL ymds2ju(iyear, imonth, iday,zsec , zjuliancnes) 336 337 !current year and curent month 338 iyy=INT(ndastp/10000) ; imm=INT((ndastp -iyy*10000)/100) ; idd=(ndastp-iyy*10000-imm*100) 339 IF (iyy < 1900) iyy = iyy+1900 ! always assume that years are on 4 digits. 340 CALL ymds2ju(iyy, imm, idd ,zsec , zjulian) 341 ndate0_cnes = zjulian - zjuliancnes ! jcnes day when call to obc_dta_ini 342 343 iyyfile=iyy ; immfile=0 ! set component of the current file name 344 IF ( cffile /= 'annual') immfile=imm 345 IF ( ln_obc_clim) iyyfile = 0 ! assume that climatological files are labeled y0000 346 347 CALL obc_dta_chktime ( iyyfile, immfile ) 348 349 IF ( itobc == 1 ) THEN 350 ! in this case we will provide boundary data only once. 351 nt_a=1 ; ntobc_a=1 352 CALL obc_read (nit000, nt_a, ntobc_a, iyyfile, immfile) 353 IF( lp_obc_east ) THEN 354 ! fills sfoe, tfoe, ufoe ,vfoe 355 sfoe(:,:) = sedta (:,:,1) ; tfoe(:,:) = tedta (:,:,1) 356 ufoe(:,:) = uedta (:,:,1) ; vfoe(:,:) = vedta (:,:,1) 357 ENDIF 358 359 IF( lp_obc_west) THEN 360 ! fills sfow, tfow, ufow ,vfow 361 sfow(:,:) = swdta (:,:,1) ; tfow(:,:) = twdta (:,:,1) 362 ufow(:,:) = uwdta (:,:,1) ; vfow(:,:) = vwdta (:,:,1) 363 ENDIF 364 365 IF( lp_obc_north) THEN 366 ! fills sfon, tfon, ufon ,vfon 367 sfon(:,:) = sndta (:,:,1) ; tfon(:,:) = tndta (:,:,1) 368 ufon(:,:) = undta (:,:,1) ; vfon(:,:) = vndta (:,:,1) 369 ENDIF 370 371 IF( lp_obc_south) THEN 372 ! fills sfos, tfos, ufos ,vfos 373 sfos(:,:) = ssdta (:,:,1) ; tfos(:,:) = tsdta (:,:,1) 374 ufos(:,:) = usdta (:,:,1) ; vfos(:,:) = vsdta (:,:,1) 375 ENDIF 376 RETURN ! we go out of obc_dta_ini -------------------------------------->>>>> 377 ENDIF 378 379 ! nday_year is the day number in the current year ( 1 for 01/01 ) 380 ! we suppose that we always start from the begining of a day 381 ! zsec=MOD( (kt-nit000)*rdt - (nday_year - nday_year0 )*rday, rday ) ! number of seconds in the current day 382 zsec=0.e0 ! here, kt=nit000, nday_year = ndat_year0 383 384 IF (ln_obc_clim) THEN 385 zjcnes = nday_year - 1 + zsec/rday ! for clim file time is in days in a year 386 ELSE 387 zjcnes = ndate0_cnes + (nday_year - nday_year0 ) + zsec/rday 388 ENDIF 389 390 ! look for 'before' record number in the current file 391 ntobc = nrecbef () 392 393 IF (lwp) WRITE(numout,*) 'obc files frequency :',cffile 394 IF (lwp) WRITE(numout,*) ' zjcnes0 =',zjcnes,' ndastp0 =',ndastp 395 IF (lwp) WRITE(numout,*) ' annee0 ',iyy,' month0 ', imm,' day0 ', idd 396 IF (lwp) WRITE(numout,*) 'first file open :',cl_obc_nTS 397 398 ! record initialisation 399 !-------------------- 400 nt_b = 1 ; nt_a = 2 401 402 ntobc_a = ntobc + 1 403 ntobc_b = ntobc 404 405 CALL obc_read (kt, nt_b, ntobc_b, iyyfile, immfile) ! read 'before' fields 406 CALL obc_read (kt, nt_a, ntobc_a, iyyfile, immfile) ! read 'after' fields 407 408 ! additional frame in case of time-splitting 409 # if defined key_dynspg_ts 410 nt_m = 0 411 ntobc_m=mod(ntobc_b-2+itobc,itobc)+1 412 zjcnes_obc(nt_m)= ztcobc(ntobc_m) ! FDbug has not checked that this is correct!! 413 IF (ln_rstart) THEN 414 CALL obc_read (kt, nt_m, ntobc_m, iyyfile, immfile) ! read 'after' fields 415 ENDIF 416 # endif 417 418 zjcnes_obc(nt_b)= ztcobc(ntobc_b) 419 zjcnes_obc(nt_a)= ztcobc(ntobc_a) 420 ! 421 END SUBROUTINE obc_dta_ini 422 423 424 SUBROUTINE obc_dta_chktime (kyyfile, kmmfile) 425 ! 426 ! check the number of time steps in the files and read ztcobc 427 ! 428 ! * Arguments 429 INTEGER, INTENT(in) :: kyyfile, kmmfile 430 ! * local variables 431 INTEGER :: istop ! error control 432 INTEGER :: ji ! dummy loop index 433 434 INTEGER :: idvar, id_e, id_w, id_n, id_s ! file identifiers 435 INTEGER, DIMENSION(1) :: itmp 436 CHARACTER(LEN=25) :: cl_vname 437 438 ntobc_a = 0; itobce =0 ; itobcw = 0; itobcn = 0; itobcs = 0 439 ! build file name 440 IF(ln_obc_clim) THEN ! revert to old convention for climatological OBC forcing 441 cl_obc_eTS='obceast_TS.nc' 442 cl_obc_wTS='obcwest_TS.nc' 443 cl_obc_nTS='obcnorth_TS.nc' 444 cl_obc_sTS='obcsouth_TS.nc' 445 ELSE ! convention for climatological OBC 446 WRITE(cl_obc_eTS ,'("obc_east_TS_y",i4.4,"m",i2.2,".nc")' ) kyyfile,kmmfile 447 WRITE(cl_obc_wTS ,'("obc_west_TS_y",i4.4,"m",i2.2,".nc")' ) kyyfile,kmmfile 448 WRITE(cl_obc_nTS ,'("obc_north_TS_y",i4.4,"m",i2.2,".nc")' ) kyyfile,kmmfile 449 WRITE(cl_obc_sTS ,'("obc_south_TS_y",i4.4,"m",i2.2,".nc")' ) kyyfile,kmmfile 450 ENDIF 451 452 cl_vname = 'time_counter' 453 IF ( lp_obc_east ) THEN 454 CALL iom_open ( cl_obc_eTS , id_e ) 455 idvar = iom_varid( id_e, cl_vname, kdimsz = itmp ); itobce=itmp(1) 456 ENDIF 457 IF ( lp_obc_west ) THEN 458 CALL iom_open ( cl_obc_wTS , id_w ) 459 idvar = iom_varid( id_w, cl_vname, kdimsz = itmp ) ; itobcw=itmp(1) 460 ENDIF 461 IF ( lp_obc_north ) THEN 462 CALL iom_open ( cl_obc_nTS , id_n ) 463 idvar = iom_varid( id_n, cl_vname, kdimsz = itmp ) ; itobcn=itmp(1) 464 ENDIF 465 IF ( lp_obc_south ) THEN 466 CALL iom_open ( cl_obc_sTS , id_s ) 467 idvar = iom_varid( id_s, cl_vname, kdimsz = itmp ) ; itobcs=itmp(1) 468 ENDIF 469 470 itobc = MAX( itobce, itobcw, itobcn, itobcs ) 471 istop = 0 472 IF ( lp_obc_east .AND. itobce /= itobc ) istop = istop+1 473 IF ( lp_obc_west .AND. itobcw /= itobc ) istop = istop+1 474 IF ( lp_obc_north .AND. itobcn /= itobc ) istop = istop+1 475 IF ( lp_obc_south .AND. itobcs /= itobc ) istop = istop+1 476 nstop = nstop + istop 477 478 IF ( istop /= 0 ) THEN 479 WRITE(ctmp1,*) ' east, west, north, south: ', itobce, itobcw, itobcn, itobcs 480 CALL ctl_stop( 'obcdta : all files must have the same number of time steps', ctmp1 ) 481 ENDIF 482 483 IF ( itobc == 1 ) THEN 484 IF (lwp) THEN 485 WRITE(numout,*) ' obcdta found one time step only in the OBC files' 486 IF (ln_obc_clim) THEN 487 ! OK no problem 488 ELSE 489 ln_obc_clim=.true. 490 WRITE(numout,*) ' we force ln_obc_clim to T' 491 ENDIF 492 ENDIF 493 ELSE 494 IF ( ALLOCATED(ztcobc) ) DEALLOCATE ( ztcobc ) 495 ALLOCATE (ztcobc(itobc)) 496 DO ji=1,1 ! use a dummy loop to read ztcobc only once 497 IF ( lp_obc_east ) THEN 498 CALL iom_gettime ( id_e, ztcobc, cl_vname ) ; CALL iom_close (id_e) ; EXIT 499 ENDIF 500 IF ( lp_obc_west ) THEN 501 CALL iom_gettime ( id_w, ztcobc, cl_vname ) ; CALL iom_close (id_w) ; EXIT 502 ENDIF 503 IF ( lp_obc_north ) THEN 504 CALL iom_gettime ( id_n, ztcobc, cl_vname ) ; CALL iom_close (id_n) ; EXIT 505 ENDIF 506 IF ( lp_obc_south ) THEN 507 CALL iom_gettime ( id_s, ztcobc, cl_vname ) ; CALL iom_close (id_s) ; EXIT 508 ENDIF 509 END DO 510 rdt_obc = ztcobc(2)-ztcobc(1) ! just an information, not used for any computation 511 IF (lwp) WRITE(numout,*) ' obcdta found', itobc,' time steps in the OBC files' 512 IF (lwp) WRITE(numout,*) ' time step of obc data :', rdt_obc,' days' 513 ENDIF 514 zjcnes = zjcnes - rdt/rday ! trick : zcnes is always incremented by rdt/rday in obc_dta! 515 END SUBROUTINE obc_dta_chktime 516 517 # if defined key_dynspg_ts || defined key_dynspg_exp 518 SUBROUTINE obc_dta_bt( kt, kbt ) 519 !!--------------------------------------------------------------------------- 520 !! *** SUBROUTINE obc_dta *** 521 !! 522 !! ** Purpose : time interpolation of barotropic data for time-splitting scheme 523 !! Data at the boundary must be in m2/s 524 !! 525 !! History : 526 !! 9.0 ! 05-11 (V. garnier) Original code 527 !!--------------------------------------------------------------------------- 528 !! * Arguments 529 INTEGER, INTENT( in ) :: kt ! ocean time-step index 530 INTEGER, INTENT( in ) :: kbt ! barotropic ocean time-step index 531 532 !! * Local declarations 533 INTEGER :: ji, jj ! dummy loop indices 534 INTEGER :: i15 535 INTEGER :: itobcm, itobcp 536 REAL(wp) :: zxy 537 INTEGER :: isrel ! number of seconds since 1/1/1992 538 539 !!--------------------------------------------------------------------------- 540 541 ! 1. First call: check time frames available in files. 542 ! ------------------------------------------------------- 543 544 IF( kt == nit000 ) THEN 545 546 ! 1.1 Barotropic tangential velocities set to zero 547 ! ------------------------------------------------- 548 IF( lp_obc_east ) vbtfoe(:) = 0.e0 549 IF( lp_obc_west ) vbtfow(:) = 0.e0 550 IF( lp_obc_south ) ubtfos(:) = 0.e0 551 IF( lp_obc_north ) ubtfon(:) = 0.e0 552 553 ! 1.2 Sea surface height and normal barotropic velocities set to zero 554 ! or initial conditions if nobc_dta == 0 555 ! -------------------------------------------------------------------- 556 557 IF( lp_obc_east ) THEN 558 ! initialisation to zero 559 sshedta(:,:) = 0.e0 560 ubtedta(:,:) = 0.e0 561 vbtedta(:,:) = 0.e0 ! tangential component 562 ! ! ================== ! 563 IF( nobc_dta == 0 ) THEN ! initial state used ! 564 ! ! ================== ! 565 ! Fills sedta, tedta, uedta (global arrays) 566 ! Remark: this works for njzoom = 1. Should the definition of ij include njzoom? 567 DO ji = nie0, nie1 568 DO jj = 1, jpj 569 sshedta(jj,1) = sshn(ji+1,jj) * tmask(ji+1,jj,1) 570 END DO 571 END DO 572 ENDIF 573 ENDIF 574 575 IF( lp_obc_west) THEN 576 ! initialisation to zero 577 sshwdta(:,:) = 0.e0 578 ubtwdta(:,:) = 0.e0 579 vbtwdta(:,:) = 0.e0 ! tangential component 580 ! ! ================== ! 581 IF( nobc_dta == 0 ) THEN ! initial state used ! 582 ! ! ================== ! 583 ! Fills swdta, twdta, uwdta (global arrays) 584 ! Remark: this works for njzoom = 1. Should the definition of ij include njzoom? 585 DO ji = niw0, niw1 586 DO jj = 1, jpj 587 sshwdta(jj,1) = sshn(ji,jj) * tmask(ji,jj,1) 588 END DO 589 END DO 590 ENDIF 591 ENDIF 592 593 IF( lp_obc_north) THEN 594 ! initialisation to zero 595 sshndta(:,:) = 0.e0 596 ubtndta(:,:) = 0.e0 ! tangential component 597 vbtndta(:,:) = 0.e0 598 ! ! ================== ! 599 IF( nobc_dta == 0 ) THEN ! initial state used ! 600 ! ! ================== ! 601 ! Fills sndta, tndta, vndta (global arrays) 602 ! Remark: this works for njzoom = 1. Should the definition of ij include njzoom? 603 DO jj = njn0, njn1 604 DO ji = 1, jpi 605 sshndta(ji,1) = sshn(ji,jj+1) * tmask(ji,jj+1,1) 606 END DO 607 END DO 608 ENDIF 609 ENDIF 610 611 IF( lp_obc_south) THEN 612 ! initialisation to zero 613 sshsdta(:,:) = 0.e0 614 ubtsdta(:,:) = 0.e0 ! tangential component 615 vbtsdta(:,:) = 0.e0 616 ! ! ================== ! 617 IF( nobc_dta == 0 ) THEN ! initial state used ! 618 ! ! ================== ! 619 ! Fills ssdta, tsdta, vsdta (global arrays) 620 ! Remark: this works for njzoom = 1. Should the definition of ij include njzoom? 621 DO jj = njs0, njs1 622 DO ji = 1, jpi 623 sshsdta(ji,1) = sshn(ji,jj) * tmask(ji,jj,1) 624 END DO 625 END DO 626 ENDIF 627 ENDIF 628 629 IF( nobc_dta == 0 ) CALL obc_depth_average(1) ! depth averaged velocity from the OBC depth-dependent frames 630 631 ENDIF ! END kt == nit000 632 633 !!------------------------------------------------------------------------------------ 634 ! 2. Initialize the time we are at. Does this every time the routine is called, 635 ! excepted when nobc_dta = 0 636 ! 637 638 ! 3. Call at every time step : Linear interpolation of BCs to current time step 639 ! ---------------------------------------------------------------------- 640 641 IF( lk_dynspg_ts ) THEN 642 isrel = (kt-1)*rdt + kbt*(rdt/REAL(nn_baro,wp)) 643 ELSE IF( lk_dynspg_exp ) THEN 644 isrel=kt*rdt 645 ENDIF 646 647 itobcm = nt_b 648 itobcp = nt_a 649 IF( itobc == 1 .OR. nobc_dta == 0 ) THEN 650 zxy = 0.e0 651 itobcm = 1 652 itobcp = 1 653 ELSE IF( itobc == 12 ) THEN 654 i15 = nday / 16 655 zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 656 ELSE 657 zxy = (zjcnes_obc(nt_a)-FLOAT(isrel)) / (zjcnes_obc(nt_a)-zjcnes_obc(nt_b)) 658 IF( zxy < 0. ) THEN ! case of extrapolation, switch to old time frames 659 itobcm = nt_m 660 itobcp = nt_b 661 zxy = (zjcnes_obc(nt_b)-FLOAT(isrel)) / (zjcnes_obc(nt_b)-zjcnes_obc(nt_m)) 662 ENDIF 663 ENDIF 664 665 IF( lp_obc_east ) THEN ! fills sshfoe, ubtfoe (local to each processor) 666 DO jj = 1, jpj 667 sshfoe(jj) = zxy * sshedta(jj,itobcp) + (1.-zxy) * sshedta(jj,itobcm) 668 ubtfoe(jj) = zxy * ubtedta(jj,itobcp) + (1.-zxy) * ubtedta(jj,itobcm) 669 vbtfoe(jj) = zxy * vbtedta(jj,itobcp) + (1.-zxy) * vbtedta(jj,itobcm) 670 END DO 671 ENDIF 672 673 IF( lp_obc_west) THEN ! fills sshfow, ubtfow (local to each processor) 674 DO jj = 1, jpj 675 sshfow(jj) = zxy * sshwdta(jj,itobcp) + (1.-zxy) * sshwdta(jj,itobcm) 676 ubtfow(jj) = zxy * ubtwdta(jj,itobcp) + (1.-zxy) * ubtwdta(jj,itobcm) 677 vbtfow(jj) = zxy * vbtwdta(jj,itobcp) + (1.-zxy) * vbtwdta(jj,itobcm) 678 END DO 679 ENDIF 680 681 IF( lp_obc_north) THEN ! fills sshfon, vbtfon (local to each processor) 682 DO ji = 1, jpi 683 sshfon(ji) = zxy * sshndta(ji,itobcp) + (1.-zxy) * sshndta(ji,itobcm) 684 ubtfon(ji) = zxy * ubtndta(ji,itobcp) + (1.-zxy) * ubtndta(ji,itobcm) 685 vbtfon(ji) = zxy * vbtndta(ji,itobcp) + (1.-zxy) * vbtndta(ji,itobcm) 686 END DO 687 ENDIF 688 689 IF( lp_obc_south) THEN ! fills sshfos, vbtfos (local to each processor) 690 DO ji = 1, jpi 691 sshfos(ji) = zxy * sshsdta(ji,itobcp) + (1.-zxy) * sshsdta(ji,itobcm) 692 ubtfos(ji) = zxy * ubtsdta(ji,itobcp) + (1.-zxy) * ubtsdta(ji,itobcm) 693 vbtfos(ji) = zxy * vbtsdta(ji,itobcp) + (1.-zxy) * vbtsdta(ji,itobcm) 694 END DO 695 ENDIF 696 697 END SUBROUTINE obc_dta_bt 698 699 # else 700 !!----------------------------------------------------------------------------- 701 !! Default option 702 !!----------------------------------------------------------------------------- 703 SUBROUTINE obc_dta_bt ( kt, kbt ) ! Empty routine 704 !! * Arguments 705 INTEGER,INTENT(in) :: kt 706 INTEGER, INTENT( in ) :: kbt ! barotropic ocean time-step index 707 WRITE(*,*) 'obc_dta_bt: You should not have seen this print! error?', kt 708 WRITE(*,*) 'obc_dta_bt: You should not have seen this print! error?', kbt 709 END SUBROUTINE obc_dta_bt 710 # endif 711 712 SUBROUTINE obc_read (kt, nt_x, ntobc_x, iyy, imm) 713 !!------------------------------------------------------------------------- 714 !! *** ROUTINE obc_read *** 715 !! 716 !! ** Purpose : Read the boundary data in files identified by iyy and imm 717 !! According to the validated open boundaries, return the 718 !! following arrays : 719 !! sedta, tedta : East OBC salinity and temperature 720 !! uedta, vedta : " " u and v velocity component 721 !! 722 !! swdta, twdta : West OBC salinity and temperature 723 !! uwdta, vwdta : " " u and v velocity component 724 !! 725 !! sndta, tndta : North OBC salinity and temperature 726 !! undta, vndta : " " u and v velocity component 727 !! 728 !! ssdta, tsdta : South OBC salinity and temperature 729 !! usdta, vsdta : " " u and v velocity component 730 !! 731 !! ** Method : These fields are read in the record ntobc_x of the files. 732 !! The number of records is already known. If ntobc_x is greater 733 !! than the number of record, this routine will look for next file, 734 !! updating the indices (case of inter-annual obcs) or loop at the 735 !! begining in case of climatological file (ln_obc_clim = true ). 736 !! ------------------------------------------------------------------------- 737 !! History: ! 2005 ( P. Mathiot, C. Langlais ) Original code 738 !! ! 2008 ( J,M, Molines ) Use IOM and cleaning 739 !!-------------------------------------------------------------------------- 740 741 ! * Arguments 742 INTEGER, INTENT( in ) :: kt, nt_x 743 INTEGER, INTENT( inout ) :: ntobc_x , iyy, imm ! yes ! inout ! 744 745 ! * Local variables 746 CHARACTER (len=40) :: & ! file names 942 747 cl_obc_eTS , cl_obc_eU, cl_obc_eV,& 943 748 cl_obc_wTS , cl_obc_wU, cl_obc_wV,& … … 945 750 cl_obc_sTS , cl_obc_sU, cl_obc_sV 946 751 947 INTEGER :: ikprint 948 REAL(wp) :: zmin, zmax ! control of boundary values 949 950 !IOM stuff 951 INTEGER :: id_e, id_w, id_n, id_s, ji, jj 952 INTEGER, DIMENSION(2) :: istart, icount 953 954 !-------------------------------------------------------------------------- 955 IF ( ntobc_x > itobc ) THEN 956 IF (ln_obc_clim) THEN ! just loop on the same file 957 ntobc_x = 1 958 ELSE 959 ! need to change file : it is always for an 'after' data 960 IF ( cffile == 'annual' ) THEN ! go to next year file 961 iyy = iyy + 1 962 ELSE IF ( cffile =='monthly' ) THEN ! go to next month file 963 imm = imm + 1 964 IF ( imm == 13 ) THEN 965 imm = 1 ; iyy = iyy + 1 966 ENDIF 967 ELSE 968 ctmp1='obcread : this type of obc file is not supported :( ' 969 ctmp2=TRIM(cffile) 970 CALL ctl_stop (ctmp1, ctmp2) 971 ! cffile should be either annual or monthly ... 972 ENDIF 973 ! as the file is changed, need to update itobc etc ... 974 CALL obc_dta_chktime (iyy,imm) 975 ntobc_x = nrecbef() + 1 ! remember : this case occur for an after data 976 ENDIF 977 ENDIF 978 979 IF ( lp_obc_east ) THEN 980 ! ... Read datafile and set temperature, salinity and normal velocity 981 ! ... initialise the sedta, tedta, uedta arrays 982 WRITE(cl_obc_eTS ,'("obc_east_TS_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm 983 WRITE(cl_obc_eU ,'("obc_east_U_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm 984 WRITE(cl_obc_eV ,'("obc_east_V_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm 985 ! JMM this may change depending on the obc data format ... 986 istart(:)=(/nje0+njmpp-1,1/) ; icount(:)=(/nje1-nje0 +1,jpk/) 987 IF (lwp) WRITE(numout,*) 'read data in :', TRIM(cl_obc_eTS) 988 IF (nje1 >= nje0 ) THEN 989 CALL iom_open ( cl_obc_eTS , id_e ) 990 CALL iom_get ( id_e, jpdom_unknown, 'votemper', tedta(nje0:nje1,:,nt_x), & 991 & ktime=ntobc_x , kstart=istart, kcount= icount ) 992 CALL iom_get ( id_e, jpdom_unknown, 'vosaline', sedta(nje0:nje1,:,nt_x), & 993 & ktime=ntobc_x , kstart=istart, kcount= icount ) 994 CALL iom_close (id_e) 995 ! 996 CALL iom_open ( cl_obc_eU , id_e ) 997 CALL iom_get ( id_e, jpdom_unknown, 'vozocrtx', uedta(nje0:nje1,:,nt_x), & 998 & ktime=ntobc_x , kstart=istart, kcount= icount ) 999 CALL iom_close ( id_e ) 1000 ! 1001 CALL iom_open ( cl_obc_eV , id_e ) 1002 CALL iom_get ( id_e, jpdom_unknown, 'vomecrty', vedta(nje0:nje1,:,nt_x), & 1003 & ktime=ntobc_x , kstart=istart, kcount= icount ) 1004 CALL iom_close ( id_e ) 1005 1006 ! mask the boundary values 1007 tedta(:,:,nt_x) = tedta(:,:,nt_x)*temsk(:,:) ; sedta(:,:,nt_x) = sedta(:,:,nt_x)*temsk(:,:) 1008 uedta(:,:,nt_x) = uedta(:,:,nt_x)*uemsk(:,:) ; vedta(:,:,nt_x) = vedta(:,:,nt_x)*vemsk(:,:) 1009 1010 ! check any outliers 1011 zmin=MINVAL( sedta(:,:,nt_x), mask=ltemsk ) ; zmax=MAXVAL(sedta(:,:,nt_x), mask=ltemsk) 1012 IF ( zmin < 5 .OR. zmax > 50) THEN 1013 CALL ctl_stop('Error in sedta',' routine obcdta') 1014 ENDIF 1015 zmin=MINVAL( tedta(:,:,nt_x), mask=ltemsk ) ; zmax=MAXVAL(tedta(:,:,nt_x), mask=ltemsk) 1016 IF ( zmin < -10. .OR. zmax > 40) THEN 1017 CALL ctl_stop('Error in tedta',' routine obcdta') 1018 ENDIF 1019 zmin=MINVAL( uedta(:,:,nt_x), mask=luemsk ) ; zmax=MAXVAL(uedta(:,:,nt_x), mask=luemsk) 1020 IF ( zmin < -5. .OR. zmax > 5.) THEN 1021 CALL ctl_stop('Error in uedta',' routine obcdta') 1022 ENDIF 1023 zmin=MINVAL( vedta(:,:,nt_x), mask=lvemsk ) ; zmax=MAXVAL(vedta(:,:,nt_x), mask=lvemsk) 1024 IF ( zmin < -5. .OR. zmax > 5.) THEN 1025 CALL ctl_stop('Error in vedta',' routine obcdta') 1026 ENDIF 1027 1028 ! Usually printout is done only once at kt = nit000, unless nprint (namelist) > 1 1029 IF ( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN 1030 WRITE(numout,*) 1031 WRITE(numout,*) ' Read East OBC data records ', ntobc_x 1032 ikprint = jpj/20 +1 1033 WRITE(numout,*) ' Temperature record 1 - printout every 3 level' 1034 CALL prihre( tedta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout ) 1035 WRITE(numout,*) 1036 WRITE(numout,*) ' Salinity record 1 - printout every 3 level' 1037 CALL prihre( sedta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout ) 1038 WRITE(numout,*) 1039 WRITE(numout,*) ' Normal velocity U record 1 - printout every 3 level' 1040 CALL prihre( uedta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout ) 1041 WRITE(numout,*) 1042 WRITE(numout,*) ' Tangential velocity V record 1 - printout every 3 level' 1043 CALL prihre( vedta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout ) 1044 ENDIF 1045 ENDIF 1046 ENDIF 752 INTEGER :: ikprint 753 REAL(wp) :: zmin, zmax ! control of boundary values 754 755 !IOM stuff 756 INTEGER :: id_e, id_w, id_n, id_s 757 INTEGER, DIMENSION(2) :: istart, icount 758 759 !-------------------------------------------------------------------------- 760 IF ( ntobc_x > itobc ) THEN 761 IF (ln_obc_clim) THEN ! just loop on the same file 762 ntobc_x = 1 763 ELSE 764 ! need to change file : it is always for an 'after' data 765 IF ( cffile == 'annual' ) THEN ! go to next year file 766 iyy = iyy + 1 767 ELSE IF ( cffile =='monthly' ) THEN ! go to next month file 768 imm = imm + 1 769 IF ( imm == 13 ) THEN 770 imm = 1 ; iyy = iyy + 1 771 ENDIF 772 ELSE 773 ctmp1='obcread : this type of obc file is not supported :( ' 774 ctmp2=TRIM(cffile) 775 CALL ctl_stop (ctmp1, ctmp2) 776 ! cffile should be either annual or monthly ... 777 ENDIF 778 ! as the file is changed, need to update itobc etc ... 779 CALL obc_dta_chktime (iyy,imm) 780 ntobc_x = nrecbef() + 1 ! remember : this case occur for an after data 781 ENDIF 782 ENDIF 783 784 IF( lp_obc_east ) THEN 785 ! ... Read datafile and set temperature, salinity and normal velocity 786 ! ... initialise the sedta, tedta, uedta arrays 787 IF(ln_obc_clim) THEN ! revert to old convention for climatological OBC forcing 788 cl_obc_eTS='obceast_TS.nc' 789 cl_obc_eU ='obceast_U.nc' 790 cl_obc_eV ='obceast_V.nc' 791 ELSE ! convention for climatological OBC 792 WRITE(cl_obc_eTS ,'("obc_east_TS_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm 793 WRITE(cl_obc_eU ,'("obc_east_U_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm 794 WRITE(cl_obc_eV ,'("obc_east_V_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm 795 ENDIF 796 ! JMM this may change depending on the obc data format ... 797 istart(:)=(/nje0+njmpp-1,1/) ; icount(:)=(/nje1-nje0 +1,jpk/) 798 IF (lwp) WRITE(numout,*) 'read data in :', TRIM(cl_obc_eTS) 799 IF (nje1 >= nje0 ) THEN 800 CALL iom_open ( cl_obc_eTS , id_e ) 801 CALL iom_get ( id_e, jpdom_unknown, 'votemper', tedta(nje0:nje1,:,nt_x), & 802 & ktime=ntobc_x , kstart=istart, kcount= icount ) 803 CALL iom_get ( id_e, jpdom_unknown, 'vosaline', sedta(nje0:nje1,:,nt_x), & 804 & ktime=ntobc_x , kstart=istart, kcount= icount ) 805 # if defined key_dynspg_ts || defined key_dynspg_exp 806 CALL iom_get ( id_e, jpdom_unknown, 'vossurfh', sshedta(nje0:nje1,nt_x), & 807 & ktime=ntobc_x , kstart=istart, kcount= icount ) 808 # endif 809 CALL iom_close (id_e) 810 ! 811 CALL iom_open ( cl_obc_eU , id_e ) 812 CALL iom_get ( id_e, jpdom_unknown, 'vozocrtx', uedta(nje0:nje1,:,nt_x), & 813 & ktime=ntobc_x , kstart=istart, kcount= icount ) 814 CALL iom_close ( id_e ) 815 ! 816 CALL iom_open ( cl_obc_eV , id_e ) 817 CALL iom_get ( id_e, jpdom_unknown, 'vomecrty', vedta(nje0:nje1,:,nt_x), & 818 & ktime=ntobc_x , kstart=istart, kcount= icount ) 819 CALL iom_close ( id_e ) 820 821 ! mask the boundary values 822 tedta(:,:,nt_x) = tedta(:,:,nt_x)*temsk(:,:) ; sedta(:,:,nt_x) = sedta(:,:,nt_x)*temsk(:,:) 823 uedta(:,:,nt_x) = uedta(:,:,nt_x)*uemsk(:,:) ; vedta(:,:,nt_x) = vedta(:,:,nt_x)*vemsk(:,:) 824 825 ! check any outliers 826 zmin=MINVAL( sedta(:,:,nt_x), mask=ltemsk ) ; zmax=MAXVAL(sedta(:,:,nt_x), mask=ltemsk) 827 IF ( zmin < 5 .OR. zmax > 50) THEN 828 CALL ctl_stop('Error in sedta',' routine obcdta') 829 ENDIF 830 zmin=MINVAL( tedta(:,:,nt_x), mask=ltemsk ) ; zmax=MAXVAL(tedta(:,:,nt_x), mask=ltemsk) 831 IF ( zmin < -10. .OR. zmax > 40) THEN 832 CALL ctl_stop('Error in tedta',' routine obcdta') 833 ENDIF 834 zmin=MINVAL( uedta(:,:,nt_x), mask=luemsk ) ; zmax=MAXVAL(uedta(:,:,nt_x), mask=luemsk) 835 IF ( zmin < -5. .OR. zmax > 5.) THEN 836 CALL ctl_stop('Error in uedta',' routine obcdta') 837 ENDIF 838 zmin=MINVAL( vedta(:,:,nt_x), mask=lvemsk ) ; zmax=MAXVAL(vedta(:,:,nt_x), mask=lvemsk) 839 IF ( zmin < -5. .OR. zmax > 5.) THEN 840 CALL ctl_stop('Error in vedta',' routine obcdta') 841 ENDIF 842 843 ! Usually printout is done only once at kt = nit000, unless nprint (namelist) > 1 844 IF ( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN 845 WRITE(numout,*) 846 WRITE(numout,*) ' Read East OBC data records ', ntobc_x 847 ikprint = jpj/20 +1 848 WRITE(numout,*) ' Temperature record 1 - printout every 3 level' 849 CALL prihre( tedta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout ) 850 WRITE(numout,*) 851 WRITE(numout,*) ' Salinity record 1 - printout every 3 level' 852 CALL prihre( sedta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout ) 853 WRITE(numout,*) 854 WRITE(numout,*) ' Normal velocity U record 1 - printout every 3 level' 855 CALL prihre( uedta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout ) 856 WRITE(numout,*) 857 WRITE(numout,*) ' Tangential velocity V record 1 - printout every 3 level' 858 CALL prihre( vedta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout ) 859 ENDIF 860 ENDIF 861 ENDIF 1047 862 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1048 IF ( lp_obc_west ) THEN 1049 ! ... Read datafile and set temperature, salinity and normal velocity 1050 ! ... initialise the swdta, twdta, uwdta arrays 1051 WRITE(cl_obc_wTS ,'("obc_west_TS_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm 1052 WRITE(cl_obc_wU ,'("obc_west_U_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm 1053 WRITE(cl_obc_wV ,'("obc_west_V_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm 1054 istart(:)=(/njw0+njmpp-1,1/) ; icount(:)=(/njw1-njw0 +1,jpk/) 1055 IF (lwp) WRITE(numout,*) 'read data in :', TRIM(cl_obc_wTS) 1056 1057 IF ( njw1 >= njw0 ) THEN 1058 CALL iom_open ( cl_obc_wTS , id_w ) 1059 CALL iom_get ( id_w, jpdom_unknown, 'votemper', twdta(njw0:njw1,:,nt_x), & 1060 & ktime=ntobc_x , kstart=istart, kcount= icount ) 1061 1062 CALL iom_get ( id_w, jpdom_unknown, 'vosaline', swdta(njw0:njw1,:,nt_x), & 863 IF ( lp_obc_west ) THEN 864 ! ... Read datafile and set temperature, salinity and normal velocity 865 ! ... initialise the swdta, twdta, uwdta arrays 866 IF (ln_obc_clim) THEN ! revert to old convention for climatological OBC forcing 867 cl_obc_wTS='obcwest_TS.nc' 868 cl_obc_wU ='obcwest_U.nc' 869 cl_obc_wV ='obcwest_V.nc' 870 ELSE ! convention for climatological OBC 871 WRITE(cl_obc_wTS ,'("obc_west_TS_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm 872 WRITE(cl_obc_wU ,'("obc_west_U_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm 873 WRITE(cl_obc_wV ,'("obc_west_V_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm 874 ENDIF 875 istart(:)=(/njw0+njmpp-1,1/) ; icount(:)=(/njw1-njw0 +1,jpk/) 876 IF (lwp) WRITE(numout,*) 'read data in :', TRIM(cl_obc_wTS) 877 878 IF ( njw1 >= njw0 ) THEN 879 CALL iom_open ( cl_obc_wTS , id_w ) 880 CALL iom_get ( id_w, jpdom_unknown, 'votemper', twdta(njw0:njw1,:,nt_x), & 881 & ktime=ntobc_x , kstart=istart, kcount= icount ) 882 883 CALL iom_get ( id_w, jpdom_unknown, 'vosaline', swdta(njw0:njw1,:,nt_x), & 1063 884 & ktime=ntobc_x , kstart=istart, kcount= icount) 1064 CALL iom_close (id_w) 1065 ! 1066 CALL iom_open ( cl_obc_wU , id_w ) 1067 CALL iom_get ( id_w, jpdom_unknown, 'vozocrtx', uwdta(njw0:njw1,:,nt_x),& 1068 & ktime=ntobc_x , kstart=istart, kcount= icount ) 1069 CALL iom_close ( id_w ) 1070 ! 1071 CALL iom_open ( cl_obc_wV , id_w ) 1072 CALL iom_get ( id_w, jpdom_unknown, 'vomecrty', vwdta(njw0:njw1,:,nt_x), & 1073 & ktime=ntobc_x , kstart=istart, kcount= icount ) 1074 CALL iom_close ( id_w ) 1075 1076 ! mask the boundary values 1077 twdta(:,:,nt_x) = twdta(:,:,nt_x)*twmsk(:,:) ; swdta(:,:,nt_x) = swdta(:,:,nt_x)*twmsk(:,:) 1078 uwdta(:,:,nt_x) = uwdta(:,:,nt_x)*uwmsk(:,:) ; vwdta(:,:,nt_x) = vwdta(:,:,nt_x)*vwmsk(:,:) 1079 1080 ! check any outliers 1081 zmin=MINVAL( swdta(:,:,nt_x), mask=ltwmsk ) ; zmax=MAXVAL(swdta(:,:,nt_x), mask=ltwmsk) 1082 IF ( zmin < 5 .OR. zmax > 50) THEN 1083 CALL ctl_stop('Error in swdta',' routine obcdta') 1084 ENDIF 1085 zmin=MINVAL( twdta(:,:,nt_x), mask=ltwmsk ) ; zmax=MAXVAL(twdta(:,:,nt_x), mask=ltwmsk) 1086 IF ( zmin < -10. .OR. zmax > 40) THEN 1087 CALL ctl_stop('Error in twdta',' routine obcdta') 1088 ENDIF 1089 zmin=MINVAL( uwdta(:,:,nt_x), mask=luwmsk ) ; zmax=MAXVAL(uwdta(:,:,nt_x), mask=luwmsk) 1090 IF ( zmin < -5. .OR. zmax > 5.) THEN 1091 CALL ctl_stop('Error in uwdta',' routine obcdta') 1092 ENDIF 1093 zmin=MINVAL( vwdta(:,:,nt_x), mask=lvwmsk ) ; zmax=MAXVAL(vwdta(:,:,nt_x), mask=lvwmsk) 1094 IF ( zmin < -5. .OR. zmax > 5.) THEN 1095 CALL ctl_stop('Error in vwdta',' routine obcdta') 1096 ENDIF 1097 1098 1099 IF ( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN 1100 WRITE(numout,*) 1101 WRITE(numout,*) ' Read West OBC data records ', ntobc_x 1102 ikprint = jpj/20 +1 1103 WRITE(numout,*) ' Temperature record 1 - printout every 3 level' 1104 CALL prihre( twdta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout ) 1105 WRITE(numout,*) 1106 WRITE(numout,*) ' Salinity record 1 - printout every 3 level' 1107 CALL prihre( swdta(:,:,nt_x),jpj,jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout ) 1108 WRITE(numout,*) 1109 WRITE(numout,*) ' Normal velocity U record 1 - printout every 3 level' 1110 CALL prihre( uwdta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout ) 1111 WRITE(numout,*) 1112 WRITE(numout,*) ' Tangential velocity V record 1 - printout every 3 level' 1113 CALL prihre( vwdta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout ) 1114 ENDIF 1115 END IF 1116 ENDIF 885 # if defined key_dynspg_ts || defined key_dynspg_exp 886 CALL iom_get ( id_w, jpdom_unknown, 'vossurfh', sshwdta(njw0:njw1,nt_x), & 887 & ktime=ntobc_x , kstart=istart, kcount= icount ) 888 # endif 889 CALL iom_close (id_w) 890 ! 891 CALL iom_open ( cl_obc_wU , id_w ) 892 CALL iom_get ( id_w, jpdom_unknown, 'vozocrtx', uwdta(njw0:njw1,:,nt_x),& 893 & ktime=ntobc_x , kstart=istart, kcount= icount ) 894 CALL iom_close ( id_w ) 895 ! 896 CALL iom_open ( cl_obc_wV , id_w ) 897 CALL iom_get ( id_w, jpdom_unknown, 'vomecrty', vwdta(njw0:njw1,:,nt_x), & 898 & ktime=ntobc_x , kstart=istart, kcount= icount ) 899 CALL iom_close ( id_w ) 900 901 ! mask the boundary values 902 twdta(:,:,nt_x) = twdta(:,:,nt_x)*twmsk(:,:) ; swdta(:,:,nt_x) = swdta(:,:,nt_x)*twmsk(:,:) 903 uwdta(:,:,nt_x) = uwdta(:,:,nt_x)*uwmsk(:,:) ; vwdta(:,:,nt_x) = vwdta(:,:,nt_x)*vwmsk(:,:) 904 905 ! check any outliers 906 zmin=MINVAL( swdta(:,:,nt_x), mask=ltwmsk ) ; zmax=MAXVAL(swdta(:,:,nt_x), mask=ltwmsk) 907 IF ( zmin < 5 .OR. zmax > 50) THEN 908 CALL ctl_stop('Error in swdta',' routine obcdta') 909 ENDIF 910 zmin=MINVAL( twdta(:,:,nt_x), mask=ltwmsk ) ; zmax=MAXVAL(twdta(:,:,nt_x), mask=ltwmsk) 911 IF ( zmin < -10. .OR. zmax > 40) THEN 912 CALL ctl_stop('Error in twdta',' routine obcdta') 913 ENDIF 914 zmin=MINVAL( uwdta(:,:,nt_x), mask=luwmsk ) ; zmax=MAXVAL(uwdta(:,:,nt_x), mask=luwmsk) 915 IF ( zmin < -5. .OR. zmax > 5.) THEN 916 CALL ctl_stop('Error in uwdta',' routine obcdta') 917 ENDIF 918 zmin=MINVAL( vwdta(:,:,nt_x), mask=lvwmsk ) ; zmax=MAXVAL(vwdta(:,:,nt_x), mask=lvwmsk) 919 IF ( zmin < -5. .OR. zmax > 5.) THEN 920 CALL ctl_stop('Error in vwdta',' routine obcdta') 921 ENDIF 922 923 924 IF ( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN 925 WRITE(numout,*) 926 WRITE(numout,*) ' Read West OBC data records ', ntobc_x 927 ikprint = jpj/20 +1 928 WRITE(numout,*) ' Temperature record 1 - printout every 3 level' 929 CALL prihre( twdta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout ) 930 WRITE(numout,*) 931 WRITE(numout,*) ' Salinity record 1 - printout every 3 level' 932 CALL prihre( swdta(:,:,nt_x),jpj,jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout ) 933 WRITE(numout,*) 934 WRITE(numout,*) ' Normal velocity U record 1 - printout every 3 level' 935 CALL prihre( uwdta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout ) 936 WRITE(numout,*) 937 WRITE(numout,*) ' Tangential velocity V record 1 - printout every 3 level' 938 CALL prihre( vwdta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout ) 939 ENDIF 940 END IF 941 ENDIF 1117 942 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1118 IF( lp_obc_north) THEN 1119 WRITE(cl_obc_nTS ,'("obc_north_TS_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm 1120 WRITE(cl_obc_nV ,'("obc_north_V_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm 1121 WRITE(cl_obc_nU ,'("obc_north_U_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm 1122 istart(:)=(/nin0+nimpp-1,1/) ; icount(:)=(/nin1-nin0 +1,jpk/) 1123 IF (lwp) WRITE(numout,*) 'read data in :', TRIM(cl_obc_nTS) 1124 IF ( nin1 >= nin0 ) THEN 1125 CALL iom_open ( cl_obc_nTS , id_n ) 1126 CALL iom_get ( id_n, jpdom_unknown, 'votemper', tndta(nin0:nin1,:,nt_x), & 1127 & ktime=ntobc_x , kstart=istart, kcount= icount ) 1128 CALL iom_get ( id_n, jpdom_unknown, 'vosaline', sndta(nin0:nin1,:,nt_x), & 1129 & ktime=ntobc_x , kstart=istart, kcount= icount ) 1130 CALL iom_close (id_n) 1131 ! 1132 CALL iom_open ( cl_obc_nU , id_n ) 1133 CALL iom_get ( id_n, jpdom_unknown, 'vozocrtx', undta(nin0:nin1,:,nt_x), & 1134 & ktime=ntobc_x , kstart=istart, kcount= icount ) 1135 CALL iom_close ( id_n ) 1136 ! 1137 CALL iom_open ( cl_obc_nV , id_n ) 1138 CALL iom_get ( id_n, jpdom_unknown, 'vomecrty', vndta(nin0:nin1,:,nt_x), & 1139 & ktime=ntobc_x , kstart=istart, kcount= icount ) 1140 CALL iom_close ( id_n ) 1141 1142 ! mask the boundary values 1143 tndta(:,:,nt_x) = tndta(:,:,nt_x)*tnmsk(:,:) ; sndta(:,:,nt_x) = sndta(:,:,nt_x)*tnmsk(:,:) 1144 undta(:,:,nt_x) = undta(:,:,nt_x)*unmsk(:,:) ; vndta(:,:,nt_x) = vndta(:,:,nt_x)*vnmsk(:,:) 1145 1146 ! check any outliers 1147 zmin=MINVAL( sndta(:,:,nt_x), mask=ltnmsk ) ; zmax=MAXVAL(sndta(:,:,nt_x), mask=ltnmsk) 1148 IF ( zmin < 5 .OR. zmax > 50) THEN 1149 CALL ctl_stop('Error in sndta',' routine obcdta') 1150 ENDIF 1151 zmin=MINVAL( tndta(:,:,nt_x), mask=ltnmsk ) ; zmax=MAXVAL(tndta(:,:,nt_x), mask=ltnmsk) 1152 IF ( zmin < -10. .OR. zmax > 40) THEN 1153 CALL ctl_stop('Error in tndta',' routine obcdta') 1154 ENDIF 1155 zmin=MINVAL( undta(:,:,nt_x), mask=lunmsk ) ; zmax=MAXVAL(undta(:,:,nt_x), mask=lunmsk) 1156 IF ( zmin < -5. .OR. zmax > 5.) THEN 1157 CALL ctl_stop('Error in undta',' routine obcdta') 1158 ENDIF 1159 zmin=MINVAL( vndta(:,:,nt_x), mask=lvnmsk ) ; zmax=MAXVAL(vndta(:,:,nt_x), mask=lvnmsk) 1160 IF ( zmin < -5. .OR. zmax > 5.) THEN 1161 CALL ctl_stop('Error in vndta',' routine obcdta') 1162 ENDIF 1163 1164 IF ( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN 1165 WRITE(numout,*) 1166 WRITE(numout,*) ' Read North OBC data records ', ntobc_x 1167 ikprint = jpi/20 +1 1168 WRITE(numout,*) ' Temperature record 1 - printout every 3 level' 1169 CALL prihre( tndta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout ) 1170 WRITE(numout,*) 1171 WRITE(numout,*) ' Salinity record 1 - printout every 3 level' 1172 CALL prihre( sndta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout ) 1173 WRITE(numout,*) 1174 WRITE(numout,*) ' Normal velocity V record 1 - printout every 3 level' 1175 CALL prihre( vndta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout ) 1176 WRITE(numout,*) 1177 WRITE(numout,*) ' Tangential velocity U record 1 - printout every 3 level' 1178 CALL prihre( undta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout ) 1179 ENDIF 1180 ENDIF 1181 ENDIF 943 IF( lp_obc_north) THEN 944 IF(ln_obc_clim) THEN ! revert to old convention for climatological OBC forcing 945 cl_obc_nTS='obcnorth_TS.nc' 946 cl_obc_nU ='obcnorth_U.nc' 947 cl_obc_nV ='obcnorth_V.nc' 948 ELSE ! convention for climatological OBC 949 WRITE(cl_obc_nTS ,'("obc_north_TS_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm 950 WRITE(cl_obc_nV ,'("obc_north_V_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm 951 WRITE(cl_obc_nU ,'("obc_north_U_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm 952 ENDIF 953 istart(:)=(/nin0+nimpp-1,1/) ; icount(:)=(/nin1-nin0 +1,jpk/) 954 IF (lwp) WRITE(numout,*) 'read data in :', TRIM(cl_obc_nTS) 955 IF ( nin1 >= nin0 ) THEN 956 CALL iom_open ( cl_obc_nTS , id_n ) 957 CALL iom_get ( id_n, jpdom_unknown, 'votemper', tndta(nin0:nin1,:,nt_x), & 958 & ktime=ntobc_x , kstart=istart, kcount= icount ) 959 CALL iom_get ( id_n, jpdom_unknown, 'vosaline', sndta(nin0:nin1,:,nt_x), & 960 & ktime=ntobc_x , kstart=istart, kcount= icount ) 961 # if defined key_dynspg_ts || defined key_dynspg_exp 962 CALL iom_get ( id_n, jpdom_unknown, 'vossurfh', sshndta(nin0:nin1,nt_x), & 963 & ktime=ntobc_x , kstart=istart, kcount= icount ) 964 # endif 965 CALL iom_close (id_n) 966 ! 967 CALL iom_open ( cl_obc_nU , id_n ) 968 CALL iom_get ( id_n, jpdom_unknown, 'vozocrtx', undta(nin0:nin1,:,nt_x), & 969 & ktime=ntobc_x , kstart=istart, kcount= icount ) 970 CALL iom_close ( id_n ) 971 ! 972 CALL iom_open ( cl_obc_nV , id_n ) 973 CALL iom_get ( id_n, jpdom_unknown, 'vomecrty', vndta(nin0:nin1,:,nt_x), & 974 & ktime=ntobc_x , kstart=istart, kcount= icount ) 975 CALL iom_close ( id_n ) 976 977 ! mask the boundary values 978 tndta(:,:,nt_x) = tndta(:,:,nt_x)*tnmsk(:,:) ; sndta(:,:,nt_x) = sndta(:,:,nt_x)*tnmsk(:,:) 979 undta(:,:,nt_x) = undta(:,:,nt_x)*unmsk(:,:) ; vndta(:,:,nt_x) = vndta(:,:,nt_x)*vnmsk(:,:) 980 981 ! check any outliers 982 zmin=MINVAL( sndta(:,:,nt_x), mask=ltnmsk ) ; zmax=MAXVAL(sndta(:,:,nt_x), mask=ltnmsk) 983 IF ( zmin < 5 .OR. zmax > 50) THEN 984 CALL ctl_stop('Error in sndta',' routine obcdta') 985 ENDIF 986 zmin=MINVAL( tndta(:,:,nt_x), mask=ltnmsk ) ; zmax=MAXVAL(tndta(:,:,nt_x), mask=ltnmsk) 987 IF ( zmin < -10. .OR. zmax > 40) THEN 988 CALL ctl_stop('Error in tndta',' routine obcdta') 989 ENDIF 990 zmin=MINVAL( undta(:,:,nt_x), mask=lunmsk ) ; zmax=MAXVAL(undta(:,:,nt_x), mask=lunmsk) 991 IF ( zmin < -5. .OR. zmax > 5.) THEN 992 CALL ctl_stop('Error in undta',' routine obcdta') 993 ENDIF 994 zmin=MINVAL( vndta(:,:,nt_x), mask=lvnmsk ) ; zmax=MAXVAL(vndta(:,:,nt_x), mask=lvnmsk) 995 IF ( zmin < -5. .OR. zmax > 5.) THEN 996 CALL ctl_stop('Error in vndta',' routine obcdta') 997 ENDIF 998 999 IF ( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN 1000 WRITE(numout,*) 1001 WRITE(numout,*) ' Read North OBC data records ', ntobc_x 1002 ikprint = jpi/20 +1 1003 WRITE(numout,*) ' Temperature record 1 - printout every 3 level' 1004 CALL prihre( tndta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout ) 1005 WRITE(numout,*) 1006 WRITE(numout,*) ' Salinity record 1 - printout every 3 level' 1007 CALL prihre( sndta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout ) 1008 WRITE(numout,*) 1009 WRITE(numout,*) ' Normal velocity V record 1 - printout every 3 level' 1010 CALL prihre( vndta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout ) 1011 WRITE(numout,*) 1012 WRITE(numout,*) ' Tangential velocity U record 1 - printout every 3 level' 1013 CALL prihre( undta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout ) 1014 ENDIF 1015 ENDIF 1016 ENDIF 1182 1017 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1183 IF( lp_obc_south) THEN 1184 WRITE(cl_obc_sTS ,'("obc_south_TS_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm 1185 WRITE(cl_obc_sV ,'("obc_south_V_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm 1186 WRITE(cl_obc_sU ,'("obc_south_U_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm 1187 istart(:)=(/nis0+nimpp-1,1/) ; icount(:)=(/nis1-nis0 +1,jpk/) 1188 IF (lwp) WRITE(numout,*) 'read data in :', TRIM(cl_obc_sTS) 1189 IF ( nis1 >= nis0 ) THEN 1190 CALL iom_open ( cl_obc_sTS , id_s ) 1191 CALL iom_get ( id_s, jpdom_unknown, 'votemper', tsdta(nis0:nis1,:,nt_x), & 1192 & ktime=ntobc_x , kstart=istart, kcount= icount ) 1193 CALL iom_get ( id_s, jpdom_unknown, 'vosaline', ssdta(nis0:nis1,:,nt_x), & 1194 & ktime=ntobc_x , kstart=istart, kcount= icount ) 1195 CALL iom_close (id_s) 1196 ! 1197 CALL iom_open ( cl_obc_sU , id_s ) 1198 CALL iom_get ( id_s, jpdom_unknown, 'vozocrtx', usdta(nis0:nis1,:,nt_x), & 1199 & ktime=ntobc_x , kstart=istart, kcount= icount ) 1200 CALL iom_close ( id_s ) 1201 ! 1202 CALL iom_open ( cl_obc_sV , id_s ) 1203 CALL iom_get ( id_s, jpdom_unknown, 'vomecrty', vsdta(nis0:nis1,:,nt_x), & 1204 & ktime=ntobc_x , kstart=istart, kcount= icount ) 1205 CALL iom_close ( id_s ) 1206 1207 ! mask the boundary values 1208 tsdta(:,:,nt_x) = tsdta(:,:,nt_x)*tsmsk(:,:) ; ssdta(:,:,nt_x) = ssdta(:,:,nt_x)*tsmsk(:,:) 1209 usdta(:,:,nt_x) = usdta(:,:,nt_x)*usmsk(:,:) ; vsdta(:,:,nt_x) = vsdta(:,:,nt_x)*vsmsk(:,:) 1210 1211 ! check any outliers 1212 zmin=MINVAL( ssdta(:,:,nt_x), mask=ltsmsk ) ; zmax=MAXVAL(ssdta(:,:,nt_x), mask=ltsmsk) 1213 IF ( zmin < 5 .OR. zmax > 50) THEN 1214 CALL ctl_stop('Error in ssdta',' routine obcdta') 1215 ENDIF 1216 zmin=MINVAL( tsdta(:,:,nt_x), mask=ltsmsk ) ; zmax=MAXVAL(tsdta(:,:,nt_x), mask=ltsmsk) 1217 IF ( zmin < -10. .OR. zmax > 40) THEN 1218 CALL ctl_stop('Error in tsdta',' routine obcdta') 1219 ENDIF 1220 zmin=MINVAL( usdta(:,:,nt_x), mask=lusmsk ) ; zmax=MAXVAL(usdta(:,:,nt_x), mask=lusmsk) 1221 IF ( zmin < -5. .OR. zmax > 5.) THEN 1222 CALL ctl_stop('Error in usdta',' routine obcdta') 1223 ENDIF 1224 zmin=MINVAL( vsdta(:,:,nt_x), mask=lvsmsk ) ; zmax=MAXVAL(vsdta(:,:,nt_x), mask=lvsmsk) 1225 IF ( zmin < -5. .OR. zmax > 5.) THEN 1226 CALL ctl_stop('Error in vsdta',' routine obcdta') 1227 ENDIF 1228 1229 IF ( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN 1230 WRITE(numout,*) 1231 WRITE(numout,*) ' Read South OBC data records ', ntobc_x 1232 ikprint = jpi/20 +1 1233 WRITE(numout,*) ' Temperature record 1 - printout every 3 level' 1234 CALL prihre( tsdta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout ) 1235 WRITE(numout,*) 1236 WRITE(numout,*) ' Salinity record 1 - printout every 3 level' 1237 CALL prihre( ssdta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout ) 1238 WRITE(numout,*) 1239 WRITE(numout,*) ' Normal velocity V record 1 - printout every 3 level' 1240 CALL prihre( vsdta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout ) 1241 WRITE(numout,*) 1242 WRITE(numout,*) ' Tangential velocity U record 1 - printout every 3 level' 1243 CALL prihre( usdta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout ) 1244 ENDIF 1245 ENDIF 1246 ENDIF 1018 IF( lp_obc_south) THEN 1019 IF(ln_obc_clim) THEN ! revert to old convention for climatological OBC forcing 1020 cl_obc_sTS='obcsouth_TS.nc' 1021 cl_obc_sU ='obcsouth_U.nc' 1022 cl_obc_sV ='obcsouth_V.nc' 1023 ELSE ! convention for climatological OBC 1024 WRITE(cl_obc_sTS ,'("obc_south_TS_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm 1025 WRITE(cl_obc_sV ,'("obc_south_V_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm 1026 WRITE(cl_obc_sU ,'("obc_south_U_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm 1027 ENDIF 1028 istart(:)=(/nis0+nimpp-1,1/) ; icount(:)=(/nis1-nis0 +1,jpk/) 1029 IF (lwp) WRITE(numout,*) 'read data in :', TRIM(cl_obc_sTS) 1030 IF ( nis1 >= nis0 ) THEN 1031 CALL iom_open ( cl_obc_sTS , id_s ) 1032 CALL iom_get ( id_s, jpdom_unknown, 'votemper', tsdta(nis0:nis1,:,nt_x), & 1033 & ktime=ntobc_x , kstart=istart, kcount= icount ) 1034 CALL iom_get ( id_s, jpdom_unknown, 'vosaline', ssdta(nis0:nis1,:,nt_x), & 1035 & ktime=ntobc_x , kstart=istart, kcount= icount ) 1036 # if defined key_dynspg_ts || defined key_dynspg_exp 1037 CALL iom_get ( id_s, jpdom_unknown, 'vossurfh', sshsdta(nis0:nis1,nt_x), & 1038 & ktime=ntobc_x , kstart=istart, kcount= icount ) 1039 # endif 1040 CALL iom_close (id_s) 1041 ! 1042 CALL iom_open ( cl_obc_sU , id_s ) 1043 CALL iom_get ( id_s, jpdom_unknown, 'vozocrtx', usdta(nis0:nis1,:,nt_x), & 1044 & ktime=ntobc_x , kstart=istart, kcount= icount ) 1045 CALL iom_close ( id_s ) 1046 ! 1047 CALL iom_open ( cl_obc_sV , id_s ) 1048 CALL iom_get ( id_s, jpdom_unknown, 'vomecrty', vsdta(nis0:nis1,:,nt_x), & 1049 & ktime=ntobc_x , kstart=istart, kcount= icount ) 1050 CALL iom_close ( id_s ) 1051 1052 ! mask the boundary values 1053 tsdta(:,:,nt_x) = tsdta(:,:,nt_x)*tsmsk(:,:) ; ssdta(:,:,nt_x) = ssdta(:,:,nt_x)*tsmsk(:,:) 1054 usdta(:,:,nt_x) = usdta(:,:,nt_x)*usmsk(:,:) ; vsdta(:,:,nt_x) = vsdta(:,:,nt_x)*vsmsk(:,:) 1055 1056 ! check any outliers 1057 zmin=MINVAL( ssdta(:,:,nt_x), mask=ltsmsk ) ; zmax=MAXVAL(ssdta(:,:,nt_x), mask=ltsmsk) 1058 IF ( zmin < 5 .OR. zmax > 50) THEN 1059 CALL ctl_stop('Error in ssdta',' routine obcdta') 1060 ENDIF 1061 zmin=MINVAL( tsdta(:,:,nt_x), mask=ltsmsk ) ; zmax=MAXVAL(tsdta(:,:,nt_x), mask=ltsmsk) 1062 IF ( zmin < -10. .OR. zmax > 40) THEN 1063 CALL ctl_stop('Error in tsdta',' routine obcdta') 1064 ENDIF 1065 zmin=MINVAL( usdta(:,:,nt_x), mask=lusmsk ) ; zmax=MAXVAL(usdta(:,:,nt_x), mask=lusmsk) 1066 IF ( zmin < -5. .OR. zmax > 5.) THEN 1067 CALL ctl_stop('Error in usdta',' routine obcdta') 1068 ENDIF 1069 zmin=MINVAL( vsdta(:,:,nt_x), mask=lvsmsk ) ; zmax=MAXVAL(vsdta(:,:,nt_x), mask=lvsmsk) 1070 IF ( zmin < -5. .OR. zmax > 5.) THEN 1071 CALL ctl_stop('Error in vsdta',' routine obcdta') 1072 ENDIF 1073 1074 IF ( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN 1075 WRITE(numout,*) 1076 WRITE(numout,*) ' Read South OBC data records ', ntobc_x 1077 ikprint = jpi/20 +1 1078 WRITE(numout,*) ' Temperature record 1 - printout every 3 level' 1079 CALL prihre( tsdta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout ) 1080 WRITE(numout,*) 1081 WRITE(numout,*) ' Salinity record 1 - printout every 3 level' 1082 CALL prihre( ssdta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout ) 1083 WRITE(numout,*) 1084 WRITE(numout,*) ' Normal velocity V record 1 - printout every 3 level' 1085 CALL prihre( vsdta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout ) 1086 WRITE(numout,*) 1087 WRITE(numout,*) ' Tangential velocity U record 1 - printout every 3 level' 1088 CALL prihre( usdta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout ) 1089 ENDIF 1090 ENDIF 1091 ENDIF 1092 1093 # if defined key_dynspg_ts || defined key_dynspg_exp 1094 CALL obc_depth_average(nt_x) ! computation of depth-averaged velocity 1095 # endif 1096 1247 1097 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1248 END SUBROUTINE obc_read1249 1250 INTEGER FUNCTION nrecbef()1098 END SUBROUTINE obc_read 1099 1100 INTEGER FUNCTION nrecbef() 1251 1101 !!----------------------------------------------------------------------- 1252 1102 !! *** FUNCTION nrecbef *** … … 1259 1109 INTEGER :: it , idum 1260 1110 1261 idum = itobc 1262 DO it =1, itobc 1263 IF ( ztcobc(it) > zjcnes ) THEN ; idum = it - 1 ; EXIT ; ENDIF 1264 ENDDO 1265 ! idum can be 0 (climato, before first record) 1266 IF ( idum == 0 ) THEN 1267 IF ( ln_obc_clim ) THEN 1268 idum = itobc 1269 ELSE 1270 ctmp1='obc_dta: find ntobc == 0 for non climatological file ' 1271 ctmp2='consider adding a first record in your data file ' 1272 CALL ctl_stop(ctmp1, ctmp2) 1273 ENDIF 1274 ENDIF 1275 ! idum can be itobc ( zjcnes > ztcobc (itobc) ) 1276 ! This is not a problem ... 1277 nrecbef = idum 1278 1279 END FUNCTION nrecbef 1111 idum = itobc 1112 DO it =1, itobc 1113 IF ( ztcobc(it) > zjcnes ) THEN ; idum = it - 1 ; EXIT ; ENDIF 1114 ENDDO 1115 ! idum can be 0 (climato, before first record) 1116 IF ( idum == 0 ) THEN 1117 IF ( ln_obc_clim ) THEN 1118 idum = itobc 1119 ELSE 1120 ctmp1='obc_dta: find ntobc == 0 for non climatological file ' 1121 ctmp2='consider adding a first record in your data file ' 1122 CALL ctl_stop(ctmp1, ctmp2) 1123 ENDIF 1124 ENDIF 1125 ! idum can be itobc ( zjcnes > ztcobc (itobc) ) 1126 ! This is not a problem ... 1127 nrecbef = idum 1128 1129 END FUNCTION nrecbef 1130 1131 !!============================================================================== 1132 SUBROUTINE obc_depth_average(nt_x) 1133 !!----------------------------------------------------------------------- 1134 !! *** ROUTINE obc_depth_average *** 1135 !! 1136 !! Purpose : - compute the depth-averaged velocity from depth-dependent OBC frames 1137 !! 1138 !! History : 2009-01 : ( Fred Dupont ) Original code 1139 !!----------------------------------------------------------------------- 1140 1141 ! * Arguments 1142 INTEGER, INTENT( in ) :: nt_x 1143 1144 ! * Local variables 1145 INTEGER :: ji, jj, jk 1146 1147 1148 IF( lp_obc_east ) THEN 1149 ! initialisation to zero 1150 ubtedta(:,nt_x) = 0.e0 1151 vbtedta(:,nt_x) = 0.e0 1152 DO ji = nie0, nie1 1153 DO jj = 1, jpj 1154 DO jk = 1, jpkm1 1155 ubtedta(jj,nt_x) = ubtedta(jj,nt_x) + uedta(jj,jk,nt_x)*fse3u(ji,jj,jk) 1156 vbtedta(jj,nt_x) = vbtedta(jj,nt_x) + vedta(jj,jk,nt_x)*fse3v(ji+1,jj,jk) 1157 END DO 1158 END DO 1159 END DO 1160 ENDIF 1161 1162 IF( lp_obc_west) THEN 1163 ! initialisation to zero 1164 ubtwdta(:,nt_x) = 0.e0 1165 vbtwdta(:,nt_x) = 0.e0 1166 DO ji = niw0, niw1 1167 DO jj = 1, jpj 1168 DO jk = 1, jpkm1 1169 ubtwdta(jj,nt_x) = ubtwdta(jj,nt_x) + uwdta(jj,jk,1)*fse3u(ji,jj,jk) 1170 vbtwdta(jj,nt_x) = vbtwdta(jj,nt_x) + vwdta(jj,jk,1)*fse3v(ji,jj,jk) 1171 END DO 1172 END DO 1173 END DO 1174 ENDIF 1175 1176 IF( lp_obc_north) THEN 1177 ! initialisation to zero 1178 ubtndta(:,nt_x) = 0.e0 1179 vbtndta(:,nt_x) = 0.e0 1180 DO jj = njn0, njn1 1181 DO ji = 1, jpi 1182 DO jk = 1, jpkm1 1183 ubtndta(ji,nt_x) = ubtndta(ji,nt_x) + undta(ji,jk,nt_x)*fse3u(ji,jj+1,jk) 1184 vbtndta(ji,nt_x) = vbtndta(ji,nt_x) + vndta(ji,jk,nt_x)*fse3v(ji,jj,jk) 1185 END DO 1186 END DO 1187 END DO 1188 ENDIF 1189 1190 IF( lp_obc_south) THEN 1191 ! initialisation to zero 1192 ubtsdta(:,nt_x) = 0.e0 1193 vbtsdta(:,nt_x) = 0.e0 1194 DO jj = njs0, njs1 1195 DO ji = nis0, nis1 1196 DO jk = 1, jpkm1 1197 ubtsdta(ji,nt_x) = ubtsdta(ji,nt_x) + usdta(ji,jk,nt_x)*fse3u(ji,jj,jk) 1198 vbtsdta(ji,nt_x) = vbtsdta(ji,nt_x) + vsdta(ji,jk,nt_x)*fse3v(ji,jj,jk) 1199 END DO 1200 END DO 1201 END DO 1202 ENDIF 1203 1204 END SUBROUTINE obc_depth_average 1280 1205 1281 1206 #else 1282 !!------------------------------------------------------------------------------1283 !! default option: Dummy module NO Open Boundary Conditions1284 !!------------------------------------------------------------------------------1285 CONTAINS1286 SUBROUTINE obc_dta( kt ) ! Dummy routine1287 INTEGER, INTENT (in) :: kt1288 WRITE(*,*) 'obc_dta: You should not have seen this print! error?', kt1289 END SUBROUTINE obc_dta1207 !!------------------------------------------------------------------------------ 1208 !! default option: Dummy module NO Open Boundary Conditions 1209 !!------------------------------------------------------------------------------ 1210 CONTAINS 1211 SUBROUTINE obc_dta( kt ) ! Dummy routine 1212 INTEGER, INTENT (in) :: kt 1213 WRITE(*,*) 'obc_dta: You should not have seen this print! error?', kt 1214 END SUBROUTINE obc_dta 1290 1215 #endif 1291 END MODULE obcdta1216 END MODULE obcdta -
branches/devmercator2010_1/NEMO/OPA_SRC/OBC/obcdyn_bt.F90
r1152 r2209 23 23 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 24 24 USE lib_mpp ! distributed memory computing 25 USE obc cli ! ocean open boundary conditions: climatology25 USE obcdta ! ocean open boundary conditions 26 26 USE in_out_manager ! I/O manager 27 27 USE dynspg_oce ! surface pressure gradient (free surface with time-splitting) … … 99 99 !! * Local declaration 100 100 INTEGER :: ji, jj, jk ! dummy loop indices 101 REAL(wp) :: z05cx, ztau, zin102 101 !!------------------------------------------------------------------------------ 103 102 … … 134 133 !! * Local declaration 135 134 INTEGER :: ji, jj, jk ! dummy loop indices 136 REAL(wp) :: z05cx, ztau, zin137 135 !!------------------------------------------------------------------------------ 138 136 … … 166 164 !! * Local declaration 167 165 INTEGER :: ji, jj, jk ! dummy loop indices 168 REAL(wp) :: z05cx, ztau, zin169 166 !!------------------------------------------------------------------------------ 170 167 … … 200 197 !! * Local declaration 201 198 INTEGER :: ji, jj, jk ! dummy loop indices 202 REAL(wp) :: z05cx, ztau, zin203 199 204 200 !!------------------------------------------------------------------------------ … … 235 231 !! * Local declaration 236 232 INTEGER :: ji, jj, jk ! dummy loop indices 237 REAL(wp) :: z05cx, ztau, zin238 233 !!------------------------------------------------------------------------------ 239 234 … … 268 263 !! * Local declaration 269 264 INTEGER :: ji, jj, jk ! dummy loop indices 270 REAL(wp) :: z05cx, ztau, zin271 265 !!------------------------------------------------------------------------------ 272 266 … … 298 292 !! * Local declaration 299 293 INTEGER :: ji, jj, jk ! dummy loop indices 300 REAL(wp) :: z05cx, ztau, zin301 294 !!------------------------------------------------------------------------------ 302 295 … … 330 323 !! * Local declaration 331 324 INTEGER :: ji, jj, jk ! dummy loop indices 332 REAL(wp) :: z05cx, ztau, zin333 325 334 326 !!------------------------------------------------------------------------------ -
branches/devmercator2010_1/NEMO/OPA_SRC/OBC/obcini.F90
r2137 r2209 375 375 END IF 376 376 377 IF ( ln_vol_cst .OR. lk_dynspg_flt ) THEN 378 ! ... Initialize obcumask and obcvmask for the Force filtering 379 ! boundary condition in dynspg_flt 380 obcumask(:,:) = umask(:,:,1) 381 obcvmask(:,:) = vmask(:,:,1) 382 383 ! ... Initialize obctmsk on overlap region and obcs. This mask 384 ! is used in obcvol.F90 to calculate cumulate flux E-P. 385 ! obc Tracer point are outside the domain ( U/V obc points) ==> masked by obctmsk 386 ! - no flux E-P on obcs and overlap region (jpreci = jprecj = 1) 387 obctmsk(:,:) = tmask_i(:,:) 388 389 IF( lp_obc_east ) THEN 390 ! ... East obc Force filtering mask for the grad D 391 obcumask(nie0 :nie1 ,nje0p1:nje1m1) = 0.e0 392 obcvmask(nie0p1:nie1p1,nje0p1:nje1m1) = 0.e0 393 ! ... set to 0 on East OBC 394 obctmsk(nie0p1:nie1p1,nje0:nje1) = 0.e0 395 END IF 396 397 IF( lp_obc_west ) THEN 398 ! ... West obc Force filtering mask for the grad D 399 obcumask(niw0:niw1,njw0:njw1) = 0.e0 400 obcvmask(niw0:niw1,njw0:njw1) = 0.e0 401 ! ... set to 0 on West OBC 402 obctmsk(niw0:niw1,njw0:njw1) = 0.e0 403 END IF 404 405 IF( lp_obc_north ) THEN 406 ! ... North obc Force filtering mask for the grad D 407 obcumask(nin0p1:nin1m1,njn0p1:njn1p1) = 0.e0 408 obcvmask(nin0p1:nin1m1,njn0 :njn1 ) = 0.e0 409 ! ... set to 0 on North OBC 410 obctmsk(nin0:nin1,njn0p1:njn1p1) = 0.e0 411 END IF 412 413 IF( lp_obc_south ) THEN 414 ! ... South obc Force filtering mask for the grad D 415 obcumask(nis0p1:nis1m1,njs0:njs1) = 0.e0 416 obcvmask(nis0p1:nis1m1,njs0:njs1) = 0.e0 417 ! ... set to 0 on South OBC 418 obctmsk(nis0:nis1,njs0:njs1) = 0.e0 419 END IF 420 ENDIF 421 422 IF ( ln_vol_cst .OR. lk_dynspg_flt ) THEN 423 424 ! 3.1 Total lateral surface 425 ! ------------------------- 426 obcsurftot = 0.e0 427 428 IF( lp_obc_east ) THEN ! ... East open boundary lateral surface 429 DO ji = nie0, nie1 430 DO jj = 1, jpj 431 obcsurftot = obcsurftot+hu(ji,jj)*e2u(ji,jj)*uemsk(jj,1) * MAX(obctmsk(ji,jj),obctmsk(ji+1,jj) ) 432 END DO 377 ! ... Initialize obcumask and obcvmask for the Force filtering 378 ! boundary condition in dynspg_flt 379 obcumask(:,:) = umask(:,:,1) 380 obcvmask(:,:) = vmask(:,:,1) 381 382 ! ... Initialize obctmsk on overlap region and obcs. This mask 383 ! is used in obcvol.F90 to calculate cumulate flux E-P. 384 ! obc Tracer point are outside the domain ( U/V obc points) ==> masked by obctmsk 385 ! - no flux E-P on obcs and overlap region (jpreci = jprecj = 1) 386 obctmsk(:,:) = tmask_i(:,:) 387 388 IF( lp_obc_east ) THEN 389 ! ... East obc Force filtering mask for the grad D 390 obcumask(nie0 :nie1 ,nje0p1:nje1m1) = 0.e0 391 obcvmask(nie0p1:nie1p1,nje0p1:nje1m1) = 0.e0 392 ! ... set to 0 on East OBC 393 obctmsk(nie0p1:nie1p1,nje0:nje1) = 0.e0 394 END IF 395 396 IF( lp_obc_west ) THEN 397 ! ... West obc Force filtering mask for the grad D 398 obcumask(niw0:niw1,njw0:njw1) = 0.e0 399 obcvmask(niw0:niw1,njw0:njw1) = 0.e0 400 ! ... set to 0 on West OBC 401 obctmsk(niw0:niw1,njw0:njw1) = 0.e0 402 END IF 403 404 IF( lp_obc_north ) THEN 405 ! ... North obc Force filtering mask for the grad D 406 obcumask(nin0p1:nin1m1,njn0p1:njn1p1) = 0.e0 407 obcvmask(nin0p1:nin1m1,njn0 :njn1 ) = 0.e0 408 ! ... set to 0 on North OBC 409 obctmsk(nin0:nin1,njn0p1:njn1p1) = 0.e0 410 END IF 411 412 IF( lp_obc_south ) THEN 413 ! ... South obc Force filtering mask for the grad D 414 obcumask(nis0p1:nis1m1,njs0:njs1) = 0.e0 415 obcvmask(nis0p1:nis1m1,njs0:njs1) = 0.e0 416 ! ... set to 0 on South OBC 417 obctmsk(nis0:nis1,njs0:njs1) = 0.e0 418 END IF 419 420 ! 3.1 Total lateral surface 421 ! ------------------------- 422 obcsurftot = 0.e0 423 424 IF( lp_obc_east ) THEN ! ... East open boundary lateral surface 425 DO ji = nie0, nie1 426 DO jj = 1, jpj 427 obcsurftot = obcsurftot+hu(ji,jj)*e2u(ji,jj)*uemsk(jj,1) * MAX(obctmsk(ji,jj),obctmsk(ji+1,jj) ) 433 428 END DO 434 END IF435 436 IF( lp_obc_west ) THEN ! ... West open boundary lateral surface 437 DO ji = niw0, niw1438 DO jj = 1, jpj439 obcsurftot = obcsurftot+hu(ji,jj)*e2u(ji,jj)*uwmsk(jj,1) * MAX(obctmsk(ji,jj),obctmsk(ji+1,jj) )440 END DO429 END DO 430 END IF 431 432 IF( lp_obc_west ) THEN ! ... West open boundary lateral surface 433 DO ji = niw0, niw1 434 DO jj = 1, jpj 435 obcsurftot = obcsurftot+hu(ji,jj)*e2u(ji,jj)*uwmsk(jj,1) * MAX(obctmsk(ji,jj),obctmsk(ji+1,jj) ) 441 436 END DO 442 END IF 443 IF( lp_obc_north ) THEN ! ... North open boundary lateral surface 444 DO jj = njn0, njn1 445 DO ji = 1, jpi 446 obcsurftot = obcsurftot+hv(ji,jj)*e1v(ji,jj)*vnmsk(ji,1) * MAX(obctmsk(ji,jj),obctmsk(ji,jj+1) ) 447 END DO 437 END DO 438 END IF 439 440 IF( lp_obc_north ) THEN ! ... North open boundary lateral surface 441 DO jj = njn0, njn1 442 DO ji = 1, jpi 443 obcsurftot = obcsurftot+hv(ji,jj)*e1v(ji,jj)*vnmsk(ji,1) * MAX(obctmsk(ji,jj),obctmsk(ji,jj+1) ) 448 444 END DO 449 END IF450 451 IF( lp_obc_south ) THEN ! ... South open boundary lateral surface 452 DO jj = njs0, njs1453 DO ji = 1, jpi454 obcsurftot = obcsurftot+hv(ji,jj)*e1v(ji,jj)*vsmsk(ji,1) * MAX(obctmsk(ji,jj),obctmsk(ji,jj+1) )455 END DO445 END DO 446 END IF 447 448 IF( lp_obc_south ) THEN ! ... South open boundary lateral surface 449 DO jj = njs0, njs1 450 DO ji = 1, jpi 451 obcsurftot = obcsurftot+hv(ji,jj)*e1v(ji,jj)*vsmsk(ji,1) * MAX(obctmsk(ji,jj),obctmsk(ji,jj+1) ) 456 452 END DO 457 END IF458 459 IF( lk_mpp ) CALL mpp_sum( obcsurftot ) ! sum over the global domain 460 ENDIF453 END DO 454 END IF 455 456 IF( lk_mpp ) CALL mpp_sum( obcsurftot ) ! sum over the global domain 461 457 462 458 ! 5. Control print on mask -
branches/devmercator2010_1/NEMO/OPA_SRC/OBC/obcrad.F90
r1528 r2209 115 115 ! ------------------- 116 116 117 IF( kt > nit000 ) THEN117 IF( kt > nit000 .OR. ln_rstart ) THEN 118 118 119 119 ! ... advance in time (time filter, array swap) … … 379 379 ! ------------------- 380 380 381 IF( kt > nit000 ) THEN381 IF( kt > nit000 .OR. ln_rstart ) THEN 382 382 383 383 ! ... advance in time (time filter, array swap) … … 648 648 ! ------------------- 649 649 650 IF( kt > nit000 ) THEN650 IF( kt > nit000 .OR. ln_rstart ) THEN 651 651 652 652 ! ... advance in time (time filter, array swap) … … 922 922 ! -------------------- 923 923 924 IF( kt > nit000 ) THEN924 IF( kt > nit000 .OR. ln_rstart ) THEN 925 925 926 926 ! ... advance in time (time filter, array swap) -
branches/devmercator2010_1/NEMO/OPA_SRC/OBC/obcrst.F90
r2137 r2209 278 278 !! * Local declarations 279 279 INTEGER :: inum = 11 ! temporary logical unit 280 INTEGER :: ji,jj,jk ,ios280 INTEGER :: ji,jj,jk 281 281 INTEGER :: ino0,it0,nbobc0,jpieob0,jpiwob0,jpjnob0,jpjsob0 282 282 INTEGER :: ino1,it1,nbobc1,jpieob1,jpiwob1,jpjnob1,jpjsob1 -
branches/devmercator2010_1/NEMO/OPA_SRC/SBC/fldread.F90
r2137 r2209 551 551 ! 552 552 ztmp = 0.e0 553 IF( REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) .GT. 0.5 ) ztmp = 1.0553 ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 554 554 ELSE 555 555 ztmp = 0.e0 -
branches/devmercator2010_1/NEMO/OPA_SRC/SBC/sbcana.F90
r1732 r2209 88 88 ! 89 89 nn_tau000 = MAX( nn_tau000, 1 ) ! must be >= 1 90 qns (:,:) = rn_qns091 qsr (:,:) = rn_qsr092 emp (:,:) = rn_emp093 emps (:,:) = rn_emp094 90 ! 95 91 ENDIF 92 93 qns (:,:) = rn_qns0 94 qsr (:,:) = rn_qsr0 95 emp (:,:) = rn_emp0 96 emps (:,:) = rn_emp0 96 97 97 98 ! Increase the surface stress to its nominal value during the first nn_tau000 time-steps -
branches/devmercator2010_1/NEMO/OPA_SRC/opa.F90
r2137 r2209 192 192 ! !--------------------------------------------! 193 193 #if defined key_iomput 194 IF( Agrif_Root() ) THEN 194 195 # if defined key_oasis3 || defined key_oasis4 195 196 IF( Agrif_Root() ) THEN … … 202 203 ENDIF 203 204 # endif 205 CALL init_ioclient( ilocal_comm ) ! exchange io_server nemo local communicator with the io_server 206 ENDIF 204 207 narea = mynode( cltxt, ilocal_comm ) ! Nodes selection 205 206 208 #else 207 209 # if defined key_oasis3 || defined key_oasis4 -
branches/devmercator2010_1/NEMO/OPA_SRC/step.F90
r2137 r2209 179 179 CALL iom_setkt( kstp ) ! say to iom that we are at time step kstp 180 180 181 CALL rst_opn( kstp ) ! Open the restart file182 183 181 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 184 182 ! Update data, open boundaries, surface boundary condition (including sea-ice)
Note: See TracChangeset
for help on using the changeset viewer.