Changeset 9977 for NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE
- Timestamp:
- 2018-07-20T10:24:45+02:00 (6 years ago)
- Location:
- NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE
- Files:
-
- 20 edited
-
BDY/bdydta.F90 (modified) (1 diff)
-
BDY/bdyice.F90 (modified) (12 diffs)
-
CRS/crsdom.F90 (modified) (2 diffs)
-
DIA/dia25h.F90 (modified) (1 diff)
-
DOM/domain.F90 (modified) (2 diffs)
-
DOM/domzgr.F90 (modified) (2 diffs)
-
IOM/iom.F90 (modified) (11 diffs)
-
IOM/restart.F90 (modified) (2 diffs)
-
LBC/lbclnk.F90 (modified) (1 diff)
-
LBC/lib_mpp.F90 (modified) (2 diffs)
-
LBC/mpp_nfd_generic.h90 (modified) (3 diffs)
-
LBC/mppini.F90 (modified) (2 diffs)
-
SBC/sbc_ice.F90 (modified) (2 diffs)
-
SBC/sbcblk.F90 (modified) (3 diffs)
-
SBC/sbccpl.F90 (modified) (2 diffs)
-
TRA/traadv_fct.F90 (modified) (2 diffs)
-
TRA/trabbl.F90 (modified) (1 diff)
-
USR/usrdef_zgr.F90 (modified) (1 diff)
-
stpctl.F90 (modified) (1 diff)
-
timing.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/BDY/bdydta.F90
r9892 r9977 351 351 ENDIF 352 352 #if defined key_si3 353 ! convert N-cat fields (input) into jpl-cat (output) 353 354 IF( cn_ice(jbdy) /= 'none' .AND. nn_ice_dta(jbdy) == 1 ) THEN 354 355 jfld_hti = jfld_htit(jbdy) 355 356 jfld_hts = jfld_htst(jbdy) 356 357 jfld_ai = jfld_ait(jbdy) 357 IF ( nice_cat == 1 ) THEN! case input cat = 1358 IF ( jpl /= 1 .AND. nice_cat == 1 ) THEN ! case input cat = 1 358 359 CALL ice_var_itd ( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), & 359 360 & dta_bdy(jbdy)%h_i , dta_bdy(jbdy)%h_s , dta_bdy(jbdy)%a_i ) 360 ELSEIF( nice_cat /= 1 .AND. nice_cat /= jpl ) THEN ! case input cat /=1 and /=jpl361 ELSEIF( jpl /= 1 .AND. nice_cat /= 1 .AND. nice_cat /= jpl ) THEN ! case input cat /=1 and /=jpl 361 362 CALL ice_var_itd2( bf(jfld_hti)%fnow(:,1,:), bf(jfld_hts)%fnow(:,1,:), bf(jfld_ai)%fnow(:,1,:), & 362 363 & dta_bdy(jbdy)%h_i , dta_bdy(jbdy)%h_s , dta_bdy(jbdy)%a_i ) -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/BDY/bdyice.F90
r9892 r9977 50 50 !! *** SUBROUTINE bdy_ice *** 51 51 !! 52 !! ** Purpose : - Apply open boundary conditions for ice (SI3)52 !! ** Purpose : Apply open boundary conditions for sea ice 53 53 !! 54 54 !!---------------------------------------------------------------------- 55 55 INTEGER, INTENT(in) :: kt ! Main time step counter 56 56 ! 57 INTEGER :: ib_bdy ! Loopindex57 INTEGER :: jbdy ! BDY set index 58 58 !!---------------------------------------------------------------------- 59 59 ! 60 IF( ln_timing ) CALL timing_start('bdy_ice ')60 IF( ln_timing ) CALL timing_start('bdy_ice_thd') 61 61 ! 62 62 CALL ice_var_glo2eqv 63 63 ! 64 DO ib_bdy = 1, nb_bdy65 ! 66 SELECT CASE( cn_ice( ib_bdy) )64 DO jbdy = 1, nb_bdy 65 ! 66 SELECT CASE( cn_ice(jbdy) ) 67 67 CASE('none') ; CYCLE 68 CASE('frs' ) ; CALL bdy_ice_frs( idx_bdy( ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )68 CASE('frs' ) ; CALL bdy_ice_frs( idx_bdy(jbdy), dta_bdy(jbdy), kt, jbdy ) 69 69 CASE DEFAULT 70 70 CALL ctl_stop( 'bdy_ice : unrecognised option for open boundaries for ice fields' ) … … 79 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 ')81 IF( ln_timing ) CALL timing_stop('bdy_ice_thd') 82 82 ! 83 83 END SUBROUTINE bdy_ice 84 84 85 85 86 SUBROUTINE bdy_ice_frs( idx, dta, kt, ib_bdy )86 SUBROUTINE bdy_ice_frs( idx, dta, kt, jbdy ) 87 87 !!------------------------------------------------------------------------------ 88 88 !! *** SUBROUTINE bdy_ice_frs *** 89 89 !! 90 !! ** Purpose : Apply the Flow Relaxation Scheme for sea-ice fields in the case 91 !! of unstructured open boundaries. 90 !! ** Purpose : Apply the Flow Relaxation Scheme for sea-ice fields 92 91 !! 93 92 !! Reference : Engedahl H., 1995: Use of the flow relaxation scheme in a three- … … 97 96 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 98 97 INTEGER, INTENT(in) :: kt ! main time-step counter 99 INTEGER, INTENT(in) :: ib_bdy! BDY set index98 INTEGER, INTENT(in) :: jbdy ! BDY set index 100 99 ! 101 100 INTEGER :: jpbound ! 0 = incoming ice 102 101 ! ! 1 = outgoing ice 103 INTEGER :: jb, jk, jgrd, jl! dummy loop indices104 INTEGER :: ji, jj, ii, ij ! local scalar102 INTEGER :: i_bdy, jgrd ! dummy loop indices 103 INTEGER :: ji, jj, jk, jl, ib, jb 105 104 REAL(wp) :: zwgt, zwgt1 ! local scalar 106 105 REAL(wp) :: ztmelts, zdh … … 110 109 ! 111 110 DO jl = 1, jpl 112 DO jb= 1, idx%nblenrim(jgrd)113 ji = idx%nbi( jb,jgrd)114 jj = idx%nbj( jb,jgrd)115 zwgt = idx%nbw( jb,jgrd)116 zwgt1 = 1.e0 - idx%nbw( jb,jgrd)117 a_i(ji,jj,jl) = ( a_i(ji,jj,jl) * zwgt1 + dta%a_i( jb,jl) * zwgt ) * tmask(ji,jj,1) ! Leads fraction118 h_i(ji,jj,jl) = ( h_i(ji,jj,jl) * zwgt1 + dta%h_i( jb,jl) * zwgt ) * tmask(ji,jj,1) ! Ice depth119 h_s(ji,jj,jl) = ( h_s(ji,jj,jl) * zwgt1 + dta%h_s( jb,jl) * zwgt ) * tmask(ji,jj,1) ! Snow depth111 DO i_bdy = 1, idx%nblenrim(jgrd) 112 ji = idx%nbi(i_bdy,jgrd) 113 jj = idx%nbj(i_bdy,jgrd) 114 zwgt = idx%nbw(i_bdy,jgrd) 115 zwgt1 = 1.e0 - idx%nbw(i_bdy,jgrd) 116 a_i(ji,jj,jl) = ( a_i(ji,jj,jl) * zwgt1 + dta%a_i(i_bdy,jl) * zwgt ) * tmask(ji,jj,1) ! Leads fraction 117 h_i(ji,jj,jl) = ( h_i(ji,jj,jl) * zwgt1 + dta%h_i(i_bdy,jl) * zwgt ) * tmask(ji,jj,1) ! Ice depth 118 h_s(ji,jj,jl) = ( h_s(ji,jj,jl) * zwgt1 + dta%h_s(i_bdy,jl) * zwgt ) * tmask(ji,jj,1) ! Snow depth 120 119 121 120 ! ----------------- … … 135 134 136 135 ENDDO 137 CALL lbc_bdy_lnk( a_i(:,:,jl), 'T', 1., ib_bdy )138 CALL lbc_bdy_lnk( h_i(:,:,jl), 'T', 1., ib_bdy )139 CALL lbc_bdy_lnk( h_s(:,:,jl), 'T', 1., ib_bdy )140 136 ENDDO 137 CALL lbc_bdy_lnk( a_i(:,:,:), 'T', 1., jbdy ) 138 CALL lbc_bdy_lnk( h_i(:,:,:), 'T', 1., jbdy ) 139 CALL lbc_bdy_lnk( h_s(:,:,:), 'T', 1., jbdy ) 141 140 142 141 DO jl = 1, jpl 143 DO jb= 1, idx%nblenrim(jgrd)144 ji = idx%nbi(jb,jgrd)145 jj = idx%nbj(jb,jgrd)142 DO i_bdy = 1, idx%nblenrim(jgrd) 143 ji = idx%nbi(i_bdy,jgrd) 144 jj = idx%nbj(i_bdy,jgrd) 146 145 147 146 ! condition on ice thickness depends on the ice velocity 148 147 ! if velocity is outward (strictly), then ice thickness, volume... must be equal to adjacent values 149 jpbound = 0 ; i i = ji ; ij= jj150 ! 151 IF( u_ice(ji+1,jj ) < 0. .AND. umask(ji-1,jj ,1) == 0. ) jpbound = 1; ii = ji+1; ij= jj152 IF( u_ice(ji-1,jj ) > 0. .AND. umask(ji+1,jj ,1) == 0. ) jpbound = 1; ii = ji-1; ij= jj153 IF( v_ice(ji ,jj+1) < 0. .AND. vmask(ji ,jj-1,1) == 0. ) jpbound = 1; ii = ji ; ij= jj+1154 IF( v_ice(ji ,jj-1) > 0. .AND. vmask(ji ,jj+1,1) == 0. ) jpbound = 1; ii = ji ; ij= jj-1155 ! 156 IF( nn_ice_dta( ib_bdy) == 0 ) jpbound = 0; ii = ji; ij= jj ! case ice boundaries = initial conditions157 ! ! do not make state variables dependent on velocity158 ! 159 IF( a_i(i i,ij,jl) > 0._wp ) THEN ! there is ice at the boundary160 ! 161 a_i(ji,jj,jl) = a_i(i i,ij,jl) ! concentration162 h_i(ji,jj,jl) = h_i(i i,ij,jl) ! thickness ice163 h_s(ji,jj,jl) = h_s(i i,ij,jl) ! thickness snw148 jpbound = 0 ; ib = ji ; jb = jj 149 ! 150 IF( u_ice(ji+1,jj ) < 0. .AND. umask(ji-1,jj ,1) == 0. ) jpbound = 1 ; ib = ji+1 ; jb = jj 151 IF( u_ice(ji-1,jj ) > 0. .AND. umask(ji+1,jj ,1) == 0. ) jpbound = 1 ; ib = ji-1 ; jb = jj 152 IF( v_ice(ji ,jj+1) < 0. .AND. vmask(ji ,jj-1,1) == 0. ) jpbound = 1 ; ib = ji ; jb = jj+1 153 IF( v_ice(ji ,jj-1) > 0. .AND. vmask(ji ,jj+1,1) == 0. ) jpbound = 1 ; ib = ji ; jb = jj-1 154 ! 155 IF( nn_ice_dta(jbdy) == 0 ) jpbound = 0 ; ib = ji ; jb = jj ! case ice boundaries = initial conditions 156 ! ! do not make state variables dependent on velocity 157 ! 158 IF( a_i(ib,jb,jl) > 0._wp ) THEN ! there is ice at the boundary 159 ! 160 a_i(ji,jj,jl) = a_i(ib,jb,jl) ! concentration 161 h_i(ji,jj,jl) = h_i(ib,jb,jl) ! thickness ice 162 h_s(ji,jj,jl) = h_s(ib,jb,jl) ! thickness snw 164 163 ! 165 164 SELECT CASE( jpbound ) … … 167 166 CASE( 0 ) ! velocity is inward 168 167 ! 169 oa_i(ji,jj, jl) = rn_ice_age( ib_bdy) * a_i(ji,jj,jl) ! age170 a_ip(ji,jj, jl) = 0._wp 171 v_ip(ji,jj, jl) = 0._wp 172 t_su(ji,jj, jl) = rn_ice_tem( ib_bdy) ! temperature surface173 t_s (ji,jj,:,jl) = rn_ice_tem( ib_bdy) ! temperature snw174 t_i (ji,jj,:,jl) = rn_ice_tem( ib_bdy) ! temperature ice175 s_i (ji,jj, jl) = rn_ice_sal( ib_bdy) ! salinity176 sz_i(ji,jj,:,jl) = rn_ice_sal( ib_bdy) ! salinity profile168 oa_i(ji,jj, jl) = rn_ice_age(jbdy) * a_i(ji,jj,jl) ! age 169 a_ip(ji,jj, jl) = 0._wp ! pond concentration 170 v_ip(ji,jj, jl) = 0._wp ! pond volume 171 t_su(ji,jj, jl) = rn_ice_tem(jbdy) ! temperature surface 172 t_s (ji,jj,:,jl) = rn_ice_tem(jbdy) ! temperature snw 173 t_i (ji,jj,:,jl) = rn_ice_tem(jbdy) ! temperature ice 174 s_i (ji,jj, jl) = rn_ice_sal(jbdy) ! salinity 175 sz_i(ji,jj,:,jl) = rn_ice_sal(jbdy) ! salinity profile 177 176 ! 178 177 CASE( 1 ) ! velocity is outward 179 178 ! 180 oa_i(ji,jj, jl) = oa_i(i i,ij, jl) ! age181 a_ip(ji,jj, jl) = a_ip(i i,ij, jl) ! pond concentration182 v_ip(ji,jj, jl) = v_ip(i i,ij, jl) ! pond volume183 t_su(ji,jj, jl) = t_su(i i,ij, jl) ! temperature surface184 t_s (ji,jj,:,jl) = t_s (i i,ij,:,jl) ! temperature snw185 t_i (ji,jj,:,jl) = t_i (i i,ij,:,jl) ! temperature ice186 s_i (ji,jj, jl) = s_i (i i,ij, jl) ! salinity187 sz_i(ji,jj,:,jl) = sz_i(i i,ij,:,jl) ! salinity profile179 oa_i(ji,jj, jl) = oa_i(ib,jb, jl) ! age 180 a_ip(ji,jj, jl) = a_ip(ib,jb, jl) ! pond concentration 181 v_ip(ji,jj, jl) = v_ip(ib,jb, jl) ! pond volume 182 t_su(ji,jj, jl) = t_su(ib,jb, jl) ! temperature surface 183 t_s (ji,jj,:,jl) = t_s (ib,jb,:,jl) ! temperature snw 184 t_i (ji,jj,:,jl) = t_i (ib,jb,:,jl) ! temperature ice 185 s_i (ji,jj, jl) = s_i (ib,jb, jl) ! salinity 186 sz_i(ji,jj,:,jl) = sz_i(ib,jb,:,jl) ! salinity profile 188 187 ! 189 188 END SELECT … … 243 242 END DO 244 243 ! 245 CALL lbc_bdy_lnk( a_i (:,:,jl), 'T', 1., ib_bdy )246 CALL lbc_bdy_lnk( h_i (:,:,jl), 'T', 1., ib_bdy )247 CALL lbc_bdy_lnk( h_s (:,:,jl), 'T', 1., ib_bdy )248 CALL lbc_bdy_lnk( oa_i(:,:,jl), 'T', 1., ib_bdy )249 CALL lbc_bdy_lnk( a_ip(:,:,jl), 'T', 1., ib_bdy )250 CALL lbc_bdy_lnk( v_ip(:,:,jl), 'T', 1., ib_bdy )251 CALL lbc_bdy_lnk( s_i (:,:,jl), 'T', 1., ib_bdy )252 CALL lbc_bdy_lnk( t_su(:,:,jl), 'T', 1., ib_bdy )253 CALL lbc_bdy_lnk( v_i (:,:,jl), 'T', 1., ib_bdy )254 CALL lbc_bdy_lnk( v_s (:,:,jl), 'T', 1., ib_bdy )255 CALL lbc_bdy_lnk( sv_i(:,:,jl), 'T', 1., ib_bdy )256 DO jk = 1, nlay_s257 CALL lbc_bdy_lnk(t_s(:,:,jk,jl), 'T', 1., ib_bdy )258 CALL lbc_bdy_lnk(e_s(:,:,jk,jl), 'T', 1., ib_bdy )259 END DO260 DO jk = 1, nlay_i261 CALL lbc_bdy_lnk(t_i(:,:,jk,jl), 'T', 1., ib_bdy )262 CALL lbc_bdy_lnk(e_i(:,:,jk,jl), 'T', 1., ib_bdy )263 END DO264 !265 244 END DO ! jl 245 246 CALL lbc_bdy_lnk( a_i (:,:,:) , 'T', 1., jbdy ) 247 CALL lbc_bdy_lnk( h_i (:,:,:) , 'T', 1., jbdy ) 248 CALL lbc_bdy_lnk( h_s (:,:,:) , 'T', 1., jbdy ) 249 CALL lbc_bdy_lnk( oa_i(:,:,:) , 'T', 1., jbdy ) 250 CALL lbc_bdy_lnk( a_ip(:,:,:) , 'T', 1., jbdy ) 251 CALL lbc_bdy_lnk( v_ip(:,:,:) , 'T', 1., jbdy ) 252 CALL lbc_bdy_lnk( s_i (:,:,:) , 'T', 1., jbdy ) 253 CALL lbc_bdy_lnk( t_su(:,:,:) , 'T', 1., jbdy ) 254 CALL lbc_bdy_lnk( v_i (:,:,:) , 'T', 1., jbdy ) 255 CALL lbc_bdy_lnk( v_s (:,:,:) , 'T', 1., jbdy ) 256 CALL lbc_bdy_lnk( sv_i(:,:,:) , 'T', 1., jbdy ) 257 CALL lbc_bdy_lnk( t_s (:,:,:,:), 'T', 1., jbdy ) 258 CALL lbc_bdy_lnk( e_s (:,:,:,:), 'T', 1., jbdy ) 259 CALL lbc_bdy_lnk( t_i (:,:,:,:), 'T', 1., jbdy ) 260 CALL lbc_bdy_lnk( e_i (:,:,:,:), 'T', 1., jbdy ) 266 261 ! 267 262 END SUBROUTINE bdy_ice_frs … … 272 267 !! *** SUBROUTINE bdy_ice_dyn *** 273 268 !! 274 !! ** Purpose : Apply dynamics boundary conditions for sea-ice in the cas of unstructured open boundaries. 275 !! u_ice and v_ice are equal to the value of the adjacent grid point if this latter is not ice free 276 !! if adjacent grid point is ice free, then u_ice and v_ice are equal to ocean velocities 269 !! ** Purpose : Apply dynamics boundary conditions for sea-ice. 277 270 !! 278 !! 2013-06 : C. Rousset 271 !! ** Method : if this adjacent grid point is not ice free, then u_ice and v_ice take its value 272 !! if is ice free, then u_ice and v_ice are unchanged by BDY 273 !! they keep values calculated in rheology 274 !! 279 275 !!------------------------------------------------------------------------------ 280 276 CHARACTER(len=1), INTENT(in) :: cd_type ! nature of velocity grid-points 281 277 ! 282 INTEGER :: jb, jgrd! dummy loop indices283 INTEGER :: ji, jj 284 INTEGER :: ib_bdy ! Loopindex278 INTEGER :: i_bdy, jgrd ! dummy loop indices 279 INTEGER :: ji, jj ! local scalar 280 INTEGER :: jbdy ! BDY set index 285 281 REAL(wp) :: zmsk1, zmsk2, zflag 286 282 !!------------------------------------------------------------------------------ 287 ! 288 DO ib_bdy=1, nb_bdy 289 ! 290 SELECT CASE( cn_ice(ib_bdy) ) 283 IF( ln_timing ) CALL timing_start('bdy_ice_dyn') 284 ! 285 DO jbdy=1, nb_bdy 286 ! 287 SELECT CASE( cn_ice(jbdy) ) 291 288 ! 292 289 CASE('none') … … 295 292 CASE('frs') 296 293 ! 297 IF( nn_ice_dta( ib_bdy) == 0 ) CYCLE ! case ice boundaries = initial conditions298 ! 294 IF( nn_ice_dta(jbdy) == 0 ) CYCLE ! case ice boundaries = initial conditions 295 ! ! do not change ice velocity (it is only computed by rheology) 299 296 SELECT CASE ( cd_type ) 300 297 ! 301 298 CASE ( 'U' ) 302 299 jgrd = 2 ! u velocity 303 DO jb = 1, idx_bdy(ib_bdy)%nblenrim(jgrd)304 ji = idx_bdy( ib_bdy)%nbi(jb,jgrd)305 jj = idx_bdy( ib_bdy)%nbj(jb,jgrd)306 zflag = idx_bdy( ib_bdy)%flagu(jb,jgrd)300 DO i_bdy = 1, idx_bdy(jbdy)%nblenrim(jgrd) 301 ji = idx_bdy(jbdy)%nbi(i_bdy,jgrd) 302 jj = idx_bdy(jbdy)%nbj(i_bdy,jgrd) 303 zflag = idx_bdy(jbdy)%flagu(i_bdy,jgrd) 307 304 ! 308 305 IF ( ABS( zflag ) == 1. ) THEN ! eastern and western boundaries … … 320 317 ! 321 318 END DO 322 CALL lbc_bdy_lnk( u_ice(:,:), 'U', -1., ib_bdy )319 CALL lbc_bdy_lnk( u_ice(:,:), 'U', -1., jbdy ) 323 320 ! 324 321 CASE ( 'V' ) 325 322 jgrd = 3 ! v velocity 326 DO jb = 1, idx_bdy(ib_bdy)%nblenrim(jgrd)327 ji = idx_bdy( ib_bdy)%nbi(jb,jgrd)328 jj = idx_bdy( ib_bdy)%nbj(jb,jgrd)329 zflag = idx_bdy( ib_bdy)%flagv(jb,jgrd)323 DO i_bdy = 1, idx_bdy(jbdy)%nblenrim(jgrd) 324 ji = idx_bdy(jbdy)%nbi(i_bdy,jgrd) 325 jj = idx_bdy(jbdy)%nbj(i_bdy,jgrd) 326 zflag = idx_bdy(jbdy)%flagv(i_bdy,jgrd) 330 327 ! 331 328 IF ( ABS( zflag ) == 1. ) THEN ! northern and southern boundaries … … 343 340 ! 344 341 END DO 345 CALL lbc_bdy_lnk( v_ice(:,:), 'V', -1., ib_bdy )342 CALL lbc_bdy_lnk( v_ice(:,:), 'V', -1., jbdy ) 346 343 ! 347 344 END SELECT … … 352 349 ! 353 350 END DO 351 ! 352 IF( ln_timing ) CALL timing_stop('bdy_ice_dyn') 354 353 ! 355 354 END SUBROUTINE bdy_ice_dyn -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/CRS/crsdom.F90
r9892 r9977 2246 2246 2247 2247 zmbk(:,:) = 0.0 2248 zmbk(:,:) = REAL( mbathy_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'T',1.0) ; mbathy_crs(:,:) = INT( zmbk(:,:) )2248 zmbk(:,:) = REAL( mbathy_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'T',1.0) ; mbathy_crs(:,:) = NINT( zmbk(:,:) ) 2249 2249 2250 2250 … … 2266 2266 ! convert into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 2267 2267 zmbk(:,:) = 1.e0; 2268 zmbk(:,:) = REAL( mbku_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'U',1.0) ; mbku_crs (:,:) = MAX( INT( zmbk(:,:) ), 1 )2269 zmbk(:,:) = REAL( mbkv_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'V',1.0) ; mbkv_crs (:,:) = MAX( INT( zmbk(:,:) ), 1 )2268 zmbk(:,:) = REAL( mbku_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'U',1.0) ; mbku_crs (:,:) = MAX( NINT( zmbk(:,:) ), 1 ) 2269 zmbk(:,:) = REAL( mbkv_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'V',1.0) ; mbkv_crs (:,:) = MAX( NINT( zmbk(:,:) ), 1 ) 2270 2270 ! 2271 2271 END SUBROUTINE crs_dom_bat -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/DIA/dia25h.F90
r9892 r9977 139 139 ! ----------------- 140 140 ! Define frequency of summing to create 25 h mean 141 IF( MOD( 3600, INT(rdt) ) == 0 ) THEN142 i_steps = 3600/ INT(rdt)141 IF( MOD( 3600,NINT(rdt) ) == 0 ) THEN 142 i_steps = 3600/NINT(rdt) 143 143 ELSE 144 144 CALL ctl_stop('STOP', 'dia_wri_tide: timestep must give MOD(3600,rdt) = 0 otherwise no hourly values are possible') -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/DOM/domain.F90
r9893 r9977 543 543 ! 544 544 cd_cfg = 'ORCA' 545 CALL iom_get( inum, 'ORCA_index', zorca_res ) ; kk_cfg = INT( zorca_res )545 CALL iom_get( inum, 'ORCA_index', zorca_res ) ; kk_cfg = NINT( zorca_res ) 546 546 ! 547 547 WRITE(ldtxt(ii),*) ' .' ; ii = ii+1 … … 563 563 ENDIF 564 564 ! 565 CALL iom_get( inum, 'jpiglo', ziglo ) ; kpi = INT( ziglo )566 CALL iom_get( inum, 'jpjglo', zjglo ) ; kpj = INT( zjglo )567 CALL iom_get( inum, 'jpkglo', zkglo ) ; kpk = INT( zkglo )568 CALL iom_get( inum, 'jperio', zperio ) ; kperio = INT( zperio )565 CALL iom_get( inum, 'jpiglo', ziglo ) ; kpi = NINT( ziglo ) 566 CALL iom_get( inum, 'jpjglo', zjglo ) ; kpj = NINT( zjglo ) 567 CALL iom_get( inum, 'jpkglo', zkglo ) ; kpk = NINT( zkglo ) 568 CALL iom_get( inum, 'jperio', zperio ) ; kperio = NINT( zperio ) 569 569 CALL iom_close( inum ) 570 570 ! -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/DOM/domzgr.F90
r9892 r9977 253 253 ! !* ocean top and bottom level 254 254 CALL iom_get( inum, jpdom_data, 'top_level' , z2d , lrowattr=ln_use_jattr ) ! 1st wet T-points (ISF) 255 k_top(:,:) = INT( z2d(:,:) )255 k_top(:,:) = NINT( z2d(:,:) ) 256 256 CALL iom_get( inum, jpdom_data, 'bottom_level' , z2d , lrowattr=ln_use_jattr ) ! last wet T-points 257 k_bot(:,:) = INT( z2d(:,:) )257 k_bot(:,:) = NINT( z2d(:,:) ) 258 258 ! 259 259 ! reference depth for negative bathy (wetting and drying only) … … 307 307 END DO 308 308 ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 309 zk(:,:) = REAL( miku(:,:), wp ) ; CALL lbc_lnk( zk, 'U', 1. ) ; miku(:,:) = MAX( INT( zk(:,:) ), 1 )310 zk(:,:) = REAL( mikv(:,:), wp ) ; CALL lbc_lnk( zk, 'V', 1. ) ; mikv(:,:) = MAX( INT( zk(:,:) ), 1 )311 zk(:,:) = REAL( mikf(:,:), wp ) ; CALL lbc_lnk( zk, 'F', 1. ) ; mikf(:,:) = MAX( INT( zk(:,:) ), 1 )312 ! 313 zk(:,:) = REAL( mbku(:,:), wp ) ; CALL lbc_lnk( zk, 'U', 1. ) ; mbku(:,:) = MAX( INT( zk(:,:) ), 1 )314 zk(:,:) = REAL( mbkv(:,:), wp ) ; CALL lbc_lnk( zk, 'V', 1. ) ; mbkv(:,:) = MAX( INT( zk(:,:) ), 1 )309 zk(:,:) = REAL( miku(:,:), wp ) ; CALL lbc_lnk( zk, 'U', 1. ) ; miku(:,:) = MAX( NINT( zk(:,:) ), 1 ) 310 zk(:,:) = REAL( mikv(:,:), wp ) ; CALL lbc_lnk( zk, 'V', 1. ) ; mikv(:,:) = MAX( NINT( zk(:,:) ), 1 ) 311 zk(:,:) = REAL( mikf(:,:), wp ) ; CALL lbc_lnk( zk, 'F', 1. ) ; mikf(:,:) = MAX( NINT( zk(:,:) ), 1 ) 312 ! 313 zk(:,:) = REAL( mbku(:,:), wp ) ; CALL lbc_lnk( zk, 'U', 1. ) ; mbku(:,:) = MAX( NINT( zk(:,:) ), 1 ) 314 zk(:,:) = REAL( mbkv(:,:), wp ) ; CALL lbc_lnk( zk, 'V', 1. ) ; mbkv(:,:) = MAX( NINT( zk(:,:) ), 1 ) 315 315 ! 316 316 END SUBROUTINE zgr_top_bot -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/IOM/iom.F90
r9892 r9977 83 83 MODULE PROCEDURE iom_p0d, iom_p1d, iom_p2d, iom_p3d 84 84 END INTERFACE iom_put 85 86 LOGICAL, PARAMETER :: ltmppatch = .TRUE. !: seb: patch before we remove periodicity87 INTEGER :: nldi_save, nlei_save !: and close boundaries in output files88 INTEGER :: nldj_save, nlej_save !:89 85 90 86 !!---------------------------------------------------------------------- … … 95 91 CONTAINS 96 92 97 SUBROUTINE iom_init( cdname, fname )93 SUBROUTINE iom_init( cdname, fname, ld_tmppatch ) 98 94 !!---------------------------------------------------------------------- 99 95 !! *** ROUTINE *** … … 102 98 !! 103 99 !!---------------------------------------------------------------------- 104 CHARACTER(len=*), INTENT(in) :: cdname100 CHARACTER(len=*), INTENT(in) :: cdname 105 101 CHARACTER(len=*), OPTIONAL, INTENT(in) :: fname 102 LOGICAL , OPTIONAL, INTENT(in) :: ld_tmppatch 106 103 #if defined key_iomput 107 104 ! … … 113 110 ! 114 111 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds 112 LOGICAL :: ll_tmppatch = .TRUE. !: seb: patch before we remove periodicity 113 INTEGER :: nldi_save, nlei_save !: and close boundaries in output files 114 INTEGER :: nldj_save, nlej_save !: 115 115 !!---------------------------------------------------------------------- 116 116 ! 117 117 ! seb: patch before we remove periodicity and close boundaries in output files 118 IF ( ltmppatch ) THEN 118 IF( PRESENT(ld_tmppatch) ) THEN ; ll_tmppatch = ld_tmppatch 119 ELSE ; ll_tmppatch = .TRUE. 120 ENDIF 121 IF ( ll_tmppatch ) THEN 119 122 nldi_save = nldi ; nlei_save = nlei 120 123 nldj_save = nldj ; nlej_save = nlej … … 246 249 DEALLOCATE( zt_bnds, zw_bnds ) 247 250 ! 248 IF ( l tmppatch ) THEN251 IF ( ll_tmppatch ) THEN 249 252 nldi = nldi_save ; nlei = nlei_save 250 253 nldj = nldj_save ; nlej = nlej_save … … 1924 1927 !!---------------------------------------------------------------------- 1925 1928 ! 1926 ! seb: patch before we remove periodicity and close boundaries in output files1927 IF ( ltmppatch ) THEN1928 nldi_save = nldi ; nlei_save = nlei1929 nldj_save = nldj ; nlej_save = nlej1930 IF( nimpp == 1 ) nldi = 11931 IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi1932 IF( njmpp == 1 ) nldj = 11933 IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj1934 ENDIF1935 !1936 1929 ni = nlei-nldi+1 1937 1930 nj = nlej-nldj+1 … … 1955 1948 ENDIF 1956 1949 ! 1957 IF ( ltmppatch ) THEN1958 nldi = nldi_save ; nlei = nlei_save1959 nldj = nldj_save ; nlej = nlej_save1960 ENDIF1961 !1962 1950 END SUBROUTINE set_grid 1963 1951 … … 1981 1969 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_rot ! Lat/lon working array for rotation of cells 1982 1970 !!---------------------------------------------------------------------- 1983 !1984 ! seb: patch before we remove periodicity and close boundaries in output files1985 IF ( ltmppatch ) THEN1986 nldi_save = nldi ; nlei_save = nlei1987 nldj_save = nldj ; nlej_save = nlej1988 IF( nimpp == 1 ) nldi = 11989 IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi1990 IF( njmpp == 1 ) nldj = 11991 IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj1992 ENDIF1993 1971 ! 1994 1972 ALLOCATE( z_bnds(4,jpi,jpj,2), z_fld(jpi,jpj), z_rot(4,2) ) … … 2075 2053 DEALLOCATE( z_bnds, z_fld, z_rot ) 2076 2054 ! 2077 IF ( ltmppatch ) THEN2078 nldi = nldi_save ; nlei = nlei_save2079 nldj = nldj_save ; nlej = nlej_save2080 ENDIF2081 !2082 2055 END SUBROUTINE set_grid_bounds 2083 2056 … … 2095 2068 REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon 2096 2069 !!---------------------------------------------------------------------- 2097 !2098 ! seb: patch before we remove periodicity and close boundaries in output files2099 IF ( ltmppatch ) THEN2100 nldi_save = nldi ; nlei_save = nlei2101 nldj_save = nldj ; nlej_save = nlej2102 IF( nimpp == 1 ) nldi = 12103 IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi2104 IF( njmpp == 1 ) nldj = 12105 IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj2106 ENDIF2107 2070 ! 2108 2071 ni=nlei-nldi+1 ! define zonal mean domain (jpj*jpk) … … 2119 2082 ! 2120 2083 CALL iom_update_file_name('ptr') 2121 !2122 IF ( ltmppatch ) THEN2123 nldi = nldi_save ; nlei = nlei_save2124 nldj = nldj_save ; nlej = nlej_save2125 ENDIF2126 2084 ! 2127 2085 END SUBROUTINE set_grid_znl -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/IOM/restart.F90
r9893 r9977 129 129 clpname = TRIM(Agrif_CFixed())//"_"//clname 130 130 ENDIF 131 CALL iom_init( cwxios_context, TRIM(clpath)//TRIM(clpname) )131 CALL iom_init( cwxios_context, TRIM(clpath)//TRIM(clpname), .false. ) 132 132 CALL xios_update_calendar(nitrst) 133 133 CALL iom_swap( cxios_context ) … … 239 239 IF( .NOT.lxios_set ) THEN 240 240 IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS' 241 CALL iom_init( crxios_context )241 CALL iom_init( crxios_context, ld_tmppatch = .false. ) 242 242 lxios_set = .TRUE. 243 243 ENDIF 244 244 ENDIF 245 245 IF( TRIM(Agrif_CFixed()) /= '0' .AND. lrxios) THEN 246 CALL iom_init( crxios_context )246 CALL iom_init( crxios_context, ld_tmppatch = .false. ) 247 247 IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS for AGRIF' 248 248 lxios_set = .TRUE. -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/LBC/lbclnk.F90
r9892 r9977 38 38 ! 39 39 INTERFACE lbc_bdy_lnk 40 MODULE PROCEDURE mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 40 MODULE PROCEDURE mpp_lnk_bdy_2d, mpp_lnk_bdy_3d, mpp_lnk_bdy_4d 41 41 END INTERFACE 42 42 ! -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/LBC/lib_mpp.F90
r9892 r9977 88 88 PUBLIC mppsize 89 89 PUBLIC mppsend, mpprecv ! needed by TAM and ICB routines 90 PUBLIC mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 90 PUBLIC mpp_lnk_bdy_2d, mpp_lnk_bdy_3d, mpp_lnk_bdy_4d 91 91 PUBLIC mpprank 92 92 … … 456 456 ! !== 4D array and array of 4D pointer ==! 457 457 ! 458 !!# define DIM_4d459 !!# define ROUTINE_BDY mpp_lnk_bdy_4d460 !!# include "mpp_bdy_generic.h90"461 !!# undef ROUTINE_BDY462 !!# undef DIM_4d458 # define DIM_4d 459 # define ROUTINE_BDY mpp_lnk_bdy_4d 460 # include "mpp_bdy_generic.h90" 461 # undef ROUTINE_BDY 462 # undef DIM_4d 463 463 464 464 !!---------------------------------------------------------------------- -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/LBC/mpp_nfd_generic.h90
r9805 r9977 56 56 INTEGER :: ipi, ipj, ipk, ipl, ipf ! dimension of the input array 57 57 INTEGER :: imigr, iihom, ijhom ! local integers 58 INTEGER :: ierr, itaille, il di, ilei, iilb58 INTEGER :: ierr, itaille, ilci, ildi, ilei, iilb 59 59 INTEGER :: ij, iproc 60 60 INTEGER, DIMENSION (jpmaxngh) :: ml_req_nf ! for mpi_isend when avoiding mpi_allgather … … 117 117 IF(iproc /= -1) THEN 118 118 iilb = nimppt(iproc+1) 119 ilci = nlcit (iproc+1) 119 120 ildi = nldit (iproc+1) 120 121 ilei = nleit (iproc+1) 121 IF( iilb == 1 ) ildi = 1! e-w boundary already done -> force to take 1st column122 IF( iilb + jpi - 1 == jpiglo ) ilei = jpi ! e-w boundary already done -> force to take last column122 IF( iilb == 1 ) ildi = 1 ! e-w boundary already done -> force to take 1st column 123 IF( iilb + ilci - 1 == jpiglo ) ilei = ilci ! e-w boundary already done -> force to take last column 123 124 iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 124 125 ENDIF … … 185 186 iproc = nrank_north(jr) + 1 186 187 iilb = nimppt(iproc) 188 ilci = nlcit (iproc) 187 189 ildi = nldit (iproc) 188 190 ilei = nleit (iproc) 189 IF( iilb == 1 ) ildi = 1! e-w boundary already done -> force to take 1st column190 IF( iilb + jpi - 1 == jpiglo ) ilei = jpi ! e-w boundary already done -> force to take last column191 IF( iilb == 1 ) ildi = 1 ! e-w boundary already done -> force to take 1st column 192 IF( iilb + ilci - 1 == jpiglo ) ilei = ilci ! e-w boundary already done -> force to take last column 191 193 DO jf = 1, ipf 192 194 DO jl = 1, ipl -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/LBC/mppini.F90
r9892 r9977 536 536 & ibonit (jproc), ibonjt (jproc) 537 537 END DO 538 CLOSE(inum)539 538 END IF 540 539 … … 577 576 IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN 578 577 CALL mpp_ini_north 579 IF(lwp) WRITE(numout,*) 580 IF(lwp) WRITE(numout,*) ' ==>>> North fold boundary prepared for jpni >1' 578 IF (lwp) THEN 579 WRITE(numout,*) 580 WRITE(numout,*) ' ==>>> North fold boundary prepared for jpni >1' 581 ! additional prints in layout.dat 582 WRITE(inum,*) 583 WRITE(inum,*) 584 WRITE(inum,*) 'number of subdomains located along the north fold : ', ndim_rank_north 585 WRITE(inum,*) 'Rank of the subdomains located along the north fold : ', ndim_rank_north 586 DO jproc = 1, ndim_rank_north, 5 587 WRITE(inum,*) nrank_north( jproc:MINVAL( (/jproc+4,ndim_rank_north/) ) ) 588 END DO 589 ENDIF 581 590 ENDIF 582 591 ! 583 592 CALL mpp_init_ioipsl ! Prepare NetCDF output file (if necessary) 584 593 ! 585 IF( ln_nnogather ) CALL mpp_init_nfdcom ! northfold neighbour lists 594 IF( ln_nnogather ) THEN 595 CALL mpp_init_nfdcom ! northfold neighbour lists 596 IF (lwp) THEN 597 WRITE(inum,*) 598 WRITE(inum,*) 599 WRITE(inum,*) 'north fold exchanges with explicit point-to-point messaging :' 600 WRITE(inum,*) 'nfsloop : ', nfsloop 601 WRITE(inum,*) 'nfeloop : ', nfeloop 602 WRITE(inum,*) 'nsndto : ', nsndto 603 WRITE(inum,*) 'isendto : ', isendto 604 ENDIF 605 ENDIF 606 ! 607 IF (lwp) CLOSE(inum) 586 608 ! 587 609 DEALLOCATE(iin, ijn, ii_nono, ii_noea, ii_noso, ii_nowe, & -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/SBC/sbc_ice.F90
r9892 r9977 49 49 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qml_ice !: heat available for snow / ice surface melting [W/m2] 50 50 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qcn_ice !: heat conduction flux in the layer below surface [W/m2] 51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: q sr_ice_tr!: solar flux transmitted below the ice surface [W/m2]51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qtr_ice_top !: solar flux transmitted below the ice surface [W/m2] 52 52 53 53 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_ice !: atmos-ice u-stress. VP: I-pt ; EVP: U,V-pts [N/m2] … … 126 126 ALLOCATE( qns_ice (jpi,jpj,jpl) , qsr_ice (jpi,jpj,jpl) , & 127 127 & qla_ice (jpi,jpj,jpl) , dqla_ice (jpi,jpj,jpl) , & 128 & dqns_ice(jpi,jpj,jpl) , tn_ice (jpi,jpj,jpl) , alb_ice (jpi,jpj,jpl) , &129 & qml_ice (jpi,jpj,jpl) , qcn_ice (jpi,jpj,jpl) , q sr_ice_tr(jpi,jpj,jpl) , &130 & utau_ice(jpi,jpj) , vtau_ice (jpi,jpj) , wndm_ice (jpi,jpj) , &131 & evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice (jpi,jpj) , &132 & qemp_ice(jpi,jpj) , qevap_ice(jpi,jpj,jpl) , qemp_oce (jpi,jpj) , &133 & qns_oce (jpi,jpj) , qsr_oce (jpi,jpj) , emp_oce (jpi,jpj) , &134 & emp_ice (jpi,jpj) , tsfc_ice (jpi,jpj,jpl) , sstfrz (jpi,jpj) , STAT= ierr(2) )128 & dqns_ice(jpi,jpj,jpl) , tn_ice (jpi,jpj,jpl) , alb_ice (jpi,jpj,jpl) , & 129 & qml_ice (jpi,jpj,jpl) , qcn_ice (jpi,jpj,jpl) , qtr_ice_top(jpi,jpj,jpl) , & 130 & utau_ice(jpi,jpj) , vtau_ice (jpi,jpj) , wndm_ice (jpi,jpj) , & 131 & evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice (jpi,jpj) , & 132 & qemp_ice(jpi,jpj) , qevap_ice(jpi,jpj,jpl) , qemp_oce (jpi,jpj) , & 133 & qns_oce (jpi,jpj) , qsr_oce (jpi,jpj) , emp_oce (jpi,jpj) , & 134 & emp_ice (jpi,jpj) , tsfc_ice (jpi,jpj,jpl) , sstfrz (jpi,jpj) , STAT= ierr(2) ) 135 135 #endif 136 136 -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/SBC/sbcblk.F90
r9892 r9977 907 907 ! 908 908 WHERE ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 909 q sr_ice_tr(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) )909 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 910 910 ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp ) ! constant (zfr1) when hi>10cm 911 q sr_ice_tr(:,:,:) = qsr_ice(:,:,:) * zfr1911 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1 912 912 ELSEWHERE ! zero when hs>0 913 q sr_ice_tr(:,:,:) = 0._wp913 qtr_ice_top(:,:,:) = 0._wp 914 914 END WHERE 915 915 ! … … 1000 1000 ztsu = ptsu(ji,jj,jl) ! Store current iteration temperature 1001 1001 ztsu0 = ptsu(ji,jj,jl) ! Store initial surface temperature 1002 zqa0 = qsr_ice(ji,jj,jl) - q sr_ice_tr(ji,jj,jl) + qns_ice(ji,jj,jl)! Net initial atmospheric heat flux1002 zqa0 = qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + qns_ice(ji,jj,jl) ! Net initial atmospheric heat flux 1003 1003 ! 1004 1004 DO iter = 1, nit ! --- Iterative loop … … 1011 1011 qcn_ice(ji,jj,jl) = zkeff_h * ( ptsu(ji,jj,jl) - ptb(ji,jj) ) 1012 1012 qns_ice(ji,jj,jl) = qns_ice(ji,jj,jl) + dqns_ice(ji,jj,jl) * ( ptsu(ji,jj,jl) - ztsu0 ) 1013 qml_ice(ji,jj,jl) = ( qsr_ice(ji,jj,jl) - q sr_ice_tr(ji,jj,jl) + qns_ice(ji,jj,jl) - qcn_ice(ji,jj,jl) )&1013 qml_ice(ji,jj,jl) = ( qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + qns_ice(ji,jj,jl) - qcn_ice(ji,jj,jl) ) & 1014 1014 & * MAX( 0._wp , SIGN( 1._wp, ptsu(ji,jj,jl) - rt0 ) ) 1015 1015 -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/SBC/sbccpl.F90
r9892 r9977 1999 1999 ! ! ========================= ! 2000 2000 CASE ('coupled') 2001 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i(:,:,:)2002 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i(:,:,:)2001 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 2002 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 2003 2003 END SELECT 2004 2004 ! … … 2012 2012 ztri = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ! surface transmission parameter (Grenfell Maykut 77) 2013 2013 ! 2014 q sr_ice_tr(:,:,:) = ztri * qsr_ice(:,:,:)2015 WHERE( phs(:,:,:) >= 0.0_wp ) q sr_ice_tr(:,:,:) = 0._wp ! snow fully opaque2016 WHERE( phi(:,:,:) <= 0.1_wp ) q sr_ice_tr(:,:,:) = qsr_ice(:,:,:) ! thin ice transmits all solar radiation2014 qtr_ice_top(:,:,:) = ztri * qsr_ice(:,:,:) 2015 WHERE( phs(:,:,:) >= 0.0_wp ) qtr_ice_top(:,:,:) = 0._wp ! snow fully opaque 2016 WHERE( phi(:,:,:) <= 0.1_wp ) qtr_ice_top(:,:,:) = qsr_ice(:,:,:) ! thin ice transmits all solar radiation 2017 2017 ! 2018 2018 CASE( np_jules_ACTIVE ) !== Jules coupler is active ==! 2019 2019 ! 2020 ! ! ===> here we must receive the q sr_ice_trarray from the coupler2020 ! ! ===> here we must receive the qtr_ice_top array from the coupler 2021 2021 ! for now just assume zero (fully opaque ice) 2022 q sr_ice_tr(:,:,:) = 0._wp2022 qtr_ice_top(:,:,:) = 0._wp 2023 2023 ! 2024 2024 END SELECT -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/TRA/traadv_fct.F90
r9892 r9977 548 548 !!gm 549 549 ! 550 IF ( ln_isfcav ) THEN ! set level two values which may not be set in ISF case 551 zwd(:,:,2) = 1._wp ; zwi(:,:,2) = 0._wp ; zws(:,:,2) = 0._wp ; zwrm(:,:,2) = 0._wp 552 END IF 553 ! 550 554 DO jj = 2, jpjm1 ! 2nd order centered at top & bottom 551 555 DO ji = fs_2, fs_jpim1 … … 556 560 zwi (ji,jj,ikt) = 0._wp 557 561 zws (ji,jj,ikt) = 0._wp 558 zwrm(ji,jj,ikt) = 0.5_wp * ( pt_in(ji,jj, jk-1) + pt_in(ji,jj,jk) )562 zwrm(ji,jj,ikt) = 0.5_wp * ( pt_in(ji,jj,ikt-1) + pt_in(ji,jj,ikt) ) 559 563 ! 560 564 zwd (ji,jj,ikb) = 1._wp ! bottom 561 565 zwi (ji,jj,ikb) = 0._wp 562 566 zws (ji,jj,ikb) = 0._wp 563 zwrm(ji,jj,ikb) = 0.5_wp * ( pt_in(ji,jj, jk-1) + pt_in(ji,jj,jk) )567 zwrm(ji,jj,ikb) = 0.5_wp * ( pt_in(ji,jj,ikb-1) + pt_in(ji,jj,ikb) ) 564 568 END DO 565 569 END DO -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/TRA/trabbl.F90
r9892 r9977 526 526 zmbku(:,:) = REAL( mbku_d(:,:), wp ) ; zmbkv(:,:) = REAL( mbkv_d(:,:), wp ) 527 527 CALL lbc_lnk_multi( zmbku,'U',1., zmbkv,'V',1.) 528 mbku_d(:,:) = MAX( INT( zmbku(:,:) ), 1 ) ; mbkv_d(:,:) = MAX( INT( zmbkv(:,:) ), 1 )528 mbku_d(:,:) = MAX( INT( zmbku(:,:) ), 1 ) ; mbkv_d(:,:) = MAX( NINT( zmbkv(:,:) ), 1 ) 529 529 ! 530 530 ! !* sign of grad(H) at u- and v-points; zero if grad(H) = 0 -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/USR/usrdef_zgr.F90
r9892 r9977 204 204 CALL lbc_lnk( z2d, 'T', 1. ) ! set surrounding land to zero (here jperio=0 ==>> closed) 205 205 ! 206 k_bot(:,:) = INT( z2d(:,:) ) ! =jpkm1 over the ocean point, =0 elsewhere206 k_bot(:,:) = NINT( z2d(:,:) ) ! =jpkm1 over the ocean point, =0 elsewhere 207 207 ! 208 208 k_top(:,:) = MIN( 1 , k_bot(:,:) ) ! = 1 over the ocean point, =0 elsewhere -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/stpctl.F90
r9892 r9977 114 114 CALL mpp_max_multiple( zmax(:), 5 ) ! max over the global domain 115 115 ! 116 nstop = INT( zmax(5) ) ! nstop indicator sheared among all local domains116 nstop = NINT( zmax(5) ) ! nstop indicator sheared among all local domains 117 117 ENDIF 118 118 ! -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/timing.F90
r9892 r9977 211 211 WRITE(numtime,*) ' NEMO team' 212 212 WRITE(numtime,*) ' Ocean General Circulation Model' 213 WRITE(numtime,*) ' version 3.6 (2015) '213 WRITE(numtime,*) ' version 4.0 (2018) ' 214 214 WRITE(numtime,*) 215 215 WRITE(numtime,*) ' Timing Informations '
Note: See TracChangeset
for help on using the changeset viewer.
