Changeset 717 for trunk/NEMO/OPA_SRC
- Timestamp:
- 2007-10-16T13:03:55+02:00 (17 years ago)
- Location:
- trunk/NEMO/OPA_SRC
- Files:
-
- 14 edited
-
DIA/diawri.F90 (modified) (3 diffs)
-
DIA/diawri_dimg.h90 (modified) (1 diff)
-
DOM/domain.F90 (modified) (3 diffs)
-
LDF/ldfeiv.F90 (modified) (3 diffs)
-
SBC/sbc_oce.F90 (modified) (1 diff)
-
SBC/sbcice_lim.F90 (modified) (3 diffs)
-
SBC/sbcssr.F90 (modified) (2 diffs)
-
TRA/traadv_cen2.F90 (modified) (14 diffs)
-
TRA/traadv_cen2_jki.F90 (modified) (12 diffs)
-
ice_oce.F90 (modified) (2 diffs)
-
lbclnk.F90 (modified) (27 diffs)
-
lib_mpp.F90 (modified) (11 diffs)
-
opa.F90 (modified) (1 diff)
-
restart.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/DIA/diawri.F90
r714 r717 16 16 USE sbc_oce ! surface boundary condition: ocean 17 17 USE sbc_ice ! surface boundary condition: ice 18 USE sbcssr ! restoring term toward SST/SSS climatology 18 19 USE phycst ! physical constants 19 20 USE ocfzpt ! ocean freezing point … … 243 244 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 244 245 #endif 245 #if ! defined key_dynspg_rl && defined key_ice_lim246 ! sowaflup = sowaflep + sorunoff + sowafldp + a term associated to247 ! internal damping to Levitus that can be diagnosed from others248 ! sowaflcd = sowaflep + sorunoff + sowafldp + iowaflup249 CALL histdef( nid_T, "iowaflup", "Ice=>ocean net freshwater" , "kg/m2/s", & ! fsalt250 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )251 CALL histdef( nid_T, "sowaflep", "atmos=>ocean net freshwater" , "kg/m2/s", & ! fmass252 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )253 #endif246 !!$#if ! defined key_dynspg_rl && defined key_ice_lim 247 !!$ ! sowaflup = sowaflep + sorunoff + sowafldp + a term associated to 248 !!$ ! internal damping to Levitus that can be diagnosed from others 249 !!$ ! sowaflcd = sowaflep + sorunoff + sowafldp + iowaflup 250 !!$ CALL histdef( nid_T, "iowaflup", "Ice=>ocean net freshwater" , "kg/m2/s", & ! fsalt 251 !!$ & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 252 !!$ CALL histdef( nid_T, "sowaflep", "atmos=>ocean net freshwater" , "kg/m2/s", & ! fmass 253 !!$ & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 254 !!$#endif 254 255 CALL histdef( nid_T, "sowaflup", "Net Upward Water Flux" , "Kg/m2/s", & ! emp 255 256 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 256 CALL histdef( nid_T, "sorunoff", "Runoffs" , "Kg/m2/s", & ! runoffs257 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )257 !!$ CALL histdef( nid_T, "sorunoff", "Runoffs" , "Kg/m2/s", & ! runoffs 258 !!$ & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 258 259 CALL histdef( nid_T, "sowaflcd", "concentration/dilution water flux" , "kg/m2/s", & ! emps 259 260 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) … … 421 422 CALL histwrite( nid_T, "sossheig", it, sshn , ndim_hT, ndex_hT ) ! sea surface height 422 423 #endif 423 #if ! defined key_dynspg_rl && defined key_ice_lim424 CALL histwrite( nid_T, "iowaflup", it, fsalt(:,:) , ndim_hT, ndex_hT ) ! ice=>ocean water flux425 CALL histwrite( nid_T, "sowaflep", it, fmass(:,:) , ndim_hT, ndex_hT ) ! atmos=>ocean water flux426 #endif424 !!$#if ! defined key_dynspg_rl && defined key_ice_lim 425 !!$ CALL histwrite( nid_T, "iowaflup", it, fsalt(:,:) , ndim_hT, ndex_hT ) ! ice=>ocean water flux 426 !!$ CALL histwrite( nid_T, "sowaflep", it, fmass(:,:) , ndim_hT, ndex_hT ) ! atmos=>ocean water flux 427 !!$#endif 427 428 CALL histwrite( nid_T, "sowaflup", it, emp , ndim_hT, ndex_hT ) ! upward water flux 428 CALL histwrite( nid_T, "sorunoff", it, runoff , ndim_hT, ndex_hT ) ! runoff429 !!$ CALL histwrite( nid_T, "sorunoff", it, runoff , ndim_hT, ndex_hT ) ! runoff 429 430 CALL histwrite( nid_T, "sowaflcd", it, emps , ndim_hT, ndex_hT ) ! c/d water flux 430 431 zw2d(:,:) = emps(:,:) * sn(:,:,1) * tmask(:,:,1) -
trunk/NEMO/OPA_SRC/DIA/diawri_dimg.h90
r714 r717 76 76 !! * modules used 77 77 USE lib_mpp 78 USE dtasst, ONLY : sst79 78 80 79 !! * Arguments -
trunk/NEMO/OPA_SRC/DOM/domain.F90
r709 r717 143 143 NAMELIST/namrun/ no , cexper , ln_rstart , nrstdt , nit000, & 144 144 & nitend, ndate0 , nleapy , ninist , nstock, & 145 & nwrite, nrunoff ,ln_dimgnnn145 & nwrite, ln_dimgnnn 146 146 147 147 NAMELIST/namdom/ ntopo , e3zps_min, e3zps_rat, ngrid , nmsh , & 148 148 & nacc , atfp , rdt , rdtmin , rdtmax, & 149 & rdth , rdtbt , n fice , nfbulk , nclosea149 & rdth , rdtbt , nclosea 150 150 NAMELIST/namcla/ n_cla 151 151 !!---------------------------------------------------------------------- … … 174 174 WRITE(numout,*) ' frequency of restart file nstock = ', nstock 175 175 WRITE(numout,*) ' frequency of output file nwrite = ', nwrite 176 WRITE(numout,*) ' runoff option nrunoff = ', nrunoff177 176 WRITE(numout,*) ' multi file dimgout ln_dimgnnn = ', ln_dimgnnn 178 177 ENDIF … … 258 257 ENDIF 259 258 260 IF( lk_ice_lim ) THEN261 IF(lwp) WRITE(numout,*) ' ice model coupling frequency nfice = ', nfice262 nfbulk = nfice263 IF( MOD( rday, nfice*rdt ) /= 0 ) THEN264 IF(lwp) WRITE(numout,*) ' '265 IF(lwp) WRITE(numout,*) 'W A R N I N G : nfice is NOT a multiple of the number of time steps in a day'266 IF(lwp) WRITE(numout,*) ' '267 ENDIF268 IF(lwp) WRITE(numout,*) ' bulk computation frequency nfbulk = ', nfbulk, ' = nfice if ice model used'269 IF(lwp) WRITE(numout,*) ' flag closed sea or not nclosea = ', nclosea270 ENDIF271 272 259 ! Default values 273 260 n_cla = 0 -
trunk/NEMO/OPA_SRC/LDF/ldfeiv.F90
r708 r717 17 17 USE dom_oce ! ocean space and time domain 18 18 USE sbc_oce ! surface boundary condition: ocean 19 USE sbcrnf ! river runoffs 19 20 USE ldftra_oce ! ocean tracer lateral physics 20 21 USE phycst ! physical constants … … 177 178 DO ji = 1, jpi 178 179 zaht = ( 1. - MIN( 1., ABS( ff(ji,jj) / zf20 ) ) ) * ( aht0 - zaht_min ) & 179 & + aht0 * upsrnfh(ji,jj) ! enhanced near river mouths180 & + aht0 * rnfmsk(ji,jj) ! enhanced near river mouths 180 181 ahtu(ji,jj) = MAX( MAX( zaht_min, aeiu(ji,jj) ) + zaht, aht0 ) 181 182 ahtv(ji,jj) = MAX( MAX( zaht_min, aeiv(ji,jj) ) + zaht, aht0 ) … … 352 353 DO ji = 1, jpi 353 354 zaht = ( 1. - MIN( 1., ABS( ff(ji,jj) / zf20 ) ) ) * ( aht0 - zaht_min ) & 354 & + aht0 * upsrnfh(ji,jj) ! enhanced near river mouths355 & + aht0 * rnfmsk(ji,jj) ! enhanced near river mouths 355 356 ahtu(ji,jj) = MAX( MAX( zaht_min, aeiu(ji,jj) ) + zaht, aht0 ) 356 357 ahtv(ji,jj) = MAX( MAX( zaht_min, aeiv(ji,jj) ) + zaht, aht0 ) -
trunk/NEMO/OPA_SRC/SBC/sbc_oce.F90
r713 r717 18 18 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: qns !: sea heat flux: non solar [W/m2] 19 19 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: qsr !: sea heat flux: solar [W/m2] 20 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: qrp !: heat flux damping [w/m2]21 20 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: emp !: freshwater budget: volume flux [Kg/m2/s] 22 21 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: emps !: freshwater budget: concentration/dillution [Kg/m2/s] 23 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: erp !: evaporation damping [kg/m2/s]24 22 25 23 !!---------------------------------------------------------------------- -
trunk/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r702 r717 104 104 DO jj = 2, jpj 105 105 DO ji = fs_2, jpi ! vector opt. 106 u _oce(ji,jj) = 0.5 * ( ssu_m(ji-1,jj ) + ssu_m(ji-1,jj-1) )107 v _oce(ji,jj) = 0.5 * ( ssv_m(ji ,jj-1) + ssv_m(ji-1,jj-1) )106 ui_oce(ji,jj) = 0.5 * ( ssu_m(ji-1,jj ) + ssu_m(ji-1,jj-1) ) 107 vi_oce(ji,jj) = 0.5 * ( ssv_m(ji ,jj-1) + ssv_m(ji-1,jj-1) ) 108 108 END DO 109 109 END DO 110 CALL lbc_lnk( u _oce, 'I', -1. ) ! I-point (i.e. F-point with ice indices)111 CALL lbc_lnk( v _oce, 'I', -1. ) ! I-point (i.e. F-point with ice indices)110 CALL lbc_lnk( ui_oce, 'I', -1. ) ! I-point (i.e. F-point with ice indices) 111 CALL lbc_lnk( vi_oce, 'I', -1. ) ! I-point (i.e. F-point with ice indices) 112 112 113 113 ! ... masked sea surface freezing temperature [Kelvin] (set to rt0 over land) … … 124 124 CALL blk_ice_clio() 125 125 CASE( 4 ) ! CORE bulk formulation 126 CALL blk_ice_core( sist , u _ice , v_ice, alb_ice_cs, &126 CALL blk_ice_core( sist , ui_ice , vi_ice , alb_ice_cs, & 127 127 & utaui_ice, vtaui_ice , qns_ice , qsr_ice, & 128 128 & qla_ice , dqns_ice , dqla_ice, & … … 148 148 ; CALL lim_thd ( kt ) ! Ice thermodynamics 149 149 ; CALL lim_sbc ( kt ) ! Ice/Ocean Mass & Heat fluxes 150 IF( MOD( kt+n fice-1, ninfo ) == 0 .OR. &150 IF( MOD( kt+nn_fsbc-1, ninfo ) == 0 .OR. & 151 151 & ntmoy == 1 ) CALL lim_dia ( kt ) ! Ice Diagnostics 152 152 ; CALL lim_wri ( kt ) ! Ice outputs -
trunk/NEMO/OPA_SRC/SBC/sbcssr.F90
r713 r717 33 33 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_sst ! structure of input SST (file informations, fields read) 34 34 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_sss ! structure of input SSS (file informations, fields read) 35 36 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: erp !: evaporation damping [kg/m2/s] 37 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: qrp !: heat flux damping [w/m2] 35 38 36 39 !! * Namelist namsbc_ssr … … 99 102 WRITE(numout,*) ' (Yes=2, volume flux) ' 100 103 WRITE(numout,*) ' dQ/dT (restoring magnitude on SST) dqdt = ', dqdt, ' W/m2/K' 101 WRITE(numout,*) ' dE/dS (restoring magnitude on SST) deds = ', deds, ' ???'104 WRITE(numout,*) ' dE/dS (restoring magnitude on SST) deds = ', deds, ' ...' 102 105 ENDIF 103 106 -
trunk/NEMO/OPA_SRC/TRA/traadv_cen2.F90
r708 r717 1 1 MODULE traadv_cen2 2 !!====================================================================== ========3 !! 2 !!====================================================================== 3 !! *** MODULE traadv_cen2 *** 4 4 !! Ocean active tracers: horizontal & vertical advective trend 5 !!============================================================================== 6 !! History : 8.2 ! 01-08 (G. Madec, E. Durand) trahad+trazad = traadv 7 !! 8.5 ! 02-06 (G. Madec) F90: Free form and module 8 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization 9 !! " " ! 06-04 (R. Benshila, G. Madec) Step reorganization 5 !!====================================================================== 6 !! History : 8.2 ! 01-08 (G. Madec, E. Durand) trahad+trazad=traadv 7 !! 8.5 ! 02-06 (G. Madec) F90: Free form and module 8 !! 9.0 ! 04-08 (C. Talandier) New trends organization 9 !! " " ! 05-11 (V. Garnier) Surface pressure gradient organization 10 !! " " ! 06-04 (R. Benshila, G. Madec) Step reorganization 11 !! " " ! 06-07 (G. madec) add ups_orca_set routine 10 12 !!---------------------------------------------------------------------- 11 13 … … 14 16 !! vertical advection trends using a seconder order 15 17 !! centered scheme. (k-j-i loops) 18 !! ups_orca_set : allow mixed upstream/centered scheme in specific 19 !! area (set for orca 2 and 4 only) 16 20 !!---------------------------------------------------------------------- 17 21 USE oce ! ocean dynamics and active tracers … … 21 25 USE trdmod_oce ! ocean variables trends 22 26 USE trdmod ! ocean active tracers trends 27 USE closea ! closed sea 23 28 USE trabbl ! advective term in the BBL 24 29 USE ocfzpt ! 30 USE sbcrnf ! river runoffs 25 31 USE in_out_manager ! I/O manager 26 32 USE lib_mpp … … 32 38 PRIVATE 33 39 34 PUBLIC tra_adv_cen2 ! routine called by step.F90 40 PUBLIC tra_adv_cen2 ! routine called by step.F90 41 PUBLIC ups_orca_set ! routine used by traadv_cen2_jki.F90 42 43 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: upsmsk !: mixed upstream/centered scheme near some straits 44 ! ! and in closed seas (orca 2 and 4 configurations) 35 45 36 46 REAL(wp), DIMENSION(jpi,jpj) :: btr2 ! inverse of T-point surface [1/(e1t*e2t)] … … 40 50 # include "vectopt_loop_substitute.h90" 41 51 !!---------------------------------------------------------------------- 42 !! OPA 9.0 , LOCEAN-IPSL (200 5)52 !! OPA 9.0 , LOCEAN-IPSL (2006) 43 53 !! $Id$ 44 54 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 119 129 !! 120 130 INTEGER :: ji, jj, jk ! dummy loop indices 121 REAL(wp) :: & 122 zbtr, zta, zsa, zfui, zfvj, & ! temporary scalars 123 zhw, ze3tr, zcofi, zcofj, & ! " " 124 zupsut, zupsvt, zupsus, zupsvs, & ! " " 125 zfp_ui, zfp_vj, zfm_ui, zfm_vj, & ! " " 126 zcofk, zupst, zupss, zcent, & ! " " 127 zcens, zfp_w, zfm_w, & ! " " 128 zcenut, zcenvt, zcenus, zcenvs, & ! " " 129 z_hdivn_x, z_hdivn_y, z_hdivn 130 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwz, ztrdt, zind ! 3D workspace 131 REAL(wp) :: zta, zsa, zbtr, zhw, ze3tr, & ! temporary scalars 132 & zfp_ui, zfp_vj, zfp_w , zfui , & ! " " 133 & zfm_ui, zfm_vj, zfm_w , zfvj , & ! " " 134 & zcofi , zcofj , zcofk , & ! " " 135 & zupsut, zupsus, zcenut, zcenus, & ! " " 136 & zupsvt, zupsvs, zcenvt, zcenvs, & ! " " 137 & zupst , zupss , zcent , zcens , & ! " " 138 & z_hdivn_x, z_hdivn_y, z_hdivn 139 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwz, ztrdt, zind ! 3D workspace 131 140 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zww, ztrds ! " " 132 141 !!---------------------------------------------------------------------- … … 137 146 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~ Vector optimization case' 138 147 IF(lwp) WRITE(numout,*) 139 ! 140 btr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) ) 148 ! 149 upsmsk(:,:) = 0.e0 ! not upstream by default 150 IF( cp_cfg == "orca" ) CALL ups_orca_set ! set mixed Upstream/centered scheme near some straits 151 ! ! and in closed seas (orca2 and orca4 only) 152 ! 153 btr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) ) ! inverse of T-point surface 141 154 ENDIF 142 155 … … 146 159 DO jj = 1, jpj 147 160 DO ji = 1, jpi 148 zind(ji,jj,jk) = MAX ( upsrnfh(ji,jj) * upsrnfz(jk), & ! changing advection scheme near runoff 149 & upsadv(ji,jj) & ! in the vicinity of some straits 161 zind(ji,jj,jk) = MAX ( & 162 rnfmsk(ji,jj) * rnfmsk_z(jk), & ! near runoff mouths (& closed sea outflows) 163 upsmsk(ji,jj) & ! some of some straits 150 164 #if defined key_ice_lim 151 & , tmask(ji,jj,jk) & ! half upstream tracer fluxes 152 & * MAX( 0., SIGN( 1., fzptn(ji,jj) & ! if tn < ("freezing"+0.1 ) 153 & +0.1-tn(ji,jj,jk) ) ) & 165 ! ! below ice covered area (if tn < "freezing"+0.1 ) 166 , MAX( 0., SIGN( 1., fzptn(ji,jj) + 0.1 - tn(ji,jj,jk) ) ) * tmask(ji,jj,jk) & 154 167 #endif 155 168 & ) … … 158 171 END DO 159 172 160 161 ! Horizontal advective fluxes 162 ! ----------------------------- 173 ! I. Horizontal advective fluxes 174 ! ------------------------------ 175 ! Second order centered tracer flux at u and v-points 176 ! ----------------------------------------------------- 163 177 ! ! =============== 164 178 DO jk = 1, jpkm1 ! Horizontal slab … … 208 222 zbtr = btr2(ji,jj) / fse3t(ji,jj,jk) 209 223 #endif 210 ! horizontal advective trends 211 zta = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk) & 224 zta = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk) & ! horizontal advective trends 212 225 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk) ) 213 226 zsa = - zbtr * ( zww(ji,jj,jk) - zww(ji-1,jj ,jk) & 214 227 & + zwz(ji,jj,jk) - zwz(ji ,jj-1,jk) ) 215 ! add it to the general tracer trends 216 ta(ji,jj,jk) = ta(ji,jj,jk) + zta 228 ta(ji,jj,jk) = ta(ji,jj,jk) + zta ! add it to the general tracer trends 217 229 sa(ji,jj,jk) = sa(ji,jj,jk) + zsa 218 230 END DO … … 279 291 & tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 280 292 281 ! 4. "zonal" mean advective heat and salt transport 282 ! ------------------------------------------------- 283 293 ! "zonal" mean advective heat and salt transport 284 294 IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 285 295 IF( lk_zco ) THEN … … 313 323 ENDIF 314 324 315 ! 1. Vertical advective fluxes 325 ! 1. Vertical advective fluxes (Second order centered tracer flux at w-point) 316 326 ! ---------------------------- 317 ! Second order centered tracer flux at w-point318 327 DO jk = 2, jpk 319 328 DO jj = 2, jpjm1 320 329 DO ji = fs_2, fs_jpim1 ! vector opt. 321 ! upstream indicator 322 zcofk = MAX( zind(ji,jj,jk-1), zind(ji,jj,jk) ) 323 ! velocity * 1/2 324 zhw = 0.5 * pwn(ji,jj,jk) 325 ! upstream scheme 326 zfp_w = zhw + ABS( zhw ) 330 zcofk = MAX( zind(ji,jj,jk-1), zind(ji,jj,jk) ) ! upstream indicator 331 zhw = 0.5 * pwn(ji,jj,jk) ! velocity * 1/2 332 zfp_w = zhw + ABS( zhw ) ! upstream scheme 327 333 zfm_w = zhw - ABS( zhw ) 328 334 zupst = zfp_w * tb(ji,jj,jk) + zfm_w * tb(ji,jj,jk-1) 329 335 zupss = zfp_w * sb(ji,jj,jk) + zfm_w * sb(ji,jj,jk-1) 330 ! centered scheme 331 zcent = zhw * ( tn(ji,jj,jk) + tn(ji,jj,jk-1) ) 336 zcent = zhw * ( tn(ji,jj,jk) + tn(ji,jj,jk-1) ) ! centered scheme 332 337 zcens = zhw * ( sn(ji,jj,jk) + sn(ji,jj,jk-1) ) 333 ! mixed centered / upstream scheme 334 zwx(ji,jj,jk) = zcofk * zupst + (1.-zcofk) * zcent 338 zwx(ji,jj,jk) = zcofk * zupst + (1.-zcofk) * zcent ! mixed centered / upstream scheme 335 339 zwy(ji,jj,jk) = zcofk * zupss + (1.-zcofk) * zcens 336 340 END DO … … 344 348 DO ji = fs_2, fs_jpim1 ! vector opt. 345 349 ze3tr = 1. / fse3t(ji,jj,jk) 346 ! vertical advective trends 347 zta = - ze3tr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) 350 zta = - ze3tr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) ! vertical advective trends 348 351 zsa = - ze3tr * ( zwy(ji,jj,jk) - zwy(ji,jj,jk+1) ) 349 ! add it to the general tracer trends 350 ta(ji,jj,jk) = ta(ji,jj,jk) + zta 352 ta(ji,jj,jk) = ta(ji,jj,jk) + zta ! add it to the general tracer trends 351 353 sa(ji,jj,jk) = sa(ji,jj,jk) + zsa 352 354 END DO … … 387 389 ! 388 390 END SUBROUTINE tra_adv_cen2 391 392 393 SUBROUTINE ups_orca_set 394 !!---------------------------------------------------------------------- 395 !! *** ROUTINE ups_orca_set *** 396 !! 397 !! ** Purpose : add a portion of upstream scheme in area where the 398 !! centered scheme generates too strong overshoot 399 !! 400 !! ** Method : orca (R4 and R2) confiiguration setting. Set upsmsk 401 !! array to nozero value in some straith. 402 !! 403 !! ** Action : - upsmsk set to 1 at some strait, 0 elsewhere for orca 404 !!---------------------------------------------------------------------- 405 INTEGER :: ii0, ii1, ij0, ij1 ! temporary integers 406 !!---------------------------------------------------------------------- 407 408 ! mixed upstream/centered scheme near river mouths 409 ! ------------------------------------------------ 410 SELECT CASE ( jp_cfg ) 411 ! ! ======================= 412 CASE ( 4 ) ! ORCA_R4 configuration 413 ! ! ======================= 414 ! ! Gibraltar Strait 415 ii0 = 70 ; ii1 = 71 416 ij0 = 52 ; ij1 = 53 ; upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50 417 ! 418 ! ! ======================= 419 CASE ( 2 ) ! ORCA_R2 configuration 420 ! ! ======================= 421 ! ! Gibraltar Strait 422 ij0 = 102 ; ij1 = 102 423 ii0 = 138 ; ii1 = 138 ; upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.20 424 ii0 = 139 ; ii1 = 139 ; upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40 425 ii0 = 140 ; ii1 = 140 ; upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50 426 ij0 = 101 ; ij1 = 102 427 ii0 = 141 ; ii1 = 141 ; upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50 428 ! ! Bab el Mandeb Strait 429 ij0 = 87 ; ij1 = 88 430 ii0 = 164 ; ii1 = 164 ; upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.10 431 ij0 = 88 ; ij1 = 88 432 ii0 = 163 ; ii1 = 163 ; upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25 433 ii0 = 162 ; ii1 = 162 ; upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40 434 ii0 = 160 ; ii1 = 161 ; upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50 435 ij0 = 89 ; ij1 = 89 436 ii0 = 158 ; ii1 = 160 ; upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25 437 ij0 = 90 ; ij1 = 90 438 ii0 = 160 ; ii1 = 160 ; upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25 439 ! ! Sound Strait 440 ij0 = 116 ; ij1 = 116 441 ii0 = 144 ; ii1 = 144 ; upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25 442 ii0 = 145 ; ii1 = 147 ; upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50 443 ii0 = 148 ; ii1 = 148 ; upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25 444 ! 445 END SELECT 446 447 ! mixed upstream/centered scheme over closed seas 448 ! ----------------------------------------------- 449 CALL clo_ups( upsmsk(:,:) ) 450 ! 451 END SUBROUTINE ups_orca_set 389 452 390 453 !!====================================================================== -
trunk/NEMO/OPA_SRC/TRA/traadv_cen2_jki.F90
r708 r717 4 4 !! Ocean active tracers: horizontal & vertical advective trend 5 5 !!============================================================================== 6 !! History : 8.2 ! 01-08 (G. Madec, E. Durand) trahad+trazad = traadv 7 !! 8.5 ! 02-06 (G. Madec) F90: Free form and module 8 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization 9 !! " " ! 06-04 (R. Benshila, G. Madec) Step reorganization 6 !! History : 8.2 ! 01-08 (G. Madec, E. Durand) trahad+trazad = traadv 7 !! 8.5 ! 02-06 (G. Madec) F90: Free form and module 8 !! 9.0 ! 04-08 (C. Talandier) New trends organization 9 !! " " ! 05-11 (V. Garnier) Surface pressure gradient organization 10 !! " " ! 06-04 (R. Benshila, G. Madec) Step reorganization 11 !! " " ! 06-07 (G. madec) add ups_orca_set routine 10 12 !!---------------------------------------------------------------------- 11 13 12 14 !!---------------------------------------------------------------------- 13 15 !! tra_adv_cen2_jki : update the tracer trend with the horizontal and 14 !! vertical advection trends using a seconder order15 !! centered scheme. Auto-tasking case, k-slab for16 !! hor. adv., j-slab for vert. adv. (j-k-i loops)16 !! vertical advection trends using a seconder order 17 !! centered scheme. Auto-tasking case, k-slab for 18 !! hor. adv., j-slab for vert. adv. (j-k-i loops) 17 19 !!---------------------------------------------------------------------- 18 20 USE oce ! ocean dynamics and active tracers … … 26 28 USE lib_mpp 27 29 USE lbclnk ! ocean lateral boundary condition (or mpp link) 30 USE sbcrnf ! river runoffs 28 31 USE in_out_manager ! I/O manager 29 32 USE diaptr ! poleward transport diagnostics 30 33 USE prtctl ! Print control 31 34 32 35 IMPLICIT NONE 33 36 PRIVATE 34 37 35 PUBLIC tra_adv_cen2_jki ! routine called by step.F9036 37 REAL(wp), DIMENSION(jpi,jpj) :: btr2 ! inverse of T-point surface [1/(e1t*e2t)]38 PUBLIC tra_adv_cen2_jki ! routine called by step.F90 39 40 REAL(wp), DIMENSION(jpi,jpj) :: btr2 ! inverse of T-point surface [1/(e1t*e2t)] 38 41 39 42 !! * Substitutions … … 87 90 !! zta+tn*divn=1/(e1t*e2t*e3t) { mi-1( e2u*e3u un di[tn] ) 88 91 !! +mj-1( e1v*e3v vn mj[tn] ) } 92 !! C A U T I O N : the trend saved is the centered trend only. 93 !! It does not take into account the upstream part of the scheme. 89 94 !! NB:in z-coordinate - full step (ln_zco=T) e3u=e3v=e3t, so 90 95 !! they vanish from the expression of the flux and divergence. … … 109 114 !! 110 115 !! ** Action : - update (ta,sa) with the now advective tracer trends 111 !! - save trends in (ztrdt,ztrds) ('key_trdtra')112 116 !!---------------------------------------------------------------------- 113 USE oce , ONLY : zwx => ua! use ua as workspace114 USE oce , ONLY : zwy => va! use va as workspace115 !!116 INTEGER , INTENT(in) :: kt ! ocean time-step index117 REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) :: pun ! ocean velocity u-component 118 REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) :: pvn ! ocean velocity v-component119 REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) :: p wn ! ocean velocity w-component120 !! 117 USE oce , zwx => ua ! use ua as workspace 118 USE oce , zwy => va ! use va as workspace 119 USE traadv_cen2, ONLY : ups_orca_set, & ! upstream indicator near some straits 120 & upsmsk ! and over closed sea (orca 2 and 4) 121 122 INTEGER , INTENT(in) :: kt ! ocean time-step index 123 REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) :: pun, pvn, pwn ! now ocean velocity fields 124 121 125 INTEGER :: ji, jj, jk ! dummy loop indices 122 REAL(wp) :: & 123 zbtr, zta, zsa, zfui, zfvj, & ! temporary scalars 124 zhw, ze3tr, zcofi, zcofj, & ! " " 125 zupsut, zupsvt, zupsus, zupsvs, & ! " " 126 zfp_ui, zfp_vj, zfm_ui, zfm_vj, & ! " " 127 zcofk, zupst, zupss, zcent, & ! " " 128 zcens, zfp_w, zfm_w, & ! " " 129 zcenut, zcenvt, zcenus, zcenvs, & ! " " 130 z_hdivn_x, z_hdivn_y, z_hdivn 131 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwz, ztrdt, zind ! 3D workspace 132 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zww, ztrds ! " " 126 REAL(wp) :: zta, zsa, zbtr, zhw, ze3tr, & ! temporary scalars 127 & zfp_ui, zfp_vj, zfp_w , zfui , & ! " " 128 & zfm_ui, zfm_vj, zfm_w , zfvj , & ! " " 129 & zcofi , zcofj , zcofk , & ! " " 130 & zupsut, zupsus, zcenut, zcenus, & ! " " 131 & zupsvt, zupsvs, zcenvt, zcenvs, & ! " " 132 & zupst , zupss , zcent , zcens , & ! " " 133 & z_hdivn_x, z_hdivn_y, z_hdivn 134 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwz, ztrdt, zind, & ! temporary workspace arrays 135 & zww, ztrds ! " " 133 136 !!---------------------------------------------------------------------- 134 137 ! 135 138 IF( kt == nit000 ) THEN 136 139 IF(lwp) WRITE(numout,*) … … 138 141 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ Auto-tasking case' 139 142 IF(lwp) WRITE(numout,*) 140 ! 141 btr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) ) 143 ! 144 upsmsk(:,:) = 0.e0 ! not upstream by default 145 IF( cp_cfg == "orca" ) CALL ups_orca_set ! set mixed Upstream/centered scheme near some straits 146 ! ! and in closed seas (orca2 and orca4 only) 147 148 btr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) ) ! inverse of T-point surface 142 149 ENDIF 143 150 … … 147 154 DO jk = 1, jpkm1 ! Horizontal slab 148 155 ! ! =============== 149 ! Upstream / centered scheme indicator 150 ! -------------------------------------- 156 157 ! 0. Upstream / centered scheme indicator 158 ! --------------------------------------- 151 159 DO jj = 1, jpj 152 160 DO ji = 1, jpi 153 zind(ji,jj,jk) = MAX (&154 upsrnfh(ji,jj) * upsrnfz(jk), & ! changing advection scheme near runoff155 ups adv(ji,jj) & ! in the vicinityof some straits161 zind(ji,jj,jk) = MAX ( & 162 rnfmsk(ji,jj) * rnfmsk_z(jk), & ! near runoff mouths (& closed sea outflows) 163 upsmsk(ji,jj) & ! some of some straits 156 164 #if defined key_ice_lim 157 , tmask(ji,jj,jk) & ! half upstream tracer fluxes if tn < ("freezing"+0.1 ) 158 * MAX( 0., SIGN( 1., fzptn(ji,jj)+0.1-tn(ji,jj,jk) ) ) & 159 #endif 160 ) 161 END DO 162 END DO 163 164 ! Horizontal advective fluxes 165 ! ----------------------------- 165 ! ! below ice covered area (if tn < "freezing"+0.1 ) 166 , MAX( 0., SIGN( 1., fzptn(ji,jj) + 0.1 - tn(ji,jj,jk) ) ) * tmask(ji,jj,jk) & 167 #endif 168 & ) 169 END DO 170 END DO 171 172 173 ! I. Horizontal advective fluxes 174 ! ------------------------------ 166 175 ! Second order centered tracer flux at u and v-points 167 176 DO jj = 1, jpjm1 168 177 DO ji = 1, fs_jpim1 ! vector opt. 169 ! upstream indicator 170 zcofi = MAX( zind(ji+1,jj,jk), zind(ji,jj,jk) ) 178 zcofi = MAX( zind(ji+1,jj,jk), zind(ji,jj,jk) ) ! upstream indicator 171 179 zcofj = MAX( zind(ji,jj+1,jk), zind(ji,jj,jk) ) 172 ! volume fluxes * 1/2 173 #if defined key_zco 174 zfui = 0.5 * e2u(ji,jj) * pun(ji,jj,jk) 180 #if defined key_zco 181 zfui = 0.5 * e2u(ji,jj) * pun(ji,jj,jk) ! volume fluxes * 1/2 (zco) 175 182 zfvj = 0.5 * e1v(ji,jj) * pvn(ji,jj,jk) 176 183 #else 177 zfui = 0.5 * e2u(ji,jj) * fse3u(ji,jj,jk) * pun(ji,jj,jk) 184 zfui = 0.5 * e2u(ji,jj) * fse3u(ji,jj,jk) * pun(ji,jj,jk) ! volume fluxes * 1/2 178 185 zfvj = 0.5 * e1v(ji,jj) * fse3v(ji,jj,jk) * pvn(ji,jj,jk) 179 186 #endif 180 ! upstream scheme 181 zfp_ui = zfui + ABS( zfui ) 187 zfp_ui = zfui + ABS( zfui ) ! upstream scheme 182 188 zfp_vj = zfvj + ABS( zfvj ) 183 189 zfm_ui = zfui - ABS( zfui ) … … 187 193 zupsus = zfp_ui * sb(ji,jj,jk) + zfm_ui * sb(ji+1,jj ,jk) 188 194 zupsvs = zfp_vj * sb(ji,jj,jk) + zfm_vj * sb(ji ,jj+1,jk) 189 ! centered scheme 190 zcenut = zfui * ( tn(ji,jj,jk) + tn(ji+1,jj ,jk) ) 195 zcenut = zfui * ( tn(ji,jj,jk) + tn(ji+1,jj ,jk) ) ! centered scheme 191 196 zcenvt = zfvj * ( tn(ji,jj,jk) + tn(ji ,jj+1,jk) ) 192 197 zcenus = zfui * ( sn(ji,jj,jk) + sn(ji+1,jj ,jk) ) 193 198 zcenvs = zfvj * ( sn(ji,jj,jk) + sn(ji ,jj+1,jk) ) 194 ! mixed centered / upstream scheme 195 zwx(ji,jj,jk) = zcofi * zupsut + (1.-zcofi) * zcenut 199 zwx(ji,jj,jk) = zcofi * zupsut + (1.-zcofi) * zcenut ! mixed centered / upstream scheme 196 200 zwy(ji,jj,jk) = zcofj * zupsvt + (1.-zcofj) * zcenvt 197 201 zww(ji,jj,jk) = zcofi * zupsus + (1.-zcofi) * zcenus … … 200 204 END DO 201 205 202 ! Tracer flux divergence at t-point added to the general trend 206 ! 2. Tracer flux divergence at t-point added to the general trend 207 ! --------------------------------------------------------------- 208 203 209 DO jj = 2, jpjm1 204 210 DO ji = fs_2, fs_jpim1 ! vector opt. 205 211 #if defined key_zco 206 zbtr = btr2(ji,jj) 207 #else 208 zbtr = btr2(ji,jj) / fse3t(ji,jj,jk) 209 #endif 210 ! horizontal advective trends 211 zta = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk) & 212 zbtr = btr2(ji,jj) ! inverse of the volume (zco) 213 #else 214 zbtr = btr2(ji,jj) / fse3t(ji,jj,jk) ! inverse of the volume 215 #endif 216 zta = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk) & ! horizontal advective trends 212 217 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk) ) 213 218 zsa = - zbtr * ( zww(ji,jj,jk) - zww(ji-1,jj ,jk) & 214 219 & + zwz(ji,jj,jk) - zwz(ji ,jj-1,jk) ) 215 ! add it to the general tracer trends 216 ta(ji,jj,jk) = ta(ji,jj,jk) + zta 220 ta(ji,jj,jk) = ta(ji,jj,jk) + zta ! add it to the general tracer trends 217 221 sa(ji,jj,jk) = sa(ji,jj,jk) + zsa 218 222 END DO … … 225 229 & tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 226 230 227 ! Save the horizontal advective trends for diagnostics231 ! 3. Save the horizontal advective trends for diagnostic 228 232 IF( l_trdtra ) THEN 229 233 ztrdt(:,:,:) = 0.e0 ; ztrds(:,:,:) = 0.e0 … … 298 302 ENDIF 299 303 300 ! Vertical advection301 ! -------------------- 304 ! II. Vertical advection 305 ! ---------------------- 302 306 !CDIR PARALLEL DO 303 307 !$OMP PARALLEL DO … … 312 316 IF( lk_dynspg_rl ) THEN ! rigid lid : flux set to zero 313 317 zwz(:,jj, 1 ) = 0.e0 ; zww(:,jj, 1 ) = 0.e0 314 ELSE ! free surface-constant volume 318 ELSE ! free surface-constant volume : advection across the surface 315 319 zwz(:,jj, 1 ) = pwn(:,jj,1) * tn(:,jj,1) 316 320 zww(:,jj, 1 ) = pwn(:,jj,1) * sn(:,jj,1) 317 321 ENDIF 318 322 319 ! Vertical advective fluxes at w-point 323 ! 1. Vertical advective fluxes (Second order centered tracer flux at w-point) 324 ! ---------------------------- 320 325 DO jk = 2, jpk 321 326 DO ji = 2, jpim1 322 ! upstream indicator 323 zcofk = MAX( zind(ji,jj,jk-1), zind(ji,jj,jk) ) 324 ! velocity * 1/2 325 zhw = 0.5 * pwn(ji,jj,jk) 326 ! upstream scheme 327 zfp_w = zhw + ABS( zhw ) 327 zcofk = MAX( zind(ji,jj,jk-1), zind(ji,jj,jk) ) ! upstream indicator 328 zhw = 0.5 * pwn(ji,jj,jk) ! velocity * 1/2 329 zfp_w = zhw + ABS( zhw ) ! upstream scheme 328 330 zfm_w = zhw - ABS( zhw ) 329 331 zupst = zfp_w * tb(ji,jj,jk) + zfm_w * tb(ji,jj,jk-1) 330 332 zupss = zfp_w * sb(ji,jj,jk) + zfm_w * sb(ji,jj,jk-1) 331 ! centered scheme 332 zcent = zhw * ( tn(ji,jj,jk) + tn(ji,jj,jk-1) ) 333 zcent = zhw * ( tn(ji,jj,jk) + tn(ji,jj,jk-1) ) ! centered scheme 333 334 zcens = zhw * ( sn(ji,jj,jk) + sn(ji,jj,jk-1) ) 334 ! mixed centered / upstream scheme 335 zwz(ji,jj,jk) = zcofk * zupst + (1.-zcofk) * zcent 335 zwz(ji,jj,jk) = zcofk * zupst + (1.-zcofk) * zcent ! mixed centered / upstream scheme 336 336 zww(ji,jj,jk) = zcofk * zupss + (1.-zcofk) * zcens 337 337 END DO 338 338 END DO 339 339 340 ! Tracer flux divergence at t-point added to the general trend 340 ! 2. Tracer flux divergence at t-point added to the general trend 341 ! ------------------------- 341 342 DO jk = 1, jpkm1 342 343 DO ji = 2, jpim1 343 344 ze3tr = 1. / fse3t(ji,jj,jk) 344 ! vertical advective trends 345 zta = - ze3tr * ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) ) 345 zta = - ze3tr * ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) ) ! vertical advective trends 346 346 zsa = - ze3tr * ( zww(ji,jj,jk) - zww(ji,jj,jk+1) ) 347 ! add it to the general tracer trends 348 ta(ji,jj,jk) = ta(ji,jj,jk) + zta 347 ta(ji,jj,jk) = ta(ji,jj,jk) + zta ! add it to the general tracer trends 349 348 sa(ji,jj,jk) = sa(ji,jj,jk) + zsa 350 349 END DO … … 354 353 ! ! =============== 355 354 356 ! Save the vertical advective trends for diagnostic 355 ! 3. Save the vertical advective trends for diagnostic 356 ! ---------------------------------------------------- 357 357 IF( l_trdtra ) THEN 358 358 ! Recompute the vertical advection zta & zsa trends computed -
trunk/NEMO/OPA_SRC/ice_oce.F90
r709 r717 39 39 fcalving !: Iceberg calving 40 40 # endif 41 42 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: field exchanges with ice model to ocean43 sst_io, sss_io , & !: sea surface temperature (C) and salinity (PSU)44 u_io , v_io , & !: velocity at ice surface (m/s)45 fsolar, fnsolar, & !: solar and non-solar heat fluxes (W/m2)46 fsalt , fmass , & !: salt and freshwater fluxes47 ftaux , ftauy , & !: wind stresses48 gtaux , gtauy !: wind stresses49 41 50 42 REAL(wp), PUBLIC :: & !: … … 59 51 #endif 60 52 61 INTEGER, PUBLIC :: & !: namdom : space/time domain (namlist)62 nfice = 5 !: coupling frequency OPA ICELLN nfice63 64 53 !!---------------------------------------------------------------------- 65 54 END MODULE ice_oce -
trunk/NEMO/OPA_SRC/lbclnk.F90
r699 r717 329 329 330 330 331 SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp )331 SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval ) 332 332 !!--------------------------------------------------------------------- 333 333 !! *** ROUTINE lbc_lnk_3d *** … … 355 355 CHARACTER(len=3), INTENT( in ), OPTIONAL :: & 356 356 cd_mpp ! fill the overlap area only (here do nothing) 357 REAL(wp) , INTENT(in ), OPTIONAL :: pval ! background value (used at closed boundaries) 357 358 358 359 !! * Local declarations 359 360 INTEGER :: ji, jk 360 361 INTEGER :: ijt, iju 362 REAL(wp) :: zland 361 363 !!---------------------------------------------------------------------- 362 364 !! OPA 9.0 , LOCEAN-IPSL (2005) … … 365 367 !!---------------------------------------------------------------------- 366 368 367 IF (PRESENT(cd_mpp)) THEN 369 IF( PRESENT( pval ) ) THEN ! set land value (zero by default) 370 zland = pval 371 ELSE 372 zland = 0.e0 373 ENDIF 374 375 376 IF( PRESENT( cd_mpp ) ) THEN 368 377 ! only fill the overlap area and extra allows 369 378 ! this is in mpp case. In this module, just do nothing … … 385 394 SELECT CASE ( cd_type ) 386 395 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 387 pt3d( 1 ,:,jk) = 0.e0388 pt3d(jpi,:,jk) = 0.e0389 CASE ( 'F' ) ! F-point 390 pt3d(jpi,:,jk) = 0.e0396 pt3d( 1 ,:,jk) = zland 397 pt3d(jpi,:,jk) = zland 398 CASE ( 'F' ) ! F-point 399 pt3d(jpi,:,jk) = zland 391 400 END SELECT 392 401 … … 402 411 CASE ( 'T' , 'U' , 'W' ) ! T-, U-, W-points 403 412 pt3d(:, 1 ,jk) = pt3d(:,3,jk) 404 pt3d(:,jpj,jk) = 0.e0413 pt3d(:,jpj,jk) = zland 405 414 CASE ( 'V' , 'F' ) ! V-, F-points 406 415 pt3d(:, 1 ,jk) = psgn * pt3d(:,2,jk) 407 pt3d(:,jpj,jk) = 0.e0416 pt3d(:,jpj,jk) = zland 408 417 END SELECT 409 418 410 419 CASE ( 3 , 4 ) ! * North fold T-point pivot 411 420 412 pt3d( 1 ,jpj,jk) = 0.e0413 pt3d(jpi,jpj,jk) = 0.e0421 pt3d( 1 ,jpj,jk) = zland 422 pt3d(jpi,jpj,jk) = zland 414 423 415 424 SELECT CASE ( cd_type ) … … 417 426 DO ji = 2, jpi 418 427 ijt = jpi-ji+2 419 pt3d(ji, 1 ,jk) = 0.e0428 pt3d(ji, 1 ,jk) = zland 420 429 pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-2,jk) 421 430 END DO … … 427 436 DO ji = 1, jpi-1 428 437 iju = jpi-ji+1 429 pt3d(ji, 1 ,jk) = 0.e0438 pt3d(ji, 1 ,jk) = zland 430 439 pt3d(ji,jpj,jk) = psgn * pt3d(iju,jpj-2,jk) 431 440 END DO … … 437 446 DO ji = 2, jpi 438 447 ijt = jpi-ji+2 439 pt3d(ji, 1 ,jk) = 0.e0448 pt3d(ji, 1 ,jk) = zland 440 449 pt3d(ji,jpj-1,jk) = psgn * pt3d(ijt,jpj-2,jk) 441 450 pt3d(ji,jpj ,jk) = psgn * pt3d(ijt,jpj-3,jk) … … 451 460 CASE ( 5 , 6 ) ! * North fold F-point pivot 452 461 453 pt3d( 1 ,jpj,jk) = 0.e0454 pt3d(jpi,jpj,jk) = 0.e0462 pt3d( 1 ,jpj,jk) = zland 463 pt3d(jpi,jpj,jk) = zland 455 464 456 465 SELECT CASE ( cd_type ) … … 458 467 DO ji = 1, jpi 459 468 ijt = jpi-ji+1 460 pt3d(ji, 1 ,jk) = 0.e0469 pt3d(ji, 1 ,jk) = zland 461 470 pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-1,jk) 462 471 END DO … … 464 473 DO ji = 1, jpi-1 465 474 iju = jpi-ji 466 pt3d(ji, 1 ,jk) = 0.e0475 pt3d(ji, 1 ,jk) = zland 467 476 pt3d(ji,jpj,jk) = psgn * pt3d(iju,jpj-1,jk) 468 477 END DO … … 470 479 DO ji = 1, jpi 471 480 ijt = jpi-ji+1 472 pt3d(ji, 1 ,jk) = 0.e0481 pt3d(ji, 1 ,jk) = zland 473 482 pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-2,jk) 474 483 END DO … … 492 501 SELECT CASE ( cd_type ) 493 502 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 494 pt3d(:, 1 ,jk) = 0.e0495 pt3d(:,jpj,jk) = 0.e0496 CASE ( 'F' ) ! F-point 497 pt3d(:,jpj,jk) = 0.e0503 pt3d(:, 1 ,jk) = zland 504 pt3d(:,jpj,jk) = zland 505 CASE ( 'F' ) ! F-point 506 pt3d(:,jpj,jk) = zland 498 507 END SELECT 499 508 … … 506 515 507 516 508 SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp )517 SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 509 518 !!--------------------------------------------------------------------- 510 519 !! *** ROUTINE lbc_lnk_2d *** … … 532 541 CHARACTER(len=3), INTENT( in ), OPTIONAL :: & 533 542 cd_mpp ! fill the overlap area only (here do nothing) 543 REAL(wp) , INTENT(in ), OPTIONAL :: pval ! background value (used at closed boundaries) 534 544 535 545 !! * Local declarations 536 546 INTEGER :: ji 537 547 INTEGER :: ijt, iju 548 REAL(wp) :: zland 538 549 !!---------------------------------------------------------------------- 539 !! OPA 8.5, LODYC-IPSL (2002) 540 !!---------------------------------------------------------------------- 550 551 IF( PRESENT( pval ) ) THEN ! set land value (zero by default) 552 zland = pval 553 ELSE 554 zland = 0.e0 555 ENDIF 541 556 542 557 IF (PRESENT(cd_mpp)) THEN … … 556 571 SELECT CASE ( cd_type ) 557 572 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 558 pt2d( 1 ,:) = 0.e0559 pt2d(jpi,:) = 0.e0573 pt2d( 1 ,:) = zland 574 pt2d(jpi,:) = zland 560 575 CASE ( 'F' ) ! F-point, ice U-V point 561 pt2d(jpi,:) = 0.e0576 pt2d(jpi,:) = zland 562 577 CASE ( 'I' ) ! F-point, ice U-V point 563 pt2d( 1 ,:) = 0.e0564 pt2d(jpi,:) = 0.e0578 pt2d( 1 ,:) = zland 579 pt2d(jpi,:) = zland 565 580 END SELECT 566 581 … … 576 591 CASE ( 'T' , 'U' , 'W' ) ! T-, U-, W-points 577 592 pt2d(:, 1 ) = pt2d(:,3) 578 pt2d(:,jpj) = 0.e0593 pt2d(:,jpj) = zland 579 594 CASE ( 'V' , 'F' , 'I' ) ! V-, F-points, ice U-V point 580 595 pt2d(:, 1 ) = psgn * pt2d(:,2) 581 pt2d(:,jpj) = 0.e0596 pt2d(:,jpj) = zland 582 597 END SELECT 583 598 584 599 CASE ( 3 , 4 ) ! * North fold T-point pivot 585 600 586 pt2d( 1 , 1 ) = 0.e0!!!!! bug gm ??? !Edmee587 pt2d( 1 ,jpj) = 0.e0588 pt2d(jpi,jpj) = 0.e0601 pt2d( 1 , 1 ) = zland !!!!! bug gm ??? !Edmee 602 pt2d( 1 ,jpj) = zland 603 pt2d(jpi,jpj) = zland 589 604 590 605 SELECT CASE ( cd_type ) … … 593 608 DO ji = 2, jpi 594 609 ijt = jpi-ji+2 595 pt2d(ji, 1 ) = 0.e0610 pt2d(ji, 1 ) = zland 596 611 pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-2) 597 612 END DO … … 604 619 DO ji = 1, jpi-1 605 620 iju = jpi-ji+1 606 pt2d(ji, 1 ) = 0.e0621 pt2d(ji, 1 ) = zland 607 622 pt2d(ji,jpj) = psgn * pt2d(iju,jpj-2) 608 623 END DO … … 615 630 DO ji = 2, jpi 616 631 ijt = jpi-ji+2 617 pt2d(ji, 1 ) = 0.e0632 pt2d(ji, 1 ) = zland 618 633 pt2d(ji,jpj-1) = psgn * pt2d(ijt,jpj-2) 619 634 pt2d(ji,jpj ) = psgn * pt2d(ijt,jpj-3) … … 628 643 629 644 CASE ( 'I' ) ! ice U-V point 630 pt2d(:, 1 ) = 0.e0645 pt2d(:, 1 ) = zland 631 646 pt2d(2,jpj) = psgn * pt2d(3,jpj-1) 632 647 DO ji = 3, jpi … … 639 654 CASE ( 5 , 6 ) ! * North fold F-point pivot 640 655 641 pt2d( 1 , 1 ) = 0.e0!!bug ???642 pt2d( 1 ,jpj) = 0.e0643 pt2d(jpi,jpj) = 0.e0656 pt2d( 1 , 1 ) = zland !!bug ??? 657 pt2d( 1 ,jpj) = zland 658 pt2d(jpi,jpj) = zland 644 659 645 660 SELECT CASE ( cd_type ) … … 648 663 DO ji = 1, jpi 649 664 ijt = jpi-ji+1 650 pt2d(ji, 1 ) = 0.e0665 pt2d(ji, 1 ) = zland 651 666 pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-1) 652 667 END DO … … 655 670 DO ji = 1, jpi-1 656 671 iju = jpi-ji 657 pt2d(ji, 1 ) = 0.e0672 pt2d(ji, 1 ) = zland 658 673 pt2d(ji,jpj) = psgn * pt2d(iju,jpj-1) 659 674 END DO … … 662 677 DO ji = 1, jpi 663 678 ijt = jpi-ji+1 664 pt2d(ji, 1 ) = 0.e0679 pt2d(ji, 1 ) = zland 665 680 pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-2) 666 681 END DO … … 681 696 682 697 CASE ( 'I' ) ! ice U-V point 683 pt2d( : , 1 ) = 0.e0684 pt2d( 2 ,jpj) = 0.e0698 pt2d( : , 1 ) = zland 699 pt2d( 2 ,jpj) = zland 685 700 DO ji = 2 , jpim1 686 701 ijt = jpi - ji + 2 … … 694 709 SELECT CASE ( cd_type ) 695 710 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 696 pt2d(:, 1 ) = 0.e0697 pt2d(:,jpj) = 0.e0711 pt2d(:, 1 ) = zland 712 pt2d(:,jpj) = zland 698 713 CASE ( 'F' ) ! F-point 699 pt2d(:,jpj) = 0.e0714 pt2d(:,jpj) = zland 700 715 CASE ( 'I' ) ! ice U-V point 701 pt2d(:, 1 ) = 0.e0702 pt2d(:,jpj) = 0.e0716 pt2d(:, 1 ) = zland 717 pt2d(:,jpj) = zland 703 718 END SELECT 704 719 -
trunk/NEMO/OPA_SRC/lib_mpp.F90
r699 r717 597 597 #endif 598 598 599 SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp )599 SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp, pval ) 600 600 !!---------------------------------------------------------------------- 601 601 !! *** routine mpp_lnk_3d *** … … 632 632 CHARACTER(len=3), INTENT( in ), OPTIONAL :: & 633 633 cd_mpp ! fill the overlap area only 634 REAL(wp) , INTENT(in ), OPTIONAL :: pval ! background value (used at closed boundaries) 634 635 635 636 !! * Local variables … … 638 639 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 639 640 INTEGER :: ml_stat(MPI_STATUS_SIZE) ! for key_mpi_isend 641 REAL(wp) :: zland 640 642 !!---------------------------------------------------------------------- 641 643 642 644 ! 1. standard boundary treatment 643 645 ! ------------------------------ 646 647 IF( PRESENT( pval ) ) THEN ! set land value (zero by default) 648 zland = pval 649 ELSE 650 zland = 0.e0 651 ENDIF 644 652 645 653 IF( PRESENT( cd_mpp ) ) THEN … … 662 670 SELECT CASE ( cd_type ) 663 671 CASE ( 'T', 'U', 'V', 'W' ) 664 ptab( 1 :jpreci,:,:) = 0.e0665 ptab(nlci-jpreci+1:jpi ,:,:) = 0.e0672 ptab( 1 :jpreci,:,:) = zland 673 ptab(nlci-jpreci+1:jpi ,:,:) = zland 666 674 CASE ( 'F' ) 667 ptab(nlci-jpreci+1:jpi ,:,:) = 0.e0675 ptab(nlci-jpreci+1:jpi ,:,:) = zland 668 676 END SELECT 669 677 ENDIF … … 673 681 SELECT CASE ( cd_type ) 674 682 CASE ( 'T', 'U', 'V', 'W' ) 675 ptab(:, 1 :jprecj,:) = 0.e0676 ptab(:,nlcj-jprecj+1:jpj ,:) = 0.e0683 ptab(:, 1 :jprecj,:) = zland 684 ptab(:,nlcj-jprecj+1:jpj ,:) = zland 677 685 CASE ( 'F' ) 678 ptab(:,nlcj-jprecj+1:jpj ,:) = 0.e0686 ptab(:,nlcj-jprecj+1:jpj ,:) = zland 679 687 END SELECT 680 688 … … 1050 1058 1051 1059 1052 SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp )1060 SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 1053 1061 !!---------------------------------------------------------------------- 1054 1062 !! *** routine mpp_lnk_2d *** … … 1084 1092 CHARACTER(len=3), INTENT( in ), OPTIONAL :: & 1085 1093 cd_mpp ! fill the overlap area only 1094 REAL(wp) , INTENT(in ), OPTIONAL :: pval ! background value (used at closed boundaries) 1086 1095 1087 1096 !! * Local variables … … 1092 1101 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 1093 1102 INTEGER :: ml_stat(MPI_STATUS_SIZE) ! for key_mpi_isend 1103 REAL(wp) :: zland 1094 1104 !!---------------------------------------------------------------------- 1105 1106 IF( PRESENT( pval ) ) THEN ! set land value (zero by default) 1107 zland = pval 1108 ELSE 1109 zland = 0.e0 1110 ENDIF 1095 1111 1096 1112 ! 1. standard boundary treatment … … 1115 1131 SELECT CASE ( cd_type ) 1116 1132 CASE ( 'T', 'U', 'V', 'W' , 'I' ) 1117 pt2d( 1 :jpreci,:) = 0.e01118 pt2d(nlci-jpreci+1:jpi ,:) = 0.e01133 pt2d( 1 :jpreci,:) = zland 1134 pt2d(nlci-jpreci+1:jpi ,:) = zland 1119 1135 CASE ( 'F' ) 1120 pt2d(nlci-jpreci+1:jpi ,:) = 0.e01136 pt2d(nlci-jpreci+1:jpi ,:) = zland 1121 1137 END SELECT 1122 1138 ENDIF … … 1126 1142 SELECT CASE ( cd_type ) 1127 1143 CASE ( 'T', 'U', 'V', 'W' , 'I' ) 1128 pt2d(:, 1 :jprecj) = 0.e01129 pt2d(:,nlcj-jprecj+1:jpj ) = 0.e01144 pt2d(:, 1 :jprecj) = zland 1145 pt2d(:,nlcj-jprecj+1:jpj ) = zland 1130 1146 CASE ( 'F' ) 1131 pt2d(:,nlcj-jprecj+1:jpj ) = 0.e01147 pt2d(:,nlcj-jprecj+1:jpj ) = zland 1132 1148 END SELECT 1133 1149 … … 1394 1410 1395 1411 CASE ( 'I' ) ! ice U-V point 1396 pt2d( 2 ,nlcj) = 0.e01412 pt2d( 2 ,nlcj) = zland 1397 1413 DO ji = 2 , nlci-1 1398 1414 ijt = iloc - ji + 2 -
trunk/NEMO/OPA_SRC/opa.F90
r709 r717 309 309 #endif 310 310 311 CALL flx_init ! Thermohaline forcing initialization312 313 CALL flx_fwb_init ! FreshWater Budget correction314 315 311 CALL dia_ptr_init ! Poleward TRansports initialization 316 312 -
trunk/NEMO/OPA_SRC/restart.F90
r709 r717 19 19 USE phycst ! physical constants 20 20 USE daymod ! calendar 21 USE ice_oce ! ice variables22 21 USE cpl_oce, ONLY : lk_cpl ! 23 22 USE in_out_manager ! I/O manager … … 138 137 CALL iom_rstput( kt, nitrst, numrow, 'rotn' , rotn ) 139 138 CALL iom_rstput( kt, nitrst, numrow, 'hdivn' , hdivn ) 140 141 #if defined key_ice_lim142 CALL iom_rstput( kt, nitrst, numrow, 'nfice' , REAL( nfice, wp) ) ! ice computation frequency143 CALL iom_rstput( kt, nitrst, numrow, 'sst_io' , sst_io )144 CALL iom_rstput( kt, nitrst, numrow, 'sss_io' , sss_io )145 CALL iom_rstput( kt, nitrst, numrow, 'u_io' , u_io )146 CALL iom_rstput( kt, nitrst, numrow, 'v_io' , v_io )147 # if defined key_coupled148 CALL iom_rstput( kt, nitrst, numrow, 'alb_ice', alb_ice )149 # endif150 #endif151 #if defined key_flx_bulk_monthly || defined key_flx_bulk_daily || defined key_flx_core152 CALL iom_rstput( kt, nitrst, numrow, 'nfbulk' , REAL( nfbulk, wp) ) ! bulk computation frequency153 CALL iom_rstput( kt, nitrst, numrow, 'gsst' , gsst )154 #endif155 139 156 140 IF( nn_dynhpg_rst == 1 .OR. lk_vvl ) THEN … … 204 188 !! has been stored in the restart file. 205 189 !!---------------------------------------------------------------------- 206 REAL(wp) :: zcoef, zkt, zrdt, zrdttra1, zndastp , znfice, znfbulk190 REAL(wp) :: zcoef, zkt, zrdt, zrdttra1, zndastp 207 191 #if defined key_ice_lim 208 192 INTEGER :: ji, jj … … 299 283 ENDIF 300 284 301 !!sm: TO BE MOVED IN NEW SURFACE MODULE...302 303 #if defined key_ice_lim304 ! Louvain La Neuve Sea Ice Model305 IF( iom_varid( numror, 'nfice' ) > 0 ) then306 CALL iom_get( numror , 'nfice' , znfice ) ! ice computation frequency307 CALL iom_get( numror, jpdom_autoglo, 'sst_io' , sst_io )308 CALL iom_get( numror, jpdom_autoglo, 'sss_io' , sss_io )309 CALL iom_get( numror, jpdom_autoglo, 'u_io' , u_io )310 CALL iom_get( numror, jpdom_autoglo, 'v_io' , v_io )311 # if defined key_coupled312 CALL iom_get( numror, jpdom_autoglo, 'alb_ice', alb_ice )313 # endif314 IF( znfice /= REAL( nfice, wp ) ) THEN ! if nfice changed between 2 runs315 zcoef = REAL( nfice-1, wp ) / znfice316 sst_io(:,:) = zcoef * sst_io(:,:)317 sss_io(:,:) = zcoef * sss_io(:,:)318 u_io (:,:) = zcoef * u_io (:,:)319 v_io (:,:) = zcoef * v_io (:,:)320 ENDIF321 ELSE322 IF(lwp) WRITE(numout,*)323 IF(lwp) WRITE(numout,*) 'rst_read : LLN sea Ice Model => Ice initialization'324 IF(lwp) WRITE(numout,*)325 zcoef = REAL( nfice-1, wp )326 sst_io(:,:) = zcoef *( tn(:,:,1) + rt0 ) !!bug a explanation is needed here!327 sss_io(:,:) = zcoef * sn(:,:,1)328 zcoef = 0.5 * REAL( nfice-1, wp )329 DO jj = 2, jpj330 DO ji = fs_2, jpi ! vector opt.331 u_io(ji,jj) = zcoef * ( un(ji-1,jj ,1) + un(ji-1,jj-1,1) )332 v_io(ji,jj) = zcoef * ( vn(ji ,jj-1,1) + vn(ji-1,jj-1,1) )333 END DO334 END DO335 # if defined key_coupled336 alb_ice(:,:) = 0.8 * tmask(:,:,1)337 # endif338 ENDIF339 #endif340 #if defined key_flx_bulk_monthly || defined key_flx_bulk_daily || defined key_flx_core341 ! Louvain La Neuve Sea Ice Model342 IF( iom_varid( numror, 'nfbulk' ) > 0 ) THEN343 CALL iom_get( numror , 'nfbulk', znfbulk ) ! bulk computation frequency344 CALL iom_get( numror, jpdom_autoglo, 'gsst' , gsst )345 IF( znfbulk /= REAL(nfbulk, wp) ) THEN ! if you change nfbulk between 2 runs346 zcoef = REAL( nfbulk-1, wp ) / znfbulk347 gsst(:,:) = zcoef * gsst(:,:)348 ENDIF349 ELSE350 IF(lwp) WRITE(numout,*)351 IF(lwp) WRITE(numout,*) 'rst_read : LLN sea Ice Model => Ice initialization'352 IF(lwp) WRITE(numout,*)353 gsst(:,:) = REAL( nfbulk - 1, wp )*( tn(:,:,1) + rt0 )354 ENDIF355 #endif356 357 !!sm: end of TO BE MOVED IN NEW SURFACE MODULE...358 359 285 IF( iom_varid( numror, 'rhd' ) > 0 ) THEN 360 286 CALL iom_get( numror, jpdom_autoglo, 'rhd' , rhd )
Note: See TracChangeset
for help on using the changeset viewer.
