Changeset 11082 for NEMO/branches/UKMO/NEMO_4.0_GO8_package/src/OCE
- Timestamp:
- 2019-06-06T16:21:52+02:00 (5 years ago)
- Location:
- NEMO/branches/UKMO/NEMO_4.0_GO8_package/src/OCE
- Files:
-
- 10 edited
-
BDY/bdy_oce.F90 (modified) (1 diff)
-
BDY/bdydta.F90 (modified) (4 diffs)
-
BDY/bdydyn2d.F90 (modified) (2 diffs)
-
BDY/bdyice.F90 (modified) (5 diffs)
-
BDY/bdyini.F90 (modified) (7 diffs)
-
DIA/diacfl.F90 (modified) (5 diffs)
-
DYN/dynkeg.F90 (modified) (4 diffs)
-
DYN/sshwzv.F90 (modified) (3 diffs)
-
LBC/lib_mpp.F90 (modified) (2 diffs)
-
ZDF/zdfphy.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO_4.0_GO8_package/src/OCE/BDY/bdy_oce.F90
r10888 r11082 85 85 ! 86 86 INTEGER :: nb_bdy !: number of open boundary sets 87 INTEGER 87 INTEGER, DIMENSION(jp_bdy) :: nb_jpk_bdy !: number of levels in the bdy data (set < 0 if consistent with planned run) 88 88 INTEGER, DIMENSION(jp_bdy) :: nn_rimwidth !: boundary rim width for Flow Relaxation Scheme 89 89 INTEGER :: nn_volctl !: = 0 the total volume will have the variability of the surface Flux E-P -
NEMO/branches/UKMO/NEMO_4.0_GO8_package/src/OCE/BDY/bdydta.F90
r10888 r11082 243 243 IF( ln_full_vel_array(jbdy) ) THEN 244 244 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend), & 245 & kit=jit, kt_offset=time_offset , jpk_bdy=nb_jpk_bdy , &245 & kit=jit, kt_offset=time_offset , jpk_bdy=nb_jpk_bdy(jbdy), & 246 246 & fvl=ln_full_vel_array(jbdy) ) 247 247 ELSE … … 313 313 jend = jstart + dta%nread(1) - 1 314 314 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), & 315 & map=nbmap_ptr(jstart:jend), kt_offset=time_offset, jpk_bdy=nb_jpk_bdy , &315 & map=nbmap_ptr(jstart:jend), kt_offset=time_offset, jpk_bdy=nb_jpk_bdy(jbdy), & 316 316 & fvl=ln_full_vel_array(jbdy) ) 317 317 ENDIF … … 446 446 NAMELIST/nambdy_dta/ bn_a_i, bn_h_i, bn_h_s 447 447 #endif 448 NAMELIST/nambdy_dta/ ln_full_vel , nb_jpk_bdy448 NAMELIST/nambdy_dta/ ln_full_vel 449 449 !!--------------------------------------------------------------------------- 450 450 ! … … 508 508 ! Read namelists 509 509 ! -------------- 510 REWIND(numnam_ref)511 510 REWIND(numnam_cfg) 512 511 jfld = 0 513 512 DO jbdy = 1, nb_bdy 514 513 IF( nn_dta(jbdy) == 1 ) THEN 514 REWIND(numnam_ref) 515 515 READ ( numnam_ref, nambdy_dta, IOSTAT = ios, ERR = 901) 516 516 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_dta in reference namelist', lwp ) -
NEMO/branches/UKMO/NEMO_4.0_GO8_package/src/OCE/BDY/bdydyn2d.F90
r10888 r11082 187 187 ! Use characteristics method instead 188 188 zflag = ABS(flagu) 189 zforc = dta%u2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pua2d(ii m1,ij)189 zforc = dta%u2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pua2d(ii+NINT(flagu),ij) 190 190 pua2d(ii,ij) = zforc + (1._wp - z1_2*zflag) * zcorr * umask(ii,ij,1) 191 191 END DO … … 205 205 ! Use characteristics method instead 206 206 zflag = ABS(flagv) 207 zforc = dta%v2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pva2d(ii,ij m1)207 zforc = dta%v2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pva2d(ii,ij+NINT(flagv)) 208 208 pva2d(ii,ij) = zforc + (1._wp - z1_2*zflag) * zcorr * vmask(ii,ij,1) 209 209 END DO -
NEMO/branches/UKMO/NEMO_4.0_GO8_package/src/OCE/BDY/bdyice.F90
r10888 r11082 57 57 INTEGER :: jbdy ! BDY set index 58 58 !!---------------------------------------------------------------------- 59 ! 60 IF( ln_timing ) CALL timing_start('bdy_ice_thd') 59 ! controls 60 IF( ln_timing ) CALL timing_start('bdy_ice_thd') ! timing 61 IF( ln_icediachk ) CALL ice_cons_hsm(0,'bdy_ice_thd', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 61 62 ! 62 63 CALL ice_var_glo2eqv … … 78 79 CALL ice_var_agg(1) 79 80 ! 80 IF( ln_icectl ) CALL ice_prt( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' ) 81 IF( ln_timing ) CALL timing_stop('bdy_ice_thd') 81 ! controls 82 IF( ln_icediachk ) CALL ice_cons_hsm(1,'bdy_ice_thd', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 83 IF( ln_icectl ) CALL ice_prt ( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' ) ! prints 84 IF( ln_timing ) CALL timing_stop ('bdy_ice_thd') ! timing 82 85 ! 83 86 END SUBROUTINE bdy_ice … … 148 151 jpbound = 0 ; ib = ji ; jb = jj 149 152 ! 150 IF( u_ice(ji +1,jj ) < 0. .AND. umask(ji-1,jj ,1) == 0. ) jpbound = 1 ; ib = ji+1 ; jb = jj151 IF( u_ice(ji-1,jj ) > 0. .AND. umask(ji +1,jj ,1) == 0. ) jpbound = 1 ; ib = ji-1 ; jb = jj152 IF( v_ice(ji ,jj +1) < 0. .AND. vmask(ji ,jj-1,1) == 0. ) jpbound = 1 ; ib = ji; jb = jj+1153 IF( v_ice(ji ,jj-1) > 0. .AND. vmask(ji ,jj +1,1) == 0. ) jpbound = 1 ; ib = ji; jb = jj-1153 IF( u_ice(ji ,jj ) < 0. .AND. umask(ji-1,jj ,1) == 0. ) jpbound = 1 ; ib = ji+1 154 IF( u_ice(ji-1,jj ) > 0. .AND. umask(ji ,jj ,1) == 0. ) jpbound = 1 ; ib = ji-1 155 IF( v_ice(ji ,jj ) < 0. .AND. vmask(ji ,jj-1,1) == 0. ) jpbound = 1 ; jb = jj+1 156 IF( v_ice(ji ,jj-1) > 0. .AND. vmask(ji ,jj ,1) == 0. ) jpbound = 1 ; jb = jj-1 154 157 ! 155 158 IF( nn_ice_dta(jbdy) == 0 ) jpbound = 0 ; ib = ji ; jb = jj ! case ice boundaries = initial conditions … … 306 309 ! one of the two zmsk is always 0 (because of zflag) 307 310 zmsk1 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji+1,jj) ) ) ! 0 if no ice 308 zmsk2 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji -1,jj) ) )! 0 if no ice311 zmsk2 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj) ) ) ! 0 if no ice 309 312 ! 310 313 ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then do not change u_ice) … … 329 332 ! one of the two zmsk is always 0 (because of zflag) 330 333 zmsk1 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj+1) ) ) ! 0 if no ice 331 zmsk2 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj -1) ) )! 0 if no ice334 zmsk2 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj) ) ) ! 0 if no ice 332 335 ! 333 336 ! v_ice = v_ice of the adjacent grid point except if this grid point is ice-free (then do not change v_ice) -
NEMO/branches/UKMO/NEMO_4.0_GO8_package/src/OCE/BDY/bdyini.F90
r10888 r11082 140 140 INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: nbrdta ! Discrete distance from rim points 141 141 CHARACTER(LEN=1),DIMENSION(jpbgrd) :: cgrid 142 INTEGER :: com_east, com_west, com_south, com_north 142 INTEGER :: com_east, com_west, com_south, com_north, jpk_max ! Flags for boundaries sending 143 143 INTEGER :: com_east_b, com_west_b, com_south_b, com_north_b ! Flags for boundaries receiving 144 144 INTEGER :: iw_b(4), ie_b(4), is_b(4), in_b(4) ! Arrays for neighbours coordinates … … 397 397 IF(lwp) WRITE(numout,*) 398 398 ENDIF 399 IF( nb_jpk_bdy > 0 ) THEN399 IF( nb_jpk_bdy(ib_bdy) > 0 ) THEN 400 400 IF(lwp) WRITE(numout,*) '*** open boundary will be interpolate in the vertical onto the native grid ***' 401 401 ELSE … … 516 516 ALLOCATE( nbidta(jpbdta, jpbgrd, nb_bdy), nbjdta(jpbdta, jpbgrd, nb_bdy), & 517 517 & nbrdta(jpbdta, jpbgrd, nb_bdy) ) 518 519 IF( nb_jpk_bdy>0 ) THEN 520 ALLOCATE( dta_global(jpbdtau, 1, nb_jpk_bdy) ) 521 ALLOCATE( dta_global_z(jpbdtau, 1, nb_jpk_bdy) ) 522 ALLOCATE( dta_global_dz(jpbdtau, 1, nb_jpk_bdy) ) 523 ELSE 524 ALLOCATE( dta_global(jpbdtau, 1, jpk) ) 525 ALLOCATE( dta_global_z(jpbdtau, 1, jpk) ) ! needed ?? TODO 526 ALLOCATE( dta_global_dz(jpbdtau, 1, jpk) )! needed ?? TODO 527 ENDIF 518 519 jpk_max = MAXVAL(nb_jpk_bdy) 520 jpk_max = MAX(jpk_max, jpk) 521 522 ALLOCATE( dta_global(jpbdtau, 1, jpk_max) ) 523 ALLOCATE( dta_global_z(jpbdtau, 1, jpk_max) ) ! needed ?? TODO 524 ALLOCATE( dta_global_dz(jpbdtau, 1, jpk_max) )! needed ?? TODO 528 525 529 526 IF ( icount>0 ) THEN 530 IF( nb_jpk_bdy>0 ) THEN 531 ALLOCATE( dta_global2(jpbdtas, nrimmax, nb_jpk_bdy) ) 532 ALLOCATE( dta_global2_z(jpbdtas, nrimmax, nb_jpk_bdy) ) 533 ALLOCATE( dta_global2_dz(jpbdtas, nrimmax, nb_jpk_bdy) ) 534 ELSE 535 ALLOCATE( dta_global2(jpbdtas, nrimmax, jpk) ) 536 ALLOCATE( dta_global2_z(jpbdtas, nrimmax, jpk) ) ! needed ?? TODO 537 ALLOCATE( dta_global2_dz(jpbdtas, nrimmax, jpk) )! needed ?? TODO 538 ENDIF 527 ALLOCATE( dta_global2(jpbdtas, nrimmax, jpk_max) ) 528 ALLOCATE( dta_global2_z(jpbdtas, nrimmax, jpk_max) ) ! needed ?? TODO 529 ALLOCATE( dta_global2_dz(jpbdtas, nrimmax, jpk_max) )! needed ?? TODO 539 530 ENDIF 540 531 ! … … 960 951 & nbrdta(ib,igrd,ib_bdy) == ir ) THEN 961 952 ii = nbidta(ib,igrd,ib_bdy)- iw_b(1)+2 962 if( (com_west_b .ne. 1) .and. (ii == (nlcit(nowe+1)-1))) then953 if( ii == (nlcit(nowe+1)-1) ) then 963 954 ij = nbjdta(ib,igrd,ib_bdy) - is_b(1)+2 964 955 if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then … … 974 965 & nbrdta(ib,igrd,ib_bdy) == ir ) THEN 975 966 ii = nbidta(ib,igrd,ib_bdy)- iw_b(2)+2 976 if( (com_east_b .ne. 1) .and. (ii == 2)) then967 if( ii == 2 ) then 977 968 ij = nbjdta(ib,igrd,ib_bdy) - is_b(2)+2 978 969 if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then … … 989 980 & nbrdta(ib,igrd,ib_bdy) == ir ) THEN 990 981 ii = nbidta(ib,igrd,ib_bdy)- iw_b(1)+2 991 if( (com_west_b .ne. 1) .and. (ii == (nlcit(nowe+1)-1))) then982 if( ii == (nlcit(nowe+1)-1) ) then 992 983 ij = nbjdta(ib,igrd,ib_bdy) - is_b(1)+2 993 984 if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then … … 1004 995 & nbrdta(ib,igrd,ib_bdy) == ir ) THEN 1005 996 ii = nbidta(ib,igrd,ib_bdy)- iw_b(2)+2 1006 if( (com_east_b .ne. 1) .and. (ii == 2)) then997 if( ii == 2 ) then 1007 998 ij = nbjdta(ib,igrd,ib_bdy) - is_b(2)+2 1008 999 if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then -
NEMO/branches/UKMO/NEMO_4.0_GO8_package/src/OCE/DIA/diacfl.F90
r10888 r11082 29 29 REAL(wp) :: rCu_max, rCv_max, rCw_max ! associated run max Courant number 30 30 31 !!gm CAUTION: need to declare these arrays here, otherwise the calculation fails in multi-proc !32 !!gm I don't understand why.33 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zCu_cfl, zCv_cfl, zCw_cfl ! workspace34 !!gm end35 36 31 PUBLIC dia_cfl ! routine called by step.F90 37 32 PUBLIC dia_cfl_init ! routine called by nemogcm … … 55 50 INTEGER, INTENT(in) :: kt ! ocean time-step index 56 51 ! 57 INTEGER :: ji, jj, jk! dummy loop indices58 REAL(wp) :: z2dt, zCu_max, zCv_max, zCw_max! local scalars59 INTEGER , DIMENSION(3) :: iloc_u , iloc_v , iloc_w , iloc! workspace60 !!gm this does not work REAL(wp), DIMENSION(jpi,jpj,jpk) :: zCu_cfl, zCv_cfl, zCw_cfl! workspace52 INTEGER :: ji, jj, jk ! dummy loop indices 53 REAL(wp) :: z2dt, zCu_max, zCv_max, zCw_max ! local scalars 54 INTEGER , DIMENSION(3) :: iloc_u , iloc_v , iloc_w , iloc ! workspace 55 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zCu_cfl, zCv_cfl, zCw_cfl ! workspace 61 56 !!---------------------------------------------------------------------- 62 57 ! … … 71 66 DO jk = 1, jpk ! calculate Courant numbers 72 67 DO jj = 1, jpj 73 DO ji = 1, fs_jpim1 ! vector opt.68 DO ji = 1, jpi 74 69 zCu_cfl(ji,jj,jk) = ABS( un(ji,jj,jk) ) * z2dt / e1u (ji,jj) ! for i-direction 75 70 zCv_cfl(ji,jj,jk) = ABS( vn(ji,jj,jk) ) * z2dt / e2v (ji,jj) ! for j-direction … … 111 106 ! ! write out to file 112 107 IF( lwp ) THEN 113 WRITE(numcfl,FMT='(2x,i 4,5x,a6,4x,f7.4,1x,i4,1x,i4,1x,i4)') kt, 'Max Cu', zCu_max, iloc_u(1), iloc_u(2), iloc_u(3)108 WRITE(numcfl,FMT='(2x,i6,3x,a6,4x,f7.4,1x,i4,1x,i4,1x,i4)') kt, 'Max Cu', zCu_max, iloc_u(1), iloc_u(2), iloc_u(3) 114 109 WRITE(numcfl,FMT='(11x, a6,4x,f7.4,1x,i4,1x,i4,1x,i4)') 'Max Cv', zCv_max, iloc_v(1), iloc_v(2), iloc_v(3) 115 110 WRITE(numcfl,FMT='(11x, a6,4x,f7.4,1x,i4,1x,i4,1x,i4)') 'Max Cw', zCw_max, iloc_w(1), iloc_w(2), iloc_w(3) … … 172 167 rCw_max = 0._wp 173 168 ! 174 !!gm required to work175 ALLOCATE ( zCu_cfl(jpi,jpj,jpk), zCv_cfl(jpi,jpj,jpk), zCw_cfl(jpi,jpj,jpk) )176 !!gm end177 !178 169 END SUBROUTINE dia_cfl_init 179 170 -
NEMO/branches/UKMO/NEMO_4.0_GO8_package/src/OCE/DYN/dynkeg.F90
r10888 r11082 74 74 INTEGER, INTENT( in ) :: kscheme ! =0/1 type of KEG scheme 75 75 ! 76 INTEGER :: ji, jj, jk, jb ! dummy loop indices 77 INTEGER :: ii, ifu, ib_bdy ! local integers 78 INTEGER :: ij, ifv, igrd ! - - 79 REAL(wp) :: zu, zv ! local scalars 76 INTEGER :: ji, jj, jk, jb ! dummy loop indices 77 INTEGER :: ifu, ifv, igrd, ib_bdy ! local integers 78 REAL(wp) :: zu, zv ! local scalars 80 79 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zhke 81 80 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdu, ztrdv 81 REAL(wp) :: zweightu, zweightv 82 82 !!---------------------------------------------------------------------- 83 83 ! … … 97 97 98 98 zhke(:,:,jpk) = 0._wp 99 100 IF (ln_bdy) THEN101 ! Maria Luneva & Fred Wobus: July-2016102 ! compensate for lack of turbulent kinetic energy on liquid bdy points103 DO ib_bdy = 1, nb_bdy104 IF( cn_dyn3d(ib_bdy) /= 'none' ) THEN105 igrd = 2 ! Copying normal velocity into points outside bdy106 DO jb = 1, idx_bdy(ib_bdy)%nblenrim(igrd)107 DO jk = 1, jpkm1108 ii = idx_bdy(ib_bdy)%nbi(jb,igrd)109 ij = idx_bdy(ib_bdy)%nbj(jb,igrd)110 ifu = NINT( idx_bdy(ib_bdy)%flagu(jb,igrd) )111 un(ii-ifu,ij,jk) = un(ii,ij,jk) * umask(ii,ij,jk)112 END DO113 END DO114 !115 igrd = 3 ! Copying normal velocity into points outside bdy116 DO jb = 1, idx_bdy(ib_bdy)%nblenrim(igrd)117 DO jk = 1, jpkm1118 ii = idx_bdy(ib_bdy)%nbi(jb,igrd)119 ij = idx_bdy(ib_bdy)%nbj(jb,igrd)120 ifv = NINT( idx_bdy(ib_bdy)%flagv(jb,igrd) )121 vn(ii,ij-ifv,jk) = vn(ii,ij,jk) * vmask(ii,ij,jk)122 END DO123 END DO124 ENDIF125 ENDDO126 ENDIF127 99 128 100 SELECT CASE ( kscheme ) !== Horizontal kinetic energy at T-point ==! … … 140 112 END DO 141 113 END DO 114 ! 115 IF (ln_bdy) THEN 116 ! Maria Luneva & Fred Wobus: July-2016 117 ! compensate for lack of turbulent kinetic energy on liquid bdy points 118 DO ib_bdy = 1, nb_bdy 119 IF( cn_dyn3d(ib_bdy) /= 'none' ) THEN 120 igrd = 1 ! compensating null velocity on the bdy 121 DO jb = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 122 ji = idx_bdy(ib_bdy)%nbi(jb,igrd) ! maximum extent : from 2 to jpi-1 123 jj = idx_bdy(ib_bdy)%nbj(jb,igrd) ! maximum extent : from 2 to jpj-1 124 DO jk = 1, jpkm1 125 zhke(ji,jj,jk) = 0._wp 126 zweightu = umask(ji-1,jj ,jk) + umask(ji,jj,jk) 127 zweightv = vmask(ji ,jj-1,jk) + vmask(ji,jj,jk) 128 zu = un(ji-1,jj ,jk) * un(ji-1,jj ,jk) + un(ji ,jj ,jk) * un(ji ,jj ,jk) 129 zv = vn(ji ,jj-1,jk) * vn(ji ,jj-1,jk) + vn(ji ,jj ,jk) * vn(ji ,jj ,jk) 130 IF( zweightu > 0._wp ) zhke(ji,jj,jk) = zhke(ji,jj,jk) + zu / (2._wp * zweightu) 131 IF( zweightv > 0._wp ) zhke(ji,jj,jk) = zhke(ji,jj,jk) + zv / (2._wp * zweightv) 132 END DO 133 END DO 134 END IF 135 CALL lbc_bdy_lnk( 'dynkeg', zhke, 'T', 1., ib_bdy ) ! send 2 and recv jpi, jpj used in the computation of the speed tendencies 136 END DO 137 END IF 142 138 ! 143 139 CASE ( nkeg_HW ) !-- Hollingsworth scheme --! … … 158 154 END DO 159 155 END DO 156 IF (ln_bdy) THEN 157 ! Maria Luneva & Fred Wobus: July-2016 158 ! compensate for lack of turbulent kinetic energy on liquid bdy points 159 DO ib_bdy = 1, nb_bdy 160 IF( cn_dyn3d(ib_bdy) /= 'none' ) THEN 161 igrd = 1 ! compensation null velocity on land at the bdy 162 DO jb = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 163 ji = idx_bdy(ib_bdy)%nbi(jb,igrd) ! maximum extent : from 2 to jpi-1 164 jj = idx_bdy(ib_bdy)%nbj(jb,igrd) ! maximum extent : from 2 to jpj-1 165 DO jk = 1, jpkm1 166 zhke(ji,jj,jk) = 0._wp 167 zweightu = 8._wp * ( umask(ji-1,jj ,jk) + umask(ji ,jj ,jk) ) & 168 & + 2._wp * ( umask(ji-1,jj-1,jk) + umask(ji-1,jj+1,jk) + umask(ji ,jj-1,jk) + umask(ji ,jj+1,jk) ) 169 zweightv = 8._wp * ( vmask(ji ,jj-1,jk) + vmask(ji ,jj-1,jk) ) & 170 & + 2._wp * ( vmask(ji-1,jj-1,jk) + vmask(ji+1,jj-1,jk) + vmask(ji-1,jj ,jk) + vmask(ji+1,jj ,jk) ) 171 zu = 8._wp * ( un(ji-1,jj ,jk) * un(ji-1,jj ,jk) & 172 & + un(ji ,jj ,jk) * un(ji ,jj ,jk) ) & 173 & + ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) ) * ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) ) & 174 & + ( un(ji ,jj-1,jk) + un(ji ,jj+1,jk) ) * ( un(ji ,jj-1,jk) + un(ji ,jj+1,jk) ) 175 zv = 8._wp * ( vn(ji ,jj-1,jk) * vn(ji ,jj-1,jk) & 176 & + vn(ji ,jj ,jk) * vn(ji ,jj ,jk) ) & 177 & + ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) ) * ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) ) & 178 & + ( vn(ji-1,jj ,jk) + vn(ji+1,jj ,jk) ) * ( vn(ji-1,jj ,jk) + vn(ji+1,jj ,jk) ) 179 IF( zweightu > 0._wp ) zhke(ji,jj,jk) = zhke(ji,jj,jk) + zu / ( 2._wp * zweightu ) 180 IF( zweightv > 0._wp ) zhke(ji,jj,jk) = zhke(ji,jj,jk) + zv / ( 2._wp * zweightv ) 181 END DO 182 END DO 183 END IF 184 END DO 185 END IF 160 186 CALL lbc_lnk( 'dynkeg', zhke, 'T', 1. ) 161 187 ! 162 END SELECT 163 164 IF (ln_bdy) THEN 165 ! restore velocity masks at points outside boundary 166 un(:,:,:) = un(:,:,:) * umask(:,:,:) 167 vn(:,:,:) = vn(:,:,:) * vmask(:,:,:) 168 ENDIF 169 188 END SELECT 170 189 ! 171 190 DO jk = 1, jpkm1 !== grad( KE ) added to the general momentum trends ==! -
NEMO/branches/UKMO/NEMO_4.0_GO8_package/src/OCE/DYN/sshwzv.F90
r10888 r11082 297 297 IF(lwp) WRITE(numout,*) 'wAimp : Courant number-based partitioning of now vertical velocity ' 298 298 IF(lwp) WRITE(numout,*) '~~~~~ ' 299 ! 300 Cu_adv(:,:,jpk) = 0._wp ! bottom value : Cu_adv=0 (set once for all) 301 ENDIF 299 ENDIF 300 ! 302 301 ! 303 302 DO jk = 1, jpkm1 ! calculate Courant numbers … … 305 304 DO ji = 2, fs_jpim1 ! vector opt. 306 305 z1_e3w = 1._wp / e3w_n(ji,jj,jk) 307 Cu_adv(ji,jj,jk) = r2dt * ( ( MAX( wn(ji,jj,jk) , 0._wp ) - MIN( wn(ji,jj,jk+1) , 0._wp ) ) &308 & + ( MAX( e2u(ji ,jj)*e3uw_n(ji ,jj,jk)*un(ji ,jj,jk), 0._wp ) - &309 & MIN( e2u(ji-1,jj)*e3uw_n(ji-1,jj,jk)*un(ji-1,jj,jk), 0._wp ) ) &310 & * r1_e1e2t(ji,jj) &311 & + ( MAX( e1v(ji,jj )*e3vw_n(ji,jj ,jk)*vn(ji,jj ,jk), 0._wp ) - &312 & MIN( e1v(ji,jj-1)*e3vw_n(ji,jj-1,jk)*vn(ji,jj-1,jk), 0._wp ) ) &313 & * r1_e1e2t(ji,jj) &314 & ) * z1_e3w306 Cu_adv(ji,jj,jk) = 2._wp * rdt * ( ( MAX( wn(ji,jj,jk) , 0._wp ) - MIN( wn(ji,jj,jk+1) , 0._wp ) ) & ! 2*rdt and not r2dt (for restartability) 307 & + ( MAX( e2u(ji ,jj)*e3uw_n(ji ,jj,jk)*un(ji ,jj,jk), 0._wp ) - & 308 & MIN( e2u(ji-1,jj)*e3uw_n(ji-1,jj,jk)*un(ji-1,jj,jk), 0._wp ) ) & 309 & * r1_e1e2t(ji,jj) & 310 & + ( MAX( e1v(ji,jj )*e3vw_n(ji,jj ,jk)*vn(ji,jj ,jk), 0._wp ) - & 311 & MIN( e1v(ji,jj-1)*e3vw_n(ji,jj-1,jk)*vn(ji,jj-1,jk), 0._wp ) ) & 312 & * r1_e1e2t(ji,jj) & 313 & ) * z1_e3w 315 314 END DO 316 315 END DO 317 316 END DO 317 CALL lbc_lnk( 'sshwzv', Cu_adv, 'T', 1. ) 318 318 ! 319 319 CALL iom_put("Courant",Cu_adv) 320 320 ! 321 wi(:,:,:) = 0._wp ! Includes top and bottom values set to zero322 321 IF( MAXVAL( Cu_adv(:,:,:) ) > Cu_min ) THEN ! Quick check if any breaches anywhere 323 322 DO jk = 1, jpkm1 ! or scan Courant criterion and partition 324 DO jj = 2, jpjm1! w where necessary325 DO ji = 2, fs_jpim1 ! vector opt.323 DO jj = 1, jpj ! w where necessary 324 DO ji = 1, jpi 326 325 ! 327 326 zCu = MAX( Cu_adv(ji,jj,jk) , Cu_adv(ji,jj,jk+1) ) 328 327 ! 329 IF( zCu < Cu_min ) THEN!<-- Fully explicit328 IF( zCu <= Cu_min ) THEN !<-- Fully explicit 330 329 zcff = 0._wp 331 330 ELSEIF( zCu < Cu_cut ) THEN !<-- Mixed explicit … … 346 345 ELSE 347 346 ! Fully explicit everywhere 348 Cu_adv = 0.0_wp ! Reuse array to output coefficient 347 Cu_adv(:,:,:) = 0._wp ! Reuse array to output coefficient 348 wi (:,:,:) = 0._wp 349 349 ENDIF 350 350 CALL iom_put("wimp",wi) -
NEMO/branches/UKMO/NEMO_4.0_GO8_package/src/OCE/LBC/lib_mpp.F90
r10888 r11082 1480 1480 LOGICAL , OPTIONAL, INTENT(in ) :: ld_lbc, ld_glb, ld_dlg 1481 1481 !! 1482 CHARACTER(len=128) :: ccountname ! name of a subroutine to count communications 1482 1483 LOGICAL :: ll_lbc, ll_glb, ll_dlg 1483 INTEGER :: ji, jj, jk, jh, jf ! dummy loop indices1484 INTEGER :: ji, jj, jk, jh, jf, jcount ! dummy loop indices 1484 1485 !!---------------------------------------------------------------------- 1485 1486 ! … … 1538 1539 WRITE(numcom,*) ' ' 1539 1540 WRITE(numcom,*) ' lbc_lnk called' 1540 jj = 1 1541 DO ji = 2, n_sequence_lbc 1542 IF( crname_lbc(ji-1) /= crname_lbc(ji) ) THEN 1543 WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_lbc(ji-1)) 1544 jj = 0 1541 DO ji = 1, n_sequence_lbc - 1 1542 IF ( crname_lbc(ji) /= 'already counted' ) THEN 1543 ccountname = crname_lbc(ji) 1544 crname_lbc(ji) = 'already counted' 1545 jcount = 1 1546 DO jj = ji + 1, n_sequence_lbc 1547 IF ( ccountname == crname_lbc(jj) ) THEN 1548 jcount = jcount + 1 1549 crname_lbc(jj) = 'already counted' 1550 END IF 1551 END DO 1552 WRITE(numcom,'(A, I4, A, A)') ' - ', jcount,' times by subroutine ', TRIM(ccountname) 1545 1553 END IF 1546 jj = jj + 11547 1554 END DO 1548 WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_lbc(n_sequence_lbc)) 1555 IF ( crname_lbc(n_sequence_lbc) /= 'already counted' ) THEN 1556 WRITE(numcom,'(A, I4, A, A)') ' - ', 1,' times by subroutine ', TRIM(crname_lbc(ncom_rec_max)) 1557 END IF 1549 1558 WRITE(numcom,*) ' ' 1550 1559 IF ( n_sequence_glb > 0 ) THEN -
NEMO/branches/UKMO/NEMO_4.0_GO8_package/src/OCE/ZDF/zdfphy.F90
r10888 r11082 132 132 IF( ln_zad_Aimp ) THEN 133 133 IF( zdf_phy_alloc() /= 0 ) & 134 & CALL ctl_stop( 'STOP', 'zdf_phy_init : unable to allocate adaptive-implicit z-advection arrays' ) 135 wi(:,:,:) = 0._wp 134 & CALL ctl_stop( 'STOP', 'zdf_phy_init : unable to allocate adaptive-implicit z-advection arrays' ) 135 Cu_adv(:,:,:) = 0._wp 136 wi (:,:,:) = 0._wp 136 137 ENDIF 137 138 ! !== Background eddy viscosity and diffusivity ==!
Note: See TracChangeset
for help on using the changeset viewer.
