- Location:
- /trunk/NEMO/OPA_SRC
- Files:
-
- 11 edited
-
DIA/diawri.F90 (modified) (2 diffs)
-
DIA/ptr.F90 (modified) (10 diffs)
-
DOM/domhgr.F90 (modified) (4 diffs)
-
DOM/domzgr.F90 (modified) (5 diffs)
-
LDF/ldfdyn.F90 (modified) (1 diff)
-
LDF/ldfeiv.F90 (modified) (2 diffs)
-
LDF/ldftra.F90 (modified) (1 diff)
-
OBC/obcdta.F90 (modified) (12 diffs)
-
OBC/obcini.F90 (modified) (16 diffs)
-
TRA/trabbl_adv.h90 (modified) (7 diffs)
-
TRA/traldf_iso_zps.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
/trunk/NEMO/OPA_SRC/DIA/diawri.F90
r20 r30 371 371 CALL histdef( nid_W, "soleahtw", "lateral eddy diffusivity" , "m2/s" , & ! ahtw 372 372 & jpi, jpj, nh_W, 1 , 1, 1 , - 99, 32, clop, zsto, zout ) 373 IF( lk_traldf_eiv ) THEN 373 # if defined key_traldf_eiv 374 374 CALL histdef( nid_W, "soleaeiw", "eddy induced vel. coeff. at w-point", "m2/s", & ! aeiw 375 375 & jpi, jpj, nh_W, 1 , 1, 1 , - 99, 32, clop, zsto, zout ) 376 ENDIF 376 # endif 377 377 #endif 378 378 … … 482 482 #if defined key_traldf_c2d 483 483 CALL histwrite( nid_W, "soleahtw", it, ahtw , ndim_hT, ndex_hT ) ! lateral eddy diff. coef. 484 IF( lk_traldf_eiv ) THEN 484 # if defined key_traldf_eiv 485 485 CALL histwrite( nid_W, "soleaeiw", it, aeiw , ndim_hT, ndex_hT ) ! EIV coefficient at w-point 486 ENDIF 486 # endif 487 487 #endif 488 488 -
/trunk/NEMO/OPA_SRC/DIA/ptr.F90
r20 r30 16 16 USE oce ! ocean dynamics and active tracers 17 17 USE dom_oce ! ocean space and time domain 18 USE ldftra_oce ! ??? 19 USE lib_mpp 20 USE in_out_manager 18 21 19 22 IMPLICIT NONE … … 21 24 22 25 !! * Routine accessibility 23 PUBLIC dia_ptr ! call by stp routine 24 PUBLIC prt_vj ! call by tra_ldf & tra_adv routines 26 PUBLIC dia_ptr_init ! call in step module 27 PUBLIC dia_ptr ! call by in step module 28 PUBLIC prt_vj ! call by tra_ldf & tra_adv routines 25 29 26 30 !! * Share Module variables 27 LOGICAL, PUBLIC, PARAMETER :: lk_diaptr = .TRUE. ! poleward transport flag28 INTEGER, PUBLIC :: !!!** ptr namelist (namptr) **29 nf_ptr = 15 ! frequency of ptr computation31 LOGICAL, PUBLIC, PARAMETER :: lk_diaptr = .TRUE. !: poleward transport flag 32 INTEGER, PUBLIC :: & !!: ** ptr namelist (namptr) ** 33 nf_ptr = 15 !: frequency of ptr computation 30 34 REAL(wp), PUBLIC, DIMENSION(jpj) :: & ! poleward transport 31 pht_adv, pst_adv, & ! heat and salt: advection32 pht_ove, pst_ove, & ! heat and salt: overturning33 pht_ldf, pst_ldf, & ! heat and salt: lateral diffusion34 pht_eiv, pst_eiv ! heat and salt: bolus advection35 pht_adv, pst_adv, & !: heat and salt: advection 36 pht_ove, pst_ove, & !: heat and salt: overturning 37 pht_ldf, pst_ldf, & !: heat and salt: lateral diffusion 38 pht_eiv, pst_eiv !: heat and salt: bolus advection 35 39 36 40 !! Module variables … … 45 49 !! * Substitutions 46 50 # include "domzgr_substitute.h90" 51 # include "vectopt_loop_substitute.h90" 47 52 !!---------------------------------------------------------------------- 48 53 !! OPA 9.0 , LODYC-IPSL (2003) … … 72 77 !! * local declarations 73 78 INTEGER :: ji, jj, jk ! dummy loop arguments 79 INTEGER :: ijpj = jpj ! ??? 74 80 REAL(wp),DIMENSION(jpj) :: & 75 81 p_fval ! function value … … 85 91 END DO 86 92 END DO 87 88 #if defined key_mpp 89 CALL mpp_sum( p_fval, jpj ) !!bug I presume 90 #endif 93 IF( lk_mpp ) CALL mpp_sum( p_fval, ijpj ) !!bug I presume 91 94 92 95 END FUNCTION ptr_vj … … 127 130 END DO 128 131 END DO 129 130 #if defined key_mpp 131 CALL mpp_sum( p_fval, jpj*jpk ) !!bug I presume 132 #endif 132 IF( lk_mpp) CALL mpp_sum( p_fval, jpj*jpk ) !!bug I presume 133 133 134 134 END FUNCTION ptr_vjk … … 171 171 END DO 172 172 p_fval(:,:) = p_val(:,:) * 0.5 173 174 #if defined key_mpp 175 CALL mpp_sum( p_fval, jpj*jpk ) !!bug I presume 176 #endif 173 IF( lk_mpp ) CALL mpp_sum( p_fval, jpj*jpk ) !!bug I presume 177 174 178 175 END FUNCTION ptr_vtjk … … 300 297 zphi(:) = gphiv(ji,:) ! if iline is in the local domain 301 298 END DO 302 # if defined key_mpp 303 CALL mpp_sum( zphi, jpj ) ! provide the correct zphi to all local domains 304 # endif 299 IF( lk_mpp ) CALL mpp_sum( zphi, jpj ) ! provide the correct zphi to all local domains 300 305 301 ! ! ======================= 306 302 ELSE ! OTHER configurations … … 402 398 zphi(:) = gphiv(ji,:) ! if iline is in the local domain 403 399 END DO 404 # if defined key_mpp 405 CALL mpp_sum( zphi, jpj ) ! provide the correct zphi to all local domains 406 # endif 400 IF( lk_mpp ) CALL mpp_sum( zphi, jpj ) ! provide the correct zphi to all local domains 401 407 402 ! ! ======================= 408 403 ELSE ! OTHER configurations … … 515 510 CONTAINS 516 511 SUBROUTINE dia_ptr( kt ) ! Empty routine 517 WRITE(*,*) kt512 WRITE(*,*) 'dia_ptr: You should not have seen this print! error?', kt 518 513 END SUBROUTINE dia_ptr 514 SUBROUTINE dia_ptr_init ! Empty routine 515 WRITE(*,*) 'dia_ptr_init: You should not have seen this print! error?' 516 END SUBROUTINE dia_ptr_init 519 517 #endif 520 518 -
/trunk/NEMO/OPA_SRC/DOM/domhgr.F90
r20 r30 101 101 !! * local declarations 102 102 INTEGER :: ji, jj ! dummy loop indices 103 INTEGER :: jeq ! index of equator T point (computed for case 4)103 INTEGER :: ijeq ! index of equator T point (computed for case 4) 104 104 REAL(wp) :: & 105 105 zti, zui, zvi, zfi, & ! temporary scalars … … 234 234 ! The formula should work even if the equator is outside the domain. 235 235 zarg = rpi / 4. - rpi / 180. * ppgphi0 / 2. 236 jeq = ABS( 180./rpi * LOG( COS( zarg ) / SIN( zarg ) ) / ppe1_deg )237 238 IF(lwp) WRITE(numout,*) ' Index of the equator on the MERCATOR grid:', jeq236 ijeq = ABS( 180./rpi * LOG( COS( zarg ) / SIN( zarg ) ) / ppe1_deg ) 237 238 IF(lwp) WRITE(numout,*) ' Index of the equator on the MERCATOR grid:', ijeq 239 239 240 240 DO jj = 1, jpj 241 241 DO ji = 1, jpi 242 zti = FLOAT( ji - 1 + nimpp - 1 ) ; ztj = FLOAT( jj - jeq + njmpp - 1 )243 zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5 ; zuj = FLOAT( jj - jeq + njmpp - 1 )244 zvi = FLOAT( ji - 1 + nimpp - 1 ) ; zvj = FLOAT( jj - jeq + njmpp - 1 ) + 0.5245 zfi = FLOAT( ji - 1 + nimpp - 1 ) + 0.5 ; zfj = FLOAT( jj - jeq + njmpp - 1 ) + 0.5242 zti = FLOAT( ji - 1 + nimpp - 1 ) ; ztj = FLOAT( jj - ijeq + njmpp - 1 ) 243 zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5 ; zuj = FLOAT( jj - ijeq + njmpp - 1 ) 244 zvi = FLOAT( ji - 1 + nimpp - 1 ) ; zvj = FLOAT( jj - ijeq + njmpp - 1 ) + 0.5 245 zfi = FLOAT( ji - 1 + nimpp - 1 ) + 0.5 ; zfj = FLOAT( jj - ijeq + njmpp - 1 ) + 0.5 246 246 ! Longitude 247 247 glamt(ji,jj) = ppglam0 + ppe1_deg * zti … … 336 336 zf0 = 2. * omega * SIN( rad * zphi0 ) ! compute f0 1st point south 337 337 338 ff(:,:) = ( zf0 + zbeta * gphif(:,:) )! f = f0 +beta* y ( y=0 at south)338 ff(:,:) = ( zf0 + zbeta * gphif(:,:) * 1.e+3 ) ! f = f0 +beta* y ( y=0 at south) 339 339 340 340 IF(lwp) WRITE(numout,*) ' Beta-plane: Beta parameter = constant = ', ff(1,1) … … 560 560 ! ! ===================== 561 561 IF( n_cla == 0 ) THEN 562 e2u( mi0(160):mi1(161) , mj0(88):mj1(88) ) = 18.e3 ! Bab el Mandeb (e2u = 18 km) 562 ii0 = 160 ; ii1 = 161 ! Bab el Mandeb (e2u = 18 km) 563 ij0 = 88 ; ij1 = 88 ; e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij0) ) = 18.e3 563 564 IF(lwp) WRITE(numout,*) 564 565 IF(lwp) WRITE(numout,*) ' Bab el Mandeb: e2u reduced to 18 km' 565 566 ENDIF 566 567 e2u( mi0(145):mi1(146) , mj0(116):mj1(116) ) = 15.e3 ! Sound Strait (e2u = 15 km) 567 568 ii0 = 145 ; ii1 = 146 ! Sound Strait (e2u = 15 km) 569 ij0 = 116 ; ij1 = 116 ; e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij0) ) = 15.e3 568 570 IF(lwp) WRITE(numout,*) 569 571 IF(lwp) WRITE(numout,*) ' : Reduced e2u at the Sound Strait' -
/trunk/NEMO/OPA_SRC/DOM/domzgr.F90
r20 r30 338 338 DO jj = 1, jpjdta 339 339 DO ji = 1, jpidta 340 IF( gdep w(jk) < zdta(ji,jj) .AND. zdta(ji,jj) <= gdepw(jk+1) ) idta(ji,jj) = jk340 IF( gdept(jk) < zdta(ji,jj) .AND. zdta(ji,jj) <= gdept(jk+1) ) idta(ji,jj) = jk 341 341 END DO 342 342 END DO … … 346 346 ! set boundary conditions (caution, idta on the global domain: use of jperio, not nperio) 347 347 IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN 348 idta( : , 1 ) = -1 ; zdta( : , 1) = -1.e0349 idta( : ,jpj) = 0 ; zdta( : ,jpj) = 0.e0348 idta( : , 1 ) = -1 ; zdta( : , 1 ) = -1.e0 349 idta( : ,jpjdta) = 0 ; zdta( : ,jpjdta) = 0.e0 350 350 ELSEIF( jperio == 2 ) THEN 351 idta( : , 1 ) = idta( : , 3 ) ; zdta( : , 1) = zdta( : , 3 )352 idta( : ,jpj) = 0 ; zdta( : ,jpj) = 0.e0353 idta( 1 , : ) = 0 ; zdta( 1 , :) = 0.e0354 idta(jpi , : ) = 0 ; zdta(jpi, :) = 0.e0351 idta( : , 1 ) = idta( : , 3 ) ; zdta( : , 1 ) = zdta( : , 3 ) 352 idta( : ,jpjdta) = 0 ; zdta( : ,jpjdta) = 0.e0 353 idta( 1 , : ) = 0 ; zdta( 1 , : ) = 0.e0 354 idta(jpidta, : ) = 0 ; zdta(jpidta, : ) = 0.e0 355 355 ELSE 356 idta( : , 1 ) = 0 ; zdta( : , 1 ) = 0.e0 357 idta( : ,jpj) = 0 ; zdta( : ,jpj) = 0.e0 358 idta( 1 , : ) = 0 ; zdta( 1 , : ) = 0.e0 359 idta(jpi, : ) = 0 ; zdta(jpi, : ) = 0.e0 356 idta( : , 1 ) = 0 ; zdta( : , 1 ) = 0.e0 357 idta( : ,jpjdta) = 0 ; zdta( : ,jpjdta) = 0.e0 358 idta( 1 , : ) = 0 ; zdta( 1 , : ) = 0.e0 359 idta(jpidta, : ) = 0 ; zdta(jpidta, : ) = 0.e0 360 ENDIF 361 362 ! EEL R5 configuration with east and west open boundaries. 363 ! Two rows of zeroes are needed at the south and north for OBCs 364 365 IF( cp_cfg == "eel" .AND. jp_cfg == 5 ) THEN 366 idta( : , 2 ) = 0 ; zdta( : , 2 ) = 0.e0 367 !!CT idta( : ,jpjdta-1) = 0 ; zdta( : ,jpjdta-1) = 0.e0 360 368 ENDIF 361 369 … … 611 619 IF(lwp) WRITE(numout,*)' ',icompt,' ocean grid points suppressed' 612 620 ENDIF 613 #if defined key_mpp 614 zbathy(:,:) = FLOAT( mbathy(:,:) )615 CALL lbc_lnk( zbathy, 'T', 1. )616 mbathy(:,:) = INT( zbathy(:,:) )617 #endif 621 IF( lk_mpp ) THEN 622 zbathy(:,:) = FLOAT( mbathy(:,:) ) 623 CALL lbc_lnk( zbathy, 'T', 1. ) 624 mbathy(:,:) = INT( zbathy(:,:) ) 625 ENDIF 618 626 619 627 ! 3.2 East-west cyclic boundary conditions … … 622 630 IF(lwp) WRITE(numout,*) ' mbathy set to 0 along east and west', & 623 631 ' boundary: nperio = ', nperio 624 #if defined key_mpp 625 IF( nbondi == -1 .OR. nbondi == 2 ) THEN626 IF( jperio /= 1 ) mbathy(1,:) = 0627 ENDIF628 IF( nbondi == 1 .OR. nbondi == 2 ) THEN629 IF( jperio /= 1 ) mbathy(nlci,:) = 0630 ENDIF631 #else 632 mbathy( 1 ,:) = 0633 mbathy(jpi,:) = 0634 #endif 632 IF( lk_mpp ) THEN 633 IF( nbondi == -1 .OR. nbondi == 2 ) THEN 634 IF( jperio /= 1 ) mbathy(1,:) = 0 635 ENDIF 636 IF( nbondi == 1 .OR. nbondi == 2 ) THEN 637 IF( jperio /= 1 ) mbathy(nlci,:) = 0 638 ENDIF 639 ELSE 640 mbathy( 1 ,:) = 0 641 mbathy(jpi,:) = 0 642 ENDIF 635 643 ELSEIF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN 636 644 IF(lwp) WRITE(numout,*)' east-west cyclic boundary conditions', & … … 656 664 657 665 ! Boundary condition on mbathy 658 # if ! defined key_mpp 659 !!bug ??? y reflechir!660 ! ... mono- or macro-tasking: T-point, >0, 2D array, no slab661 zbathy(:,:) = FLOAT( mbathy(:,:) )662 CALL lbc_lnk( zbathy, 'T', 1. )663 mbathy(:,:) = INT( zbathy(:,:) )664 # endif 666 IF( .NOT.lk_mpp ) THEN 667 !!bug ??? y reflechir! 668 ! ... mono- or macro-tasking: T-point, >0, 2D array, no slab 669 zbathy(:,:) = FLOAT( mbathy(:,:) ) 670 CALL lbc_lnk( zbathy, 'T', 1. ) 671 mbathy(:,:) = INT( zbathy(:,:) ) 672 ENDIF 665 673 666 674 ENDIF -
/trunk/NEMO/OPA_SRC/LDF/ldfdyn.F90
r20 r30 126 126 ENDIF 127 127 128 IF( .NOT. lk_sco ) THEN ! horizontal = iso-level except in s-coordinate 129 ln_dynldf_level = ln_dynldf_level .OR. ln_dynldf_hor 128 IF( lk_sco ) THEN ! s-coordinates: rotation required for horizontal or isopycnal direction 129 IF( ( ln_dynldf_iso .OR. ln_dynldf_hor ) .AND. .NOT.lk_ldfslp ) THEN 130 IF(lwp) WRITE(numout,cform_err) 131 IF(lwp) WRITE(numout,*) ' the rotation of the viscous tensor require key_ldfslp' 132 IF( .NOT.lk_esopa ) nstop = nstop + 1 133 ENDIF 134 ELSE ! z-coordinates with/without partial step: 135 ln_dynldf_level = ln_dynldf_level .OR. ln_dynldf_hor ! level mixing = horizontal mixing 130 136 ln_dynldf_hor = .FALSE. 131 137 IF(lwp) WRITE(numout,*) ' horizontal mixing in z-coord or partial steps: force ln_dynldf_level = T' 132 IF(lwp) WRITE(numout,*) ' ln_dynldf_level = ', ln_dynldf_level, ' ln_dynldf_hor = ', ln_dynldf_hor 133 IF(lwp) WRITE(numout,*) ' ln_dynldf_t 1: ', .NOT. lk_ldfslp .OR. .NOT. lk_esopa & 134 , '2 ' , ln_dynldf_iso .OR. .NOT. ln_dynldf_hor 135 ENDIF 136 IF( .NOT.lk_ldfslp .AND. ( ln_dynldf_iso .OR. .NOT. ln_dynldf_hor ) ) THEN 137 IF( .NOT.lk_esopa ) THEN 138 IF(lwp) WRITE(numout,*) ' and force ln_dynldf_hor = F' 139 IF( ln_dynldf_iso .AND. .NOT.lk_ldfslp ) THEN ! rotation required for isopycnal mixing 138 140 IF(lwp) WRITE(numout,cform_err) 139 IF(lwp) WRITE(numout,*) ' the rotation of the diffusivetensor require key_ldfslp'140 nstop = nstop + 1141 IF(lwp) WRITE(numout,*) ' the rotation of the viscous tensor require key_ldfslp' 142 IF( .NOT.lk_esopa ) nstop = nstop + 1 141 143 ENDIF 142 144 ENDIF 143 144 145 145 146 l_dynldf_lap = ln_dynldf_lap .AND. ln_dynldf_level ! iso-level laplacian operator -
/trunk/NEMO/OPA_SRC/LDF/ldfeiv.F90
r20 r30 295 295 DO jj = 2, jpjm1 296 296 DO ji = fs_2, fs_jpim1 ! vector opt. 297 aeiw(ji,jj) = MIN( aeiw(ji,jj), 1000.)297 aeiw(ji,jj) = MIN( aeiw(ji,jj), aeiv0 ) 298 298 END DO 299 299 END DO … … 336 336 #else 337 337 !!---------------------------------------------------------------------- 338 !! Default option Empty module338 !! Default option Dummy module 339 339 !!---------------------------------------------------------------------- 340 340 CONTAINS 341 SUBROUTINE ldf_eiv ! Empty routine 341 SUBROUTINE ldf_eiv( kt ) ! Empty routine 342 WRITE(*,*) 'ldf_eiv: You should not have seen this print! error?', kt 342 343 END SUBROUTINE ldf_eiv 343 344 #endif -
/trunk/NEMO/OPA_SRC/LDF/ldftra.F90
r20 r30 135 135 ENDIF 136 136 137 IF( .NOT. lk_sco ) THEN ! horizontal = iso-level except in s-coordinate 138 ln_traldf_level = ln_traldf_level .OR. ln_traldf_hor 137 IF( lk_sco ) THEN ! s-coordinates: rotation required for horizontal or isopycnal mixing 138 IF( ( ln_traldf_iso .OR. ln_traldf_hor ) .AND. .NOT.lk_ldfslp ) THEN 139 IF(lwp) WRITE(numout,cform_err) 140 IF(lwp) WRITE(numout,*) ' the rotation of the diffusive tensor require key_ldfslp' 141 IF( .NOT.lk_esopa ) nstop = nstop + 1 142 ENDIF 143 ELSE ! z-coordinates with/without partial step: 144 ln_traldf_level = ln_traldf_level .OR. ln_traldf_hor ! level diffusion = horizontal diffusion 139 145 ln_traldf_hor = .FALSE. 140 ENDIF141 IF( .NOT.lk_ldfslp .AND. ( ln_traldf_iso .OR. .NOT.ln_traldf_hor ) ) THEN142 IF( .NOT.lk_esopa ) THEN146 IF(lwp) WRITE(numout,*) ' horizontal mixing in z-coord or partial steps: force ln_traldf_level = T' 147 IF(lwp) WRITE(numout,*) ' and force ln_traldf_hor = F' 148 IF( ln_traldf_iso .AND. .NOT.lk_ldfslp ) THEN ! rotation required for isopycnal mixing 143 149 IF(lwp) WRITE(numout,cform_err) 144 150 IF(lwp) WRITE(numout,*) ' the rotation of the diffusive tensor require key_ldfslp' 145 nstop = nstop + 1151 IF( .NOT.lk_esopa ) nstop = nstop + 1 146 152 ENDIF 147 153 ENDIF -
/trunk/NEMO/OPA_SRC/OBC/obcdta.F90
r20 r30 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 -
/trunk/NEMO/OPA_SRC/OBC/obcini.F90
r20 r30 1 1 MODULE obcini 2 #if defined key_obc3 2 !!================================================================================= 4 3 !! *** MODULE obcini *** 5 4 !! OBC initial state : Open boundary initial state 6 5 !!================================================================================= 7 6 #if defined key_obc 7 !!--------------------------------------------------------------------------------- 8 !! 'key_obc' Open Boundary Conditions 8 9 !!--------------------------------------------------------------------------------- 9 10 !! * Modules used … … 41 42 !! (t, s) over 2 time step and 2 rows 42 43 !! if ln_rstart = .FALSE. : no restart, fields set to zero 43 !! if ln_rstart = .TRUE. : restart, fields are read in file numrob44 !! if ln_rstart = .TRUE. : restart, fields are read in a file 44 45 !! if rdpxxx = 0 then lfbc is set true for this boundary. 45 46 !! 46 !! ** Input file : restart.obc : input restart file for open47 !! boundaries (unit file numrob)47 !! ** Input : restart.obc file, restart file for open boundaries 48 !! 48 49 !! History : 49 50 !! 8.0 ! 97-07 (G. Madec) Original code … … 52 53 !!---------------------------------------------------------------------- 53 54 !! * Modules used 54 USE obcrst, ONLY : obc_rst_lec 55 USE obcdom, ONLY : obc_dom 55 USE obcrst, ONLY : obc_rst_lec ! Make obc_rst_lec routine available 56 USE obcdom, ONLY : obc_dom ! Make obc_dom routine available 56 57 57 58 !! * Local declarations … … 62 63 63 64 NAMELIST/namobc/ rdpein, rdpwin, rdpnin, rdpsin, & 64 65 66 nbic, volemp65 & rdpeob, rdpwob, rdpnob, rdpsob, & 66 & zbsic1, zbsic2, zbsic3, & 67 & nbic, volemp, nobc_dta 67 68 !!---------------------------------------------------------------------- 68 69 … … 135 136 IF(lwp) WRITE(numout,*) ' namobc' 136 137 IF(lwp) WRITE(numout,*) ' ' 137 IF(lwp) WRITE(numout,*) ' data in file (=1) or nobc_dta = ', nobc_dta138 IF(lwp) WRITE(numout,*) ' data in file (=1) or nobc_dta = ', nobc_dta 138 139 IF(lwp) WRITE(numout,*) ' initial state used (=0) ' 139 140 IF( lwp.AND.lpeastobc ) THEN 140 141 WRITE(numout,*) ' East open boundary :' 141 WRITE(numout,*) ' i index jpieob = ', jpieob142 WRITE(numout,*) ' damping time scale (days) rdpeob = ', rdpeob143 WRITE(numout,*) ' damping time scale (days) rdpein = ', rdpein142 WRITE(numout,*) ' i index jpieob = ', jpieob 143 WRITE(numout,*) ' damping time scale (days) rdpeob = ', rdpeob 144 WRITE(numout,*) ' damping time scale (days) rdpein = ', rdpein 144 145 END IF 145 146 146 147 IF( lwp.AND.lpwestobc ) THEN 147 148 WRITE(numout,*) ' West open boundary :' 148 WRITE(numout,*) ' i index jpiwob = ', jpiwob149 WRITE(numout,*) ' damping time scale (days) rdpwob = ', rdpwob150 WRITE(numout,*) ' damping time scale (days) rdpwin = ', rdpwin149 WRITE(numout,*) ' i index jpiwob = ', jpiwob 150 WRITE(numout,*) ' damping time scale (days) rdpwob = ', rdpwob 151 WRITE(numout,*) ' damping time scale (days) rdpwin = ', rdpwin 151 152 END IF 152 153 153 154 IF( lwp.AND.lpnorthobc ) THEN 154 155 WRITE(numout,*) ' North open boundary :' 155 WRITE(numout,*) ' j index jpjnob = ', jpjnob156 WRITE(numout,*) ' damping time scale (days) rdpnob = ', rdpnob157 WRITE(numout,*) ' damping time scale (days) rdpnin = ', rdpnin156 WRITE(numout,*) ' j index jpjnob = ', jpjnob 157 WRITE(numout,*) ' damping time scale (days) rdpnob = ', rdpnob 158 WRITE(numout,*) ' damping time scale (days) rdpnin = ', rdpnin 158 159 END IF 159 160 160 161 IF( lwp.AND.lpsouthobc ) THEN 161 162 WRITE(numout,*) ' South open boundary :' 162 WRITE(numout,*) ' j index jpjsob = ', jpjsob163 WRITE(numout,*) ' damping time scale (days) rdpsob = ', rdpsob164 WRITE(numout,*) ' damping time scale (days) rdpsin = ', rdpsin163 WRITE(numout,*) ' j index jpjsob = ', jpjsob 164 WRITE(numout,*) ' damping time scale (days) rdpsob = ', rdpsob 165 WRITE(numout,*) ' damping time scale (days) rdpsin = ', rdpsin 165 166 WRITE(numout,*) ' ' 166 167 END IF … … 537 538 END DO 538 539 END IF 539 540 # if defined key_mpp 541 CALL mpp_sum( obcsurftot ) 542 # endif 540 IF( lk_mpp ) CALL mpp_sum( obcsurftot ) ! sum over the global domain 543 541 544 542 # endif … … 566 564 IF( (njw1 + njmpp - 1) == jpjwf ) ztestmask(2)=ztestmask(2)+ tmask(ji,njw1,1) 567 565 END DO 568 # if defined key_mpp 569 CALL mpp_sum( ztestmask, 2 ) 570 # endif 566 IF( lk_mpp ) CALL mpp_sum( ztestmask, 2 ) ! sum over the global domain 567 571 568 IF( ztestmask(1) /= 0. ) icorner(1)=icorner(1)+1 572 569 IF( ztestmask(2) /= 0. ) icorner(4)=icorner(4)+1 … … 587 584 IF( (nje1 + njmpp - 1) == jpjef ) ztestmask(2)=ztestmask(2)+ tmask(ji,nje1,1) 588 585 END DO 589 # if defined key_mpp 590 CALL mpp_sum( ztestmask, 2 ) 591 # endif 586 IF( lk_mpp ) CALL mpp_sum( ztestmask, 2 ) ! sum over the global domain 587 592 588 IF( ztestmask(1) /= 0. ) icorner(2)=icorner(2)+1 593 589 IF( ztestmask(2) /= 0. ) icorner(3)=icorner(3)+1 … … 608 604 IF( (nin1 + nimpp - 1) == jpinf ) ztestmask(2)=ztestmask(2)+ tmask(nin1,jj,1) 609 605 END DO 610 # if defined key_mpp 611 CALL mpp_sum( ztestmask, 2 ) 612 # endif 606 IF( lk_mpp ) CALL mpp_sum( ztestmask, 2 ) ! sum over the global domain 607 613 608 IF( ztestmask(1) /= 0. ) icorner(4)=icorner(4)+1 614 609 IF( ztestmask(2) /= 0. ) icorner(3)=icorner(3)+1 … … 629 624 IF( (nis1 + nimpp - 1) == jpisf ) ztestmask(2)=ztestmask(2)+ tmask(nis1,jj,1) 630 625 END DO 631 # if defined key_mpp 632 CALL mpp_sum( ztestmask, 2 ) 633 # endif 626 IF( lk_mpp ) CALL mpp_sum( ztestmask, 2 ) ! sum over the global domain 627 634 628 IF( ztestmask(1) /= 0. ) icorner(1)=icorner(1)+1 635 629 IF( ztestmask(2) /= 0. ) icorner(2)=icorner(2)+1 … … 695 689 ! -------------------------------------------------------------- 696 690 697 ! ... Restart from numrob691 ! ... Restart from restart.obc 698 692 IF( ln_rstart ) THEN 699 693 CALL obc_rst_lec … … 703 697 ! Those have dimensions of local subdomains 704 698 705 bebnd(:,:,:) = 0.e0 706 uebnd(:,:,:,:) = 0.e0 707 vebnd(:,:,:,:) = 0.e0 708 tebnd(:,:,:,:) = 0.e0 709 sebnd(:,:,:,:) = 0.e0 710 711 bwbnd(:,:,:) = 0.e0 712 uwbnd(:,:,:,:) = 0.e0 713 vwbnd(:,:,:,:) = 0.e0 714 twbnd(:,:,:,:) = 0.e0 715 swbnd(:,:,:,:) = 0.e0 716 717 bnbnd(:,:,:) = 0.e0 718 unbnd(:,:,:,:) = 0.e0 719 vnbnd(:,:,:,:) = 0.e0 720 tnbnd(:,:,:,:) = 0.e0 721 snbnd(:,:,:,:) = 0.e0 722 723 bsbnd(:,:,:) = 0.e0 724 usbnd(:,:,:,:) = 0.e0 725 vsbnd(:,:,:,:) = 0.e0 726 tsbnd(:,:,:,:) = 0.e0 727 ssbnd(:,:,:,:) = 0.e0 699 bebnd(:,:,:) = 0.e0 ; bnbnd(:,:,:) = 0.e0 700 uebnd(:,:,:,:) = 0.e0 ; unbnd(:,:,:,:) = 0.e0 701 vebnd(:,:,:,:) = 0.e0 ; vnbnd(:,:,:,:) = 0.e0 702 tebnd(:,:,:,:) = 0.e0 ; tnbnd(:,:,:,:) = 0.e0 703 sebnd(:,:,:,:) = 0.e0 ; snbnd(:,:,:,:) = 0.e0 704 705 bwbnd(:,:,:) = 0.e0 ; bsbnd(:,:,:) = 0.e0 706 uwbnd(:,:,:,:) = 0.e0 ; usbnd(:,:,:,:) = 0.e0 707 vwbnd(:,:,:,:) = 0.e0 ; vsbnd(:,:,:,:) = 0.e0 708 twbnd(:,:,:,:) = 0.e0 ; tsbnd(:,:,:,:) = 0.e0 709 swbnd(:,:,:,:) = 0.e0 ; ssbnd(:,:,:,:) = 0.e0 728 710 729 711 END IF … … 744 726 istop = istop + 1 745 727 END IF 746 # if defined key_mpp 747 ! ... 748 IF( nimpp > jpieob-5) THEN 749 IF(lwp) WRITE(numout,cform_err) 750 IF(lwp) WRITE(numout,*) ' A sub-domain is too close to the East OBC' 751 IF(lwp) WRITE(numout,*) ' nimpp must be < jpieob-5' 752 istop = istop + 1 753 END IF 754 # else 755 IF( tmask(jpieob+1,jpjed ,1) /= 0. .OR. & 756 tmask(jpieob+1,jpjed+1,1) /= 1. ) THEN 757 IF(lwp) WRITE(numout,cform_err) 758 IF(lwp) WRITE(numout,*) ' starting point is not a land T-point.' 759 IF(lwp) WRITE(numout,*) ' or starting point + 1 is not a ocean T-point.' 760 istop = istop + 1 761 END IF 762 IF( tmask(jpieob+1,jpjef ,1) /= 0. .OR. & 763 tmask(jpieob+1,jpjef-1,1) /= 1. ) THEN 764 IF(lwp) WRITE(numout,cform_err) 765 IF(lwp) WRITE(numout,*) ' ending point is not a land T-point.' 766 IF(lwp) WRITE(numout,*) ' or ending point - 1 is not a ocean T-point.' 767 istop = istop + 1 768 END IF 769 770 ! ... stop if e r r o r (s) detected 771 IF( istop /= 0 ) THEN 772 IF(lwp)WRITE(numout,*) 773 IF(lwp)WRITE(numout,*) istop,' E R R O R (S) detected : stop' 774 IF(lwp)WRITE(numout,*) ' =============== ' 775 IF(lwp)WRITE(numout,*) 776 nstop = nstop + 1 777 END IF 778 # endif 779 END IF 728 729 IF( lk_mpp ) THEN 730 ! ... 731 IF( nimpp > jpieob-5) THEN 732 IF(lwp) WRITE(numout,cform_err) 733 IF(lwp) WRITE(numout,*) ' A sub-domain is too close to the East OBC' 734 IF(lwp) WRITE(numout,*) ' nimpp must be < jpieob-5' 735 istop = istop + 1 736 ENDIF 737 ELSE 738 IF( tmask(jpieob+1,jpjed ,1) /= 0. .OR. & 739 tmask(jpieob+1,jpjed+1,1) /= 1. ) THEN 740 IF(lwp) WRITE(numout,cform_err) 741 IF(lwp) WRITE(numout,*) ' starting point is not a land T-point.' 742 IF(lwp) WRITE(numout,*) ' or starting point + 1 is not a ocean T-point.' 743 istop = istop + 1 744 END IF 745 IF( tmask(jpieob+1,jpjef ,1) /= 0. .OR. & 746 tmask(jpieob+1,jpjef-1,1) /= 1. ) THEN 747 IF(lwp) WRITE(numout,cform_err) 748 IF(lwp) WRITE(numout,*) ' ending point is not a land T-point.' 749 IF(lwp) WRITE(numout,*) ' or ending point - 1 is not a ocean T-point.' 750 istop = istop + 1 751 END IF 752 753 ! ... stop if e r r o r (s) detected 754 IF( istop /= 0 ) THEN 755 IF(lwp)WRITE(numout,*) 756 IF(lwp)WRITE(numout,*) istop,' E R R O R (S) detected : stop' 757 IF(lwp)WRITE(numout,*) ' =============== ' 758 IF(lwp)WRITE(numout,*) 759 nstop = nstop + 1 760 ENDIF 761 ENDIF 762 ENDIF 780 763 781 764 ! ... control of the west boundary … … 787 770 istop = istop + 1 788 771 END IF 789 # if defined key_mpp 790 ! ...791 IF( (nimpp < jpiwob+5) .AND. (nimpp > 1) ) THEN792 IF(lwp) WRITE(numout,cform_err)793 IF(lwp) WRITE(numout,*) ' A sub-domain is too close to the West OBC'794 IF(lwp) WRITE(numout,*) ' nimpp must be > jpiwob-5 or =1'795 istop = istop + 1796 ENDIF797 # else 798 IF( tmask(jpiwob,jpjwd ,1) /= 0. .OR. &799 tmask(jpiwob,jpjwd+1,1) /= 1. ) THEN800 IF(lwp) WRITE(numout,cform_err)801 IF(lwp) WRITE(numout,*) ' starting point is not a land T-point.'802 IF(lwp) WRITE(numout,*) ' or starting point + 1 is not a ocean T-point.'803 istop = istop + 1804 END IF805 IF ( tmask(jpieob+1,jpjef ,1) /= 0. .OR. &806 tmask(jpieob+1,jpjef-1,1) /= 1. ) THEN807 IF(lwp) WRITE(numout,cform_err)808 IF(lwp) WRITE(numout,*) ' ending point is not a land T-point.'809 IF(lwp) WRITE(numout,*) ' or ending point - 1 is not a ocean T-point.'810 istop = istop + 1811 END IF812 813 ! ... stop if e r r o r (s) detected814 IF( istop /= 0 ) THEN815 IF(lwp)WRITE(numout,*)816 IF(lwp)WRITE(numout,*) istop,' E R R O R (S) detected : stop'817 IF(lwp)WRITE(numout,*) ' =============== '818 IF(lwp)WRITE(numout,*)819 nstop = nstop + 1820 ENDIF821 # endif 822 END 772 773 IF( lk_mpp ) THEN 774 IF( (nimpp < jpiwob+5) .AND. (nimpp > 1) ) THEN 775 IF(lwp) WRITE(numout,cform_err) 776 IF(lwp) WRITE(numout,*) ' A sub-domain is too close to the West OBC' 777 IF(lwp) WRITE(numout,*) ' nimpp must be > jpiwob-5 or =1' 778 istop = istop + 1 779 ENDIF 780 ELSE 781 IF( tmask(jpiwob,jpjwd ,1) /= 0. .OR. & 782 tmask(jpiwob,jpjwd+1,1) /= 1. ) THEN 783 IF(lwp) WRITE(numout,cform_err) 784 IF(lwp) WRITE(numout,*) ' starting point is not a land T-point.' 785 IF(lwp) WRITE(numout,*) ' or starting point + 1 is not a ocean T-point.' 786 istop = istop + 1 787 END IF 788 IF ( tmask(jpieob+1,jpjef ,1) /= 0. .OR. & 789 tmask(jpieob+1,jpjef-1,1) /= 1. ) THEN 790 IF(lwp) WRITE(numout,cform_err) 791 IF(lwp) WRITE(numout,*) ' ending point is not a land T-point.' 792 IF(lwp) WRITE(numout,*) ' or ending point - 1 is not a ocean T-point.' 793 istop = istop + 1 794 END IF 795 796 ! ... stop if e r r o r (s) detected 797 IF( istop /= 0 ) THEN 798 IF(lwp)WRITE(numout,*) 799 IF(lwp)WRITE(numout,*) istop,' E R R O R (S) detected : stop' 800 IF(lwp)WRITE(numout,*) ' =============== ' 801 IF(lwp)WRITE(numout,*) 802 nstop = nstop + 1 803 ENDIF 804 ENDIF 805 ENDIF 823 806 824 807 ! control of the north boundary … … 830 813 istop = istop + 1 831 814 END IF 832 # if defined key_mpp 833 ! ...834 IF( njmpp > jpjnob-5) THEN835 IF(lwp) WRITE(numout,cform_err)836 IF(lwp) WRITE(numout,*) ' A sub-domain is too close to the North OBC'837 IF(lwp) WRITE(numout,*) ' njmpp must be < jpjnob-5'838 istop = istop + 1839 ENDIF840 # else 841 IF( tmask(jpind , jpjnob+1,1) /= 0. .OR. &842 tmask(jpind+1, jpjnob+1,1) /= 1. ) THEN843 IF(lwp) WRITE(numout,cform_err)844 IF(lwp) WRITE(numout,*) ' starting point is not a land T-point.'845 IF(lwp) WRITE(numout,*) ' or starting point + 1 is not a ocean T-point.'846 istop = istop + 1847 END IF848 IF( tmask(jpinf ,jpjnob+1,1) /= 0. .OR. &849 tmask(jpinf-1,jpjnob+1,1) /= 1. ) THEN850 IF(lwp) WRITE(numout,cform_err)851 IF(lwp) WRITE(numout,*) ' ending point is not a land T-point.'852 IF(lwp) WRITE(numout,*) ' or ending point - 1 is not a ocean T-point.'853 istop = istop + 1854 END IF855 856 ! ... stop if e r r o r (s) detected857 IF( istop /= 0 ) THEN858 IF(lwp)WRITE(numout,*)859 IF(lwp)WRITE(numout,*) istop,' E R R O R (S) detected : stop'860 IF(lwp)WRITE(numout,*) ' =============== '861 IF(lwp)WRITE(numout,*)862 nstop = nstop + 1863 ENDIF864 # endif 865 END 815 816 IF( lk_mpp ) THEN 817 IF( njmpp > jpjnob-5) THEN 818 IF(lwp) WRITE(numout,cform_err) 819 IF(lwp) WRITE(numout,*) ' A sub-domain is too close to the North OBC' 820 IF(lwp) WRITE(numout,*) ' njmpp must be < jpjnob-5' 821 istop = istop + 1 822 ENDIF 823 ELSE 824 IF( tmask(jpind , jpjnob+1,1) /= 0. .OR. & 825 tmask(jpind+1, jpjnob+1,1) /= 1. ) THEN 826 IF(lwp) WRITE(numout,cform_err) 827 IF(lwp) WRITE(numout,*) ' starting point is not a land T-point.' 828 IF(lwp) WRITE(numout,*) ' or starting point + 1 is not a ocean T-point.' 829 istop = istop + 1 830 END IF 831 IF( tmask(jpinf ,jpjnob+1,1) /= 0. .OR. & 832 tmask(jpinf-1,jpjnob+1,1) /= 1. ) THEN 833 IF(lwp) WRITE(numout,cform_err) 834 IF(lwp) WRITE(numout,*) ' ending point is not a land T-point.' 835 IF(lwp) WRITE(numout,*) ' or ending point - 1 is not a ocean T-point.' 836 istop = istop + 1 837 END IF 838 839 ! ... stop if e r r o r (s) detected 840 IF( istop /= 0 ) THEN 841 IF(lwp)WRITE(numout,*) 842 IF(lwp)WRITE(numout,*) istop,' E R R O R (S) detected : stop' 843 IF(lwp)WRITE(numout,*) ' =============== ' 844 IF(lwp)WRITE(numout,*) 845 nstop = nstop + 1 846 ENDIF 847 ENDIF 848 ENDIF 866 849 867 850 ! control of the south boundary … … 873 856 istop = istop + 1 874 857 END IF 875 # if defined key_mpp 876 ! ...877 IF( (njmpp < jpjsob+5) .AND. (njmpp > 1) ) THEN878 IF(lwp) WRITE(numout,cform_err)879 IF(lwp) WRITE(numout,*) ' A sub-domain is too close to the South OBC'880 IF(lwp) WRITE(numout,*) ' njmpp must be > jpjsob+5 or =1'881 istop = istop + 1882 ENDIF883 # else 884 IF( tmask(jpisd , jpjsob,1) /= 0. .OR. &885 tmask(jpisd+1, jpjsob,1) /= 1. ) THEN886 IF(lwp) WRITE(numout,cform_err)887 IF(lwp) WRITE(numout,*) ' starting point is not a land T-point.'888 IF(lwp) WRITE(numout,*) ' or starting point + 1 is not a ocean T-point.'889 istop = istop + 1890 END IF891 IF( tmask(jpisf ,jpjsob,1) /= 0. .OR. &892 tmask(jpisf-1,jpjsob,1) /= 1. ) THEN893 IF(lwp) WRITE(numout,cform_err)894 IF(lwp) WRITE(numout,*) ' ending point is not a land T-point.'895 IF(lwp) WRITE(numout,*) ' or ending point - 1 is not a ocean T-point.'896 istop = istop + 1897 END IF898 899 ! ... stop if e r r o r (s) detected900 IF( istop /= 0 ) THEN901 IF(lwp)WRITE(numout,*)902 IF(lwp)WRITE(numout,*) istop,' E R R O R (S) detected : stop'903 IF(lwp)WRITE(numout,*) ' =============== '904 IF(lwp)WRITE(numout,*)905 nstop = nstop + 1906 ENDIF907 # endif 908 END 858 859 IF( lk_mpp ) THEN 860 IF( (njmpp < jpjsob+5) .AND. (njmpp > 1) ) THEN 861 IF(lwp) WRITE(numout,cform_err) 862 IF(lwp) WRITE(numout,*) ' A sub-domain is too close to the South OBC' 863 IF(lwp) WRITE(numout,*) ' njmpp must be > jpjsob+5 or =1' 864 istop = istop + 1 865 ENDIF 866 ELSE 867 IF( tmask(jpisd , jpjsob,1) /= 0. .OR. & 868 tmask(jpisd+1, jpjsob,1) /= 1. ) THEN 869 IF(lwp) WRITE(numout,cform_err) 870 IF(lwp) WRITE(numout,*) ' starting point is not a land T-point.' 871 IF(lwp) WRITE(numout,*) ' or starting point + 1 is not a ocean T-point.' 872 istop = istop + 1 873 END IF 874 IF( tmask(jpisf ,jpjsob,1) /= 0. .OR. & 875 tmask(jpisf-1,jpjsob,1) /= 1. ) THEN 876 IF(lwp) WRITE(numout,cform_err) 877 IF(lwp) WRITE(numout,*) ' ending point is not a land T-point.' 878 IF(lwp) WRITE(numout,*) ' or ending point - 1 is not a ocean T-point.' 879 istop = istop + 1 880 END IF 881 882 ! ... stop if e r r o r (s) detected 883 IF( istop /= 0 ) THEN 884 IF(lwp)WRITE(numout,*) 885 IF(lwp)WRITE(numout,*) istop,' E R R O R (S) detected : stop' 886 IF(lwp)WRITE(numout,*) ' =============== ' 887 IF(lwp)WRITE(numout,*) 888 nstop = nstop + 1 889 ENDIF 890 ENDIF 891 ENDIF 909 892 910 893 END SUBROUTINE obc_init 894 911 895 #else 912 !!================================================================================= 913 !! *** MODULE obcini *** 914 !! OBC initial state : Open boundary initial state 915 !!================================================================================= 896 !!--------------------------------------------------------------------------------- 897 !! Dummy module NO open boundaries 898 !!--------------------------------------------------------------------------------- 916 899 CONTAINS 917 918 SUBROUTINE obc_init 919 ! This is not an Open boundary mode ==> empty routine 900 SUBROUTINE obc_init ! Dummy routine 920 901 END SUBROUTINE obc_init 921 902 #endif 922 903 904 !!================================================================================= 923 905 END MODULE obcini -
/trunk/NEMO/OPA_SRC/TRA/trabbl_adv.h90
r20 r30 71 71 zahu, zahv ! " " 72 72 REAL(wp), DIMENSION(jpi,jpj) :: & ! temporary workspace arrays 73 zalphax, zalphay, zwu, zwv,& ! " "74 z unb, zvnb, zind,& ! " "73 zalphax, zwu, zunb, & ! " " 74 zalphay, zwv, zvnb, & ! " " 75 75 zwx, zwy, zww, zwz ! " " 76 76 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 77 77 zhdivn ! temporary workspace arrays 78 78 REAL(wp) :: & 79 zfui, zfvj, zbt, zsigna, & ! temporary scalars 80 zcofi , zupsut, zupsus, & ! " " 81 zcofj , zupsvt, zupsvs, & ! " " 82 zcenut, zcenus, & ! " " 83 zcenvt, zcenvs ! " " 79 zfui, zfvj, zbt, zsigna ! temporary scalars 84 80 REAL(wp) :: & 85 fsalbt, pft, pfs, pfh, & ! statement function 86 fsx, fsy, pfx1, pfx2, & ! " " 87 pfu, pfv, pfy1, pfy2 ! " " 81 fsalbt, pft, pfs, pfh ! statement function 88 82 !!---------------------------------------------------------------------- 89 83 ! ratio alpha/beta … … 106 100 +( 0.791325e-08 * pft - 0.933746e-06 ) * pft & 107 101 + 0.380374e-04 ) * pfh 108 ! Up Stream Advection Scheme109 ! ==========================110 ! fsx: along i-direction111 ! fsy: along j-direction112 113 fsx( pfx1, pfx2, pfu ) = ( ( pfu + abs(pfu) ) * pfx1 &114 +( pfu - abs(pfu) ) * pfx2 ) * 0.5115 fsy( pfy1, pfy2, pfv ) = ( ( pfv + abs(pfv) ) * pfy1 &116 +( pfv - abs(pfv) ) * pfy2 ) * 0.5117 102 !!---------------------------------------------------------------------- 118 103 … … 142 127 #endif 143 128 END DO 144 # 145 j = 1129 #if defined key_vectopt_loop && ! defined key_autotasking 130 jj = 1 146 131 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 147 132 zunb(ji,jj) = un(ji,jj,mbku(ji,jj)) * umask(ji,jj,1) 148 133 zvnb(ji,jj) = vn(ji,jj,mbkv(ji,jj)) * vmask(ji,jj,1) ! retirer le mask en u, v et t ! 149 134 END DO 150 # 135 #else 151 136 DO jj = 1, jpjm1 152 137 DO ji = 1, jpim1 … … 178 163 zahu(ji,jj) = atrbbl*e2u(ji,jj)*fse3u(ji,jj,iku)/e1u(ji,jj) * umask(ji,jj,1) 179 164 zahv(ji,jj) = atrbbl*e1v(ji,jj)*fse3v(ji,jj,ikv)/e2v(ji,jj) * vmask(ji,jj,1) 180 # if ! defined key_vectopt_loop || defined key_autotasking181 END DO 182 # endif165 # if ! defined key_vectopt_loop || defined key_autotasking 166 END DO 167 # endif 183 168 END DO 184 169 #endif … … 259 244 END SELECT 260 245 261 262 246 ! lateral boundary conditions on zalphax and zalphay (unchanged sign) 263 247 CALL lbc_lnk( zalphax, 'U', 1. ) ; CALL lbc_lnk( zalphay, 'V', 1. ) 264 #endif 248 265 249 266 250 ! 3. Velocities that are exchanged between ajacent bottom boxes. … … 288 272 END DO 289 273 290 ! lateral boundary conditions on u zbbl and vzbbl (changed sign)291 CALL lbc_lnk( u zbbl, 'U', -1. ) ; CALL lbc_lnk( vzbbl, 'V', -1. )274 ! lateral boundary conditions on u_bbl and v_bbl (changed sign) 275 CALL lbc_lnk( u_bbl, 'U', -1. ) ; CALL lbc_lnk( v_bbl, 'V', -1. ) 292 276 293 277 … … 384 368 ! zwz(ji,jj) = 0.5* zfvj * ( zsnb(ji,jj) + zsnb(ji,jj+1) ) 385 369 ! upstream scheme 386 zwx(ji,jj) = fsx(ztbb(ji,jj),ztbb(ji+1,jj),zfui) 387 zwy(ji,jj) = fsy(ztbb(ji,jj),ztbb(ji,jj+1),zfvj) 388 zww(ji,jj) = fsx(zsbb(ji,jj),zsbb(ji+1,jj),zfui) 389 zwz(ji,jj) = fsy(zsbb(ji,jj),zsbb(ji,jj+1),zfvj) 370 zwx(ji,jj) = ( ( zfui + ABS( zfui ) ) * ztbb(ji ,jj ) & 371 & +( zfui - ABS( zfui ) ) * ztbb(ji+1,jj ) ) * 0.5 372 zwy(ji,jj) = ( ( zfui + ABS( zfvj ) ) * ztbb(ji ,jj ) & 373 & +( zfui - ABS( zfvj ) ) * ztbb(ji ,jj+1) ) * 0.5 374 zww(ji,jj) = ( ( zfui + ABS( zfui ) ) * zsbb(ji ,jj ) & 375 & +( zfui - ABS( zfui ) ) * zsbb(ji+1,jj ) ) * 0.5 376 zwz(ji,jj) = ( ( zfui + ABS( zfvj ) ) * zsbb(ji ,jj ) & 377 & +( zfui - ABS( zfvj ) ) * zsbb(ji ,jj+1) ) * 0.5 390 378 #if ! defined key_vectopt_loop || defined key_autotasking 391 379 END DO -
/trunk/NEMO/OPA_SRC/TRA/traldf_iso_zps.F90
r20 r30 4 4 !! Ocean active tracers: horizontal component of the lateral tracer mixing trend 5 5 !!============================================================================== 6 #if defined key_ldfslp|| defined key_esopa6 #if ( defined key_ldfslp && defined key_partial_steps ) || defined key_esopa 7 7 !!---------------------------------------------------------------------- 8 8 !! 'key_ldfslp' slope of the lateral diffusive direction … … 289 289 CONTAINS 290 290 SUBROUTINE tra_ldf_iso_zps( kt ) ! Empty routine 291 WRITE(*,*) kt291 WRITE(*,*) 'tra_ldf_iso_zps: You should not have seen this print! error?', kt 292 292 END SUBROUTINE tra_ldf_iso_zps 293 293 #endif
Note: See TracChangeset
for help on using the changeset viewer.
