Changeset 26 for trunk/NEMO/OPA_SRC/OBC
- Timestamp:
- 2004-02-17T10:01:42+01:00 (20 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/OBC/obcdta.F90 (modified) (12 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/OBC/obcdta.F90
r3 r26 19 19 USE daymod ! calendar 20 20 USE in_out_manager ! I/O logical units 21 USE lib_mpp ! distribued memory computing 21 22 22 23 … … 42 43 SUBROUTINE obc_dta_uvt ( kt ) 43 44 !!--------------------------------------------------------------------------- 44 !! SUBROUTINE obc_dta_uvt 45 !! ************************ 46 !! ** Purpose : 47 !! Find the climatological boundary arrays for the specified date, 45 !! *** SUBROUTINE obc_dta_uvt *** 46 !! 47 !! ** Purpose : Find the climatological boundary arrays for the specified date, 48 48 !! Originally this routine interpolated between monthly fields 49 49 !! of a climatology. … … 51 51 !! and do not need to interpolate. 52 52 !! 53 !! ** Method : 54 !! Determine the current month from kdat, and interpolate for the 55 !! current day. 53 !! ** Method : Determine the current month from kdat, and interpolate for 54 !! the current day. 56 55 !! 57 56 !! History : … … 149 148 sedta(ij,jk,1) = sn(ji,jj,jk)*tmask(ji,jj,jk) 150 149 tedta(ij,jk,1) = tn(ji,jj,jk)*tmask(ji,jj,jk) 151 uedta(ij,jk,1) = 0.1*umask(ji,jj,jk)150 uedta(ij,jk,1) = un(ji,jj,jk)*umask(ji,jj,jk) 152 151 END DO 153 152 END DO … … 240 239 IF( nobc_dta == 0 ) THEN ! initial state used 241 240 ! ! ================== ! 242 DO ji = fs_niw0, fs_niw1 ! Vector opt. 241 DO ji = fs_niw0, fs_niw1 ! Vector opt. 242 DO jk = 1, jpkm1 243 DO jj = 1, jpj 244 ij = jj -1 + njmpp 245 swdta(ij,jk,1) = sn(ji,jj,jk)*tmask(ji,jj,jk) 246 twdta(ij,jk,1) = tn(ji,jj,jk)*tmask(ji,jj,jk) 247 uwdta(ij,jk,1) = un(ji,jj,jk)*umask(ji,jj,jk) 248 END DO 249 END DO 250 END DO 251 243 252 DO jk = 1, jpkm1 244 253 DO jj = 1, jpj 245 254 ij = jj -1 + njmpp 246 s wdta(ij,jk,1) = sn(ji,jj,jk)*tmask(ji,jj,jk)247 t wdta(ij,jk,1) = tn(ji,jj,jk)*tmask(ji,jj,jk)248 u wdta(ij,jk,1) = 0.1*umask(ji,jj,jk)255 sfow(jj,jk) = swdta(ij,jk,1)*twmsk(jj,jk) 256 tfow(jj,jk) = twdta(ij,jk,1)*twmsk(jj,jk) 257 ufow(jj,jk) = uwdta(ij,jk,1)*uwmsk(jj,jk) 249 258 END DO 250 259 END DO 251 END DO252 253 DO jk = 1, jpkm1254 DO jj = 1, jpj255 ij = jj -1 + njmpp256 sfow(jj,jk) = swdta(ij,jk,1)*twmsk(jj,jk)257 tfow(jj,jk) = twdta(ij,jk,1)*twmsk(jj,jk)258 ufow(jj,jk) = uwdta(ij,jk,1)*uwmsk(jj,jk)259 END DO260 END DO261 260 ! ! =================== ! 262 261 ELSE ! read in obceast.dta 263 262 ! ! =================== ! 264 OPEN(UNIT = inum,&263 OPEN(UNIT = inum, & 265 264 IOSTAT = ios, & 266 265 FILE ='obcwest.dta', & … … 268 267 ACCESS ='DIRECT', & 269 268 RECL = 4096 ) 270 IF( ios > 0 ) THEN271 IF(lwp) WRITE(numout,*) 'obc_dta_uvt: Pbm to OPEN the obcwest.dta file '272 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'273 nstop = nstop + 1274 END IF275 READ(inum,REC=1) clversion, clcom,irecl276 CLOSE(inum)277 IF(lwp) WRITE(numout,*)' '278 IF(lwp) WRITE(numout,*)' opening obcwest.dta with irecl=',irecl279 OPEN(UNIT = inum,&269 IF( ios > 0 ) THEN 270 IF(lwp) WRITE(numout,*) 'obc_dta_uvt: Pbm to OPEN the obcwest.dta file ' 271 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 272 nstop = nstop + 1 273 END IF 274 READ(inum,REC=1) clversion, clcom,irecl 275 CLOSE(inum) 276 IF(lwp) WRITE(numout,*)' ' 277 IF(lwp) WRITE(numout,*)' opening obcwest.dta with irecl=',irecl 278 OPEN(UNIT = inum, & 280 279 IOSTAT = ios, & 281 280 FILE ='obcwest.dta', & … … 283 282 ACCESS ='DIRECT', & 284 283 RECL = irecl ) 285 IF( ios > 0 ) THEN286 IF(lwp) WRITE(numout,*) 'obc_dta_uvt: Pbm to OPEN the obcwest.dta file '287 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'288 nstop = nstop + 1289 END IF290 291 ! ... Read datafile and set temperature, salinity and normal velocity292 ! ... initialise the swdta, twdta arrays293 ! ... index 1 refer to before, 2 to after294 DO jk = 1, jpkm1295 irec = 2 + (jk -1)* jpf296 READ(inum,REC=irec )((swdta(jj,jk,1),ji=1,1),jj=jpjwd, jpjwf)297 READ(inum,REC=irec+1)((twdta(jj,jk,1),ji=1,1),jj=jpjwd, jpjwf)298 READ(inum,REC=irec+2)((uwdta(jj,jk,1),ji=1,1),jj=jpjwd, jpjwf)299 DO jj = 1, jpj300 ij = jj -1 + njmpp301 sfow(jj,jk) = swdta(ij,jk,1)*twmsk(jj,jk)302 tfow(jj,jk) = twdta(ij,jk,1)*twmsk(jj,jk)303 END DO304 END DO305 CLOSE(inum)284 IF( ios > 0 ) THEN 285 IF(lwp) WRITE(numout,*) 'obc_dta_uvt: Pbm to OPEN the obcwest.dta file ' 286 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 287 nstop = nstop + 1 288 END IF 289 290 ! ... Read datafile and set temperature, salinity and normal velocity 291 ! ... initialise the swdta, twdta arrays 292 ! ... index 1 refer to before, 2 to after 293 DO jk = 1, jpkm1 294 irec = 2 + (jk -1)* jpf 295 READ(inum,REC=irec )((swdta(jj,jk,1),ji=1,1),jj=jpjwd, jpjwf) 296 READ(inum,REC=irec+1)((twdta(jj,jk,1),ji=1,1),jj=jpjwd, jpjwf) 297 READ(inum,REC=irec+2)((uwdta(jj,jk,1),ji=1,1),jj=jpjwd, jpjwf) 298 DO jj = 1, jpj 299 ij = jj -1 + njmpp 300 sfow(jj,jk) = swdta(ij,jk,1)*twmsk(jj,jk) 301 tfow(jj,jk) = twdta(ij,jk,1)*twmsk(jj,jk) 302 END DO 303 END DO 304 CLOSE(inum) 306 305 307 306 #if ! defined key_dynspg_fsc 308 ! ... Rigid lid case: make sure uwdta is baroclinic velocity309 ! ... In rigid lid case uwdta needs to be the baroclinic component.310 311 CALL obc_cli( uwdta, ucliw, fs_niw0, fs_niw1, 0, jpj, njmpp )307 ! ... Rigid lid case: make sure uwdta is baroclinic velocity 308 ! ... In rigid lid case uwdta needs to be the baroclinic component. 309 310 CALL obc_cli( uwdta, ucliw, fs_niw0, fs_niw1, 0, jpj, njmpp ) 312 311 313 312 # endif 314 ! ... Set normal velocity (on niw0, niw1 <=> jpiwob)315 DO jk = 1, jpkm1316 DO jj = 1, jpj317 ij = jj -1 + njmpp318 ufow(jj,jk) = uwdta(ij,jk,1)*uwmsk(jj,jk)319 END DO320 END DO313 ! ... Set normal velocity (on niw0, niw1 <=> jpiwob) 314 DO jk = 1, jpkm1 315 DO jj = 1, jpj 316 ij = jj -1 + njmpp 317 ufow(jj,jk) = uwdta(ij,jk,1)*uwmsk(jj,jk) 318 END DO 319 END DO 321 320 ENDIF 322 321 ENDIF … … 332 331 vndta(:,:,1) = 0.e0 333 332 334 OPEN(UNIT = inum, &333 OPEN(UNIT = inum, & 335 334 IOSTAT = ios, & 336 335 FILE ='obcnorth.dta', & … … 528 527 !! * Arguments 529 528 INTEGER,INTENT(in) :: kt 530 WRITE(*,*) kt529 WRITE(*,*) 'obc_dta_psi: You should not have seen this print! error?', kt 531 530 END SUBROUTINE obc_dta_psi 532 531 #else … … 567 566 !! * Local declarations 568 567 INTEGER :: ji, jj, jnic, jip ! dummy loop indices 568 INTEGER :: inum = 11 ! temporary logical unit 569 569 INTEGER :: ip, ii, ij, iii, ijj 570 570 INTEGER :: kbsfstart … … 622 622 END DO 623 623 END IF 624 # if defined key_mpp 625 CALL mpprisl( gcbic, 3 ) 626 # endif 624 625 IF( lk_mpp ) CALL mpp_isl( gcbic, 3 ) 627 626 628 627 ! 3. Update the climatological barotropic function at the boundary … … 711 710 SUBROUTINE obc_dta_uvt( kt ) ! Empty routine 712 711 INTEGER, INTENT (in) :: kt 713 WRITE(*,*) kt712 WRITE(*,*) 'obc_dta_uvt: You should not have seen this print! error?', kt 714 713 END SUBROUTINE obc_dta_uvt 715 714 716 715 SUBROUTINE obc_dta_psi( kt ) ! Empty routine 717 716 INTEGER, INTENT (in) :: kt 718 WRITE(*,*) kt717 WRITE(*,*) 'obc_dta_psi: You should not have seen this print! error?', kt 719 718 END SUBROUTINE obc_dta_psi 720 719
Note: See TracChangeset
for help on using the changeset viewer.
