Changeset 7510 for branches/2016
- Timestamp:
- 2016-12-19T16:20:16+01:00 (7 years ago)
- Location:
- branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM
- Files:
-
- 21 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef.xml
r6316 r7510 61 61 <file id="file2" name_suffix="_SBC" description="surface fluxes variables" > <!-- time step automaticaly defined based on nn_fsbc --> 62 62 <field field_ref="empmr" name="wfo" /> 63 64 63 <field field_ref="emp_oce" name="emp_oce" long_name="Evap minus Precip over ocean" /> 64 <field field_ref="emp_ice" name="emp_ice" long_name="Evap minus Precip over ice" /> 65 65 <field field_ref="qsr_oce" name="qsr_oce" /> 66 66 <field field_ref="qns_oce" name="qns_oce" /> -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/CONFIG/SHARED/field_def.xml
r6970 r7510 507 507 <field id="bgheatco" long_name="drift in global mean heat content wrt timestep 1" unit="1.e20J" /> 508 508 <field id="bgheatfx" long_name="drift in global mean heat flux wrt timestep 1" unit="W/m2" /> 509 <field id="bgsaltco" long_name="drift in global mean salt content wrt timestep 1" unit="1e-3*km3" />509 <field id="bgsaltco" long_name="drift in global mean salt content wrt timestep 1" unit="1e-3*km3" /> 510 510 <field id="bgvolssh" long_name="drift in global mean ssh volume wrt timestep 1" unit="km3" /> 511 511 <field id="bgvole3t" long_name="drift in global mean volume variation (e3t) wrt timestep 1" unit="km3" /> -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
r7060 r7510 5 5 !!====================================================================== 6 6 !! History : 2.0 ! 2004-01 (C. Ethe, G. Madec) Original code 7 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation7 !! 3.0 ! 2011-02 (G. Madec) dynamical allocation 8 8 !! - ! 2014 (C. Rousset) add N/S initializations 9 9 !!---------------------------------------------------------------------- … … 24 24 USE par_oce ! ocean parameters 25 25 USE limvar ! lim_var_salprof 26 ! 26 27 USE in_out_manager ! I/O manager 27 28 USE lib_mpp ! MPP library … … 31 32 USE iom 32 33 33 !!!clem34 !! USE diawri35 !!!36 37 34 IMPLICIT NONE 38 35 PRIVATE … … 61 58 !! ** Purpose : defined the sea-ice initial state 62 59 !! 63 !! ** Method : 64 !! This routine will put some ice where ocean 60 !! ** Method : This routine will put some ice where ocean 65 61 !! is at the freezing point, then fill in ice 66 62 !! state variables using prescribed initial 67 63 !! values in the namelist 68 64 !! 69 !! ** Steps : 70 !! 1) Read namelist 65 !! ** Steps : 1) Read namelist 71 66 !! 2) Basal temperature; ice and hemisphere masks 72 67 !! 3) Fill in the ice thickness distribution using gaussian … … 83 78 !! 4.0 ! 09-11 (M. Vancoppenolle) Enhanced version for ice cats 84 79 !!-------------------------------------------------------------------- 85 86 !! * Local variables 87 INTEGER :: ji, jj, jk, jl ! dummy loop indices 88 REAL(wp) :: ztmelts, zdh 89 INTEGER :: i_hemis, i_fill, jl0 80 INTEGER :: ji, jj, jk, jl ! dummy loop indices 81 REAL(wp) :: ztmelts, zdh 82 INTEGER :: i_hemis, i_fill, jl0 90 83 REAL(wp) :: zarg, zV, zconv, zdv 91 84 REAL(wp), POINTER, DIMENSION(:,:) :: zswitch ! ice indicator … … 102 95 103 96 IF(lwp) WRITE(numout,*) 104 IF(lwp) WRITE(numout,*) 'lim_istate : Ice initialization '105 IF(lwp) WRITE(numout,*) '~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~'97 IF(lwp) WRITE(numout,*) 'lim_istate : sea-ice initialization ' 98 IF(lwp) WRITE(numout,*) '~~~~~~~~~~ ' 106 99 107 100 !-------------------------------------------------------------------- 108 101 ! 1) Read namelist 109 102 !-------------------------------------------------------------------- 103 ! 110 104 CALL lim_istate_init 111 105 … … 125 119 !-------------------------------------------------------------------- 126 120 IF( ln_limini ) THEN 127 121 ! 128 122 IF( ln_limini_file )THEN 129 123 ! 130 124 zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) 131 125 zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) … … 134 128 ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) 135 129 zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) 136 130 ! 137 131 WHERE( zat_i_ini(:,:) > 0._wp ) ; zswitch(:,:) = tmask(:,:,1) 138 132 ELSEWHERE ; zswitch(:,:) = 0._wp 139 133 END WHERE 140 134 ! 141 135 ELSE ! ln_limini_file = F 142 136 … … 172 166 END DO 173 167 END DO 174 168 ! 175 169 ENDIF ! ln_limini_file 176 170 … … 184 178 zh_i_ini(:,:,:) = 0._wp 185 179 za_i_ini(:,:,:) = 0._wp 186 180 ! 187 181 DO jj = 1, jpj 188 182 DO ji = 1, jpi 189 183 ! 190 184 IF( zat_i_ini(ji,jj) > 0._wp .AND. zht_i_ini(ji,jj) > 0._wp )THEN 191 185 … … 198 192 ENDIF 199 193 END DO 200 194 ! 201 195 ! initialisation of tests 202 196 itest(:) = 0 … … 211 205 za_i_ini(ji,jj,:) = 0._wp 212 206 itest(:) = 0 213 207 ! 214 208 ! *** case very thin ice: fill only category 1 215 209 IF ( i_fill == 1 ) THEN … … 224 218 zh_i_ini(ji,jj,jl) = hi_mean(jl) 225 219 END DO 226 220 ! 227 221 !--- Concentrations 228 222 za_i_ini(ji,jj,jl0) = zat_i_ini(ji,jj) / SQRT(REAL(jpl)) … … 233 227 ENDIF 234 228 END DO 235 229 ! 236 230 ! Concentration in the last (i_fill) category 237 231 za_i_ini(ji,jj,i_fill) = zat_i_ini(ji,jj) - SUM( za_i_ini(ji,jj,1:i_fill-1) ) … … 254 248 ENDDO 255 249 ENDIF 256 250 ! 257 251 ENDIF ! case ice is thick or thin 258 252 … … 280 274 END DO ! end iteration on categories 281 275 ! !============================ 282 276 ! 283 277 IF( lwp .AND. SUM(itest) /= 4 ) THEN 284 278 WRITE(numout,*) … … 292 286 293 287 ENDIF ! zat_i_ini(ji,jj) > 0._wp .AND. zht_i_ini(ji,jj) > 0._wp 294 295 END DO296 END DO288 ! 289 END DO 290 END DO 297 291 298 292 !--------------------------------------------------------------------- -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r6994 r7510 23 23 !! lim_sbc_tau : update i- and j-stresses, and its modulus at the ocean surface 24 24 !!---------------------------------------------------------------------- 25 USE par_oce ! ocean parameters 26 USE phycst ! physical constants 27 USE dom_oce ! ocean domain 28 USE ice ! LIM sea-ice variables 29 USE sbc_ice ! Surface boundary condition: sea-ice fields 30 USE sbc_oce ! Surface boundary condition: ocean fields 31 USE sbccpl 32 USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 33 USE albedo ! albedo parameters 34 USE lbclnk ! ocean lateral boundary condition - MPP exchanges 35 USE lib_mpp ! MPP library 36 USE wrk_nemo ! work arrays 37 USE in_out_manager ! I/O manager 38 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 39 USE traqsr ! add penetration of solar flux in the calculation of heat budget 40 USE iom 41 USE domvvl ! Variable volume 42 USE limctl 43 USE limcons 25 USE par_oce ! ocean parameters 26 USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 27 USE phycst ! physical constants 28 USE dom_oce ! ocean domain 29 USE ice ! LIM sea-ice variables 30 USE sbc_ice ! Surface boundary condition: sea-ice fields 31 USE sbc_oce ! Surface boundary condition: ocean fields 32 USE sbccpl ! Surface boundary condition: coupled interface 33 USE albedo ! albedo parameters 34 USE traqsr ! add penetration of solar flux in the calculation of heat budget 35 USE domvvl ! Variable volume 36 USE limctl ! 37 USE limcons ! 38 ! 39 USE in_out_manager ! I/O manager 40 USE iom ! xIO server 41 USE lbclnk ! ocean lateral boundary condition - MPP exchanges 42 USE lib_mpp ! MPP library 43 USE wrk_nemo ! work arrays 44 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 44 45 45 46 IMPLICIT NONE … … 98 99 !! The ref should be Rousset et al., 2015 99 100 !!--------------------------------------------------------------------- 100 INTEGER, INTENT(in) :: kt 101 INTEGER :: ji, jj, jl, jk ! dummy loop indices102 REAL(wp) :: zqmass ! Heat flux associated with mass exchange ice->ocean (W.m-2)103 REAL(wp) :: zq sr ! New solar flux received by the ocean104 !101 INTEGER, INTENT(in) :: kt ! number of iteration 102 ! 103 INTEGER :: ji, jj, jl, jk ! dummy loop indices 104 REAL(wp) :: zqmass ! Heat flux associated with mass exchange ice->ocean (W.m-2) 105 REAL(wp) :: zqsr ! New solar flux received by the ocean 105 106 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_cs, zalb_os ! 3D workspace 106 107 REAL(wp), POINTER, DIMENSION(:,:) :: zalb ! 2D workspace … … 130 131 131 132 CALL wrk_dealloc( jpi,jpj, zalb ) 132 ! 133 133 134 134 DO jj = 1, jpj 135 135 DO ji = 1, jpi … … 208 208 ! Snow/ice albedo (only if sent to coupler, useless in forced mode) ! 209 209 !------------------------------------------------------------------------! 210 CALL wrk_alloc( jpi, jpj, jpl,zalb_cs, zalb_os )210 CALL wrk_alloc( jpi,jpj,jpl, zalb_cs, zalb_os ) 211 211 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 212 212 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 213 CALL wrk_dealloc( jpi, jpj, jpl,zalb_cs, zalb_os )213 CALL wrk_dealloc( jpi,jpj,jpl, zalb_cs, zalb_os ) 214 214 215 215 ! conservation test … … 250 250 INTEGER , INTENT(in) :: kt ! ocean time-step index 251 251 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pu_oce, pv_oce ! surface ocean currents 252 ! !252 ! 253 253 INTEGER :: ji, jj ! dummy loop indices 254 254 REAL(wp) :: zat_u, zutau_ice, zu_t, zmodt ! local scalar … … 306 306 !! ** input : Namelist namicedia 307 307 !!------------------------------------------------------------------- 308 INTEGER :: ji, jj, jk ! dummy loop indices 309 REAL(wp) :: zcoefu, zcoefv, zcoeff ! local scalar 308 INTEGER :: ji, jj, jk ! dummy loop indices 309 REAL(wp) :: zcoefu, zcoefv, zcoeff ! local scalar 310 !!------------------------------------------------------------------- 311 ! 310 312 IF(lwp) WRITE(numout,*) 311 313 IF(lwp) WRITE(numout,*) 'lim_sbc_init : LIM-3 sea-ice - surface boundary condition' … … 365 367 ENDIF ! .NOT. ln_rstart 366 368 ! 367 368 369 END SUBROUTINE lim_sbc_init 369 370 -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r6994 r7510 22 22 USE phycst ! physical constants 23 23 USE dom_oce ! ocean space and time domain variables 24 USE ice ! LIM:sea-ice variables24 USE ice ! sea-ice variables 25 25 USE sbc_oce ! Surface boundary condition: ocean fields 26 26 USE sbc_ice ! Surface boundary condition: ice fields 27 USE thd_ice ! LIMthermodynamic sea-ice variables28 USE limthd_dif ! LIM: thermodynamics,vertical diffusion29 USE limthd_dh ! LIM: thermodynamics, ice and snow thickness variation30 USE limthd_da ! LIM: thermodynamics,lateral melting31 USE limthd_sal ! LIM: thermodynamics,ice salinity32 USE limthd_ent ! LIM: thermodynamics,ice enthalpy redistribution33 USE limthd_lac ! LIM-3lateral accretion27 USE thd_ice ! thermodynamic sea-ice variables 28 USE limthd_dif ! vertical diffusion 29 USE limthd_dh ! ice-snow growth and melt 30 USE limthd_da ! lateral melting 31 USE limthd_sal ! ice salinity 32 USE limthd_ent ! ice enthalpy redistribution 33 USE limthd_lac ! lateral accretion 34 34 USE limitd_th ! remapping thickness distribution 35 USE limtab ! LIM: 1D <==> 2D transformation 36 USE limvar ! LIM: sea-ice variables 35 USE limtab ! 1D <==> 2D transformation 36 USE limvar ! 37 USE limcons ! conservation tests 38 USE limctl ! control print 39 ! 40 USE in_out_manager ! I/O manager 37 41 USE lbclnk ! lateral boundary condition - MPP links 38 42 USE lib_mpp ! MPP library 39 43 USE wrk_nemo ! work arrays 40 USE in_out_manager ! I/O manager41 44 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 42 45 USE timing ! Timing 43 USE limcons ! conservation tests44 USE limctl45 46 46 47 IMPLICIT NONE … … 80 81 !!--------------------------------------------------------------------- 81 82 INTEGER, INTENT(in) :: kt ! number of iteration 82 ! !83 ! 83 84 INTEGER :: ji, jj, jk, jl ! dummy loop indices 84 85 INTEGER :: nbpb ! nb of icy pts for vertical thermo calculations 85 INTEGER :: ii, ij ! temporary dummy loop index86 86 REAL(wp) :: zfric_u, zqld, zqfr 87 87 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b … … 92 92 !!------------------------------------------------------------------- 93 93 94 IF( nn_timing == 1 ) CALL timing_start('limthd')94 IF( nn_timing == 1 ) CALL timing_start('limthd') 95 95 96 96 CALL wrk_alloc( jpi,jpj, zu_io, zv_io, zfric ) … … 224 224 END DO 225 225 END DO 226 226 227 227 !------------------------------------------------------------------------------! 228 228 ! Thermodynamic computation (only on grid points covered by ice) 229 229 !------------------------------------------------------------------------------! 230 230 231 DO jl = 1, jpl !loop over ice categories 231 232 … … 358 359 !!------------------------------------------------------------------- 359 360 INTEGER, INTENT(in) :: kideb, kiut ! bounds for the spatial loop 360 ! !361 ! 361 362 INTEGER :: ji, jk ! dummy loop indices 362 363 REAL(wp) :: ztmelts, zaaa, zbbb, zccc, zdiscrim ! local scalar … … 378 379 END DO 379 380 END DO 380 381 ! 381 382 END SUBROUTINE lim_thd_temp 383 382 384 383 385 SUBROUTINE lim_thd_lam( kideb, kiut ) … … 389 391 !!----------------------------------------------------------------------- 390 392 INTEGER, INTENT(in) :: kideb, kiut ! bounds for the spatial loop 391 INTEGER :: ji ! dummy loop indices 392 REAL(wp) :: zhi_bef ! ice thickness before thermo 393 REAL(wp) :: zdh_mel, zda_mel ! net melting 394 REAL(wp) :: zvi, zvs ! ice/snow volumes 395 393 ! 394 INTEGER :: ji ! dummy loop indices 395 REAL(wp) :: zhi_bef ! ice thickness before thermo 396 REAL(wp) :: zdh_mel, zda_mel ! net melting 397 REAL(wp) :: zvi, zvs ! ice/snow volumes 398 !!----------------------------------------------------------------------- 399 ! 396 400 DO ji = kideb, kiut 397 401 zdh_mel = MIN( 0._wp, dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) + dh_i_sub(ji) ) … … 411 415 END IF 412 416 END DO 413 417 ! 414 418 END SUBROUTINE lim_thd_lam 419 415 420 416 421 SUBROUTINE lim_thd_1d2d( nbpb, jl, kn ) … … 420 425 !! ** Purpose : move arrays from 1d to 2d and the reverse 421 426 !!----------------------------------------------------------------------- 422 INTEGER, INTENT(in) :: kn ! 1= from 2D to 1D 423 ! 2= from 1D to 2D 427 INTEGER, INTENT(in) :: kn ! 1= from 2D to 1D ; 2= from 1D to 2D 424 428 INTEGER, INTENT(in) :: nbpb ! size of 1D arrays 425 429 INTEGER, INTENT(in) :: jl ! ice cat 430 ! 426 431 INTEGER :: jk ! dummy loop indices 427 432 !!----------------------------------------------------------------------- 433 ! 428 434 SELECT CASE( kn ) 429 430 CASE( 1 ) 431 435 ! 436 CASE( 1 ) ! from 2D to 1D 437 ! 432 438 CALL tab_2d_1d( nbpb, at_i_1d (1:nbpb), at_i , jpi, jpj, npb(1:nbpb) ) 433 439 CALL tab_2d_1d( nbpb, a_i_1d (1:nbpb), a_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 434 440 CALL tab_2d_1d( nbpb, ht_i_1d (1:nbpb), ht_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 435 441 CALL tab_2d_1d( nbpb, ht_s_1d (1:nbpb), ht_s(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 436 442 ! 437 443 CALL tab_2d_1d( nbpb, t_su_1d (1:nbpb), t_su(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 438 444 CALL tab_2d_1d( nbpb, sm_i_1d (1:nbpb), sm_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) … … 446 452 CALL tab_2d_1d( nbpb, s_i_1d(1:nbpb,jk), s_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 447 453 END DO 448 454 ! 449 455 CALL tab_2d_1d( nbpb, qprec_ice_1d(1:nbpb), qprec_ice(:,:) , jpi, jpj, npb(1:nbpb) ) 450 456 CALL tab_2d_1d( nbpb, qevap_ice_1d(1:nbpb), qevap_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) … … 461 467 CALL tab_2d_1d( nbpb, qlead_1d (1:nbpb), qlead , jpi, jpj, npb(1:nbpb) ) 462 468 CALL tab_2d_1d( nbpb, fhld_1d (1:nbpb), fhld , jpi, jpj, npb(1:nbpb) ) 463 469 ! 464 470 CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw , jpi, jpj, npb(1:nbpb) ) 465 471 CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub , jpi, jpj, npb(1:nbpb) ) 466 472 ! 467 473 CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog , jpi, jpj, npb(1:nbpb) ) 468 474 CALL tab_2d_1d( nbpb, wfx_bom_1d (1:nbpb), wfx_bom , jpi, jpj, npb(1:nbpb) ) … … 471 477 CALL tab_2d_1d( nbpb, wfx_res_1d (1:nbpb), wfx_res , jpi, jpj, npb(1:nbpb) ) 472 478 CALL tab_2d_1d( nbpb, wfx_spr_1d (1:nbpb), wfx_spr , jpi, jpj, npb(1:nbpb) ) 473 479 ! 474 480 CALL tab_2d_1d( nbpb, sfx_bog_1d (1:nbpb), sfx_bog , jpi, jpj, npb(1:nbpb) ) 475 481 CALL tab_2d_1d( nbpb, sfx_bom_1d (1:nbpb), sfx_bom , jpi, jpj, npb(1:nbpb) ) … … 479 485 CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res , jpi, jpj, npb(1:nbpb) ) 480 486 CALL tab_2d_1d( nbpb, sfx_sub_1d (1:nbpb), sfx_sub , jpi, jpj,npb(1:nbpb) ) 481 487 ! 482 488 CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd , jpi, jpj, npb(1:nbpb) ) 483 489 CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr , jpi, jpj, npb(1:nbpb) ) … … 493 499 CALL tab_2d_1d( nbpb, hfx_err_dif_1d (1:nbpb), hfx_err_dif , jpi, jpj, npb(1:nbpb) ) 494 500 CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) ) 495 496 CASE( 2 ) 497 501 ! 502 CASE( 2 ) ! from 1D to 2D 503 ! 498 504 CALL tab_1d_2d( nbpb, at_i , npb, at_i_1d (1:nbpb) , jpi, jpj ) 499 505 CALL tab_1d_2d( nbpb, ht_i(:,:,jl) , npb, ht_i_1d (1:nbpb) , jpi, jpj ) … … 512 518 END DO 513 519 CALL tab_1d_2d( nbpb, qlead , npb, qlead_1d (1:nbpb) , jpi, jpj ) 514 520 ! 515 521 CALL tab_1d_2d( nbpb, wfx_snw , npb, wfx_snw_1d(1:nbpb) , jpi, jpj ) 516 522 CALL tab_1d_2d( nbpb, wfx_sub , npb, wfx_sub_1d(1:nbpb) , jpi, jpj ) 517 523 ! 518 524 CALL tab_1d_2d( nbpb, wfx_bog , npb, wfx_bog_1d(1:nbpb) , jpi, jpj ) 519 525 CALL tab_1d_2d( nbpb, wfx_bom , npb, wfx_bom_1d(1:nbpb) , jpi, jpj ) … … 522 528 CALL tab_1d_2d( nbpb, wfx_res , npb, wfx_res_1d(1:nbpb) , jpi, jpj ) 523 529 CALL tab_1d_2d( nbpb, wfx_spr , npb, wfx_spr_1d(1:nbpb) , jpi, jpj ) 524 530 ! 525 531 CALL tab_1d_2d( nbpb, sfx_bog , npb, sfx_bog_1d(1:nbpb) , jpi, jpj ) 526 532 CALL tab_1d_2d( nbpb, sfx_bom , npb, sfx_bom_1d(1:nbpb) , jpi, jpj ) … … 530 536 CALL tab_1d_2d( nbpb, sfx_bri , npb, sfx_bri_1d(1:nbpb) , jpi, jpj ) 531 537 CALL tab_1d_2d( nbpb, sfx_sub , npb, sfx_sub_1d(1:nbpb) , jpi, jpj ) 532 538 ! 533 539 CALL tab_1d_2d( nbpb, hfx_thd , npb, hfx_thd_1d(1:nbpb) , jpi, jpj ) 534 540 CALL tab_1d_2d( nbpb, hfx_spr , npb, hfx_spr_1d(1:nbpb) , jpi, jpj ) … … 549 555 ! 550 556 END SELECT 551 557 ! 552 558 END SUBROUTINE lim_thd_1d2d 553 559 … … 580 586 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicethd in configuration namelist', lwp ) 581 587 IF(lwm) WRITE ( numoni, namicethd ) 582 !583 IF ( ( jpl > 1 ) .AND. ( nn_monocat == 1 ) ) THEN584 nn_monocat = 0585 IF(lwp) WRITE(numout, *) ' nn_monocat must be 0 in multi-category case '586 ENDIF587 588 ! 588 589 IF(lwp) THEN ! control print … … 615 616 WRITE(numout,*)' check heat conservation in the ice/snow con_i = ', con_i 616 617 ENDIF 618 IF( jpl > 1 .AND. nn_monocat == 1 ) THEN 619 nn_monocat = 0 620 IF(lwp) WRITE(numout,*) 621 IF(lwp) WRITE(numout,*) ' nn_monocat forced to 0 as jpl>1, i.e. multi-category case is chosen' 622 ENDIF 617 623 ! 618 624 END SUBROUTINE lim_thd_init -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
r6994 r7510 647 647 & - sm_i_1d(ji) * a_i_1d(ji) * dh_snowice(ji) * rhoic * r1_rdtice ! and get rn_icesal from the ocean 648 648 ENDIF 649 649 650 650 ! Contribution to mass flux 651 651 ! All snow is thrown in the ocean, and seawater is taken to replace the volume -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
r6994 r7510 331 331 DO ji = 1, nbpac 332 332 ztmelts = - tmut * zs_newice(ji) + rt0 ! Melting point (K) 333 ze_newice(ji) = rhoic * ( cpic * ( ztmelts - t_bo_1d(ji) ) &333 ze_newice(ji) = rhoic * ( cpic * ( ztmelts - t_bo_1d(ji) ) & 334 334 & + lfus * ( 1.0 - ( ztmelts - rt0 ) / MIN( t_bo_1d(ji) - rt0, -epsi10 ) ) & 335 335 & - rcp * ( ztmelts - rt0 ) ) -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90
r6515 r7510 60 60 !--------------------------------------------------------------------| 61 61 ! do nothing 62 62 63 63 !----------------------------------------------------------------------| 64 64 ! 2) salinity varying in time | -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
r6994 r7510 247 247 END DO 248 248 END DO 249 250 249 250 251 251 IF( MOD( ( kt - 1) / nn_fsbc , 2 ) == 0 ) THEN !== odd ice time step: adv_x then adv_y ==! 252 252 DO jt = 1, initad … … 332 332 END DO 333 333 ENDIF 334 334 335 335 !------------------------------------------- 336 336 ! Recover the properties from their contents … … 348 348 END DO 349 349 END DO 350 350 351 351 at_i(:,:) = a_i(:,:,1) ! total ice fraction 352 352 DO jl = 2, jpl -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90
r6994 r7510 151 151 SUBROUTINE lim_update1 ! Empty routine 152 152 END SUBROUTINE lim_update1 153 153 154 #endif 154 155 -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90
r6994 r7510 192 192 SUBROUTINE lim_update2 ! Empty routine 193 193 END SUBROUTINE lim_update2 194 194 195 #endif 195 196 -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90
r6853 r7510 303 303 sm_i(:,:,:) = rn_icesal 304 304 ENDIF 305 305 306 306 !----------------------------------- 307 307 ! Salinity profile, varying in time … … 641 641 INTEGER , POINTER, DIMENSION(:) :: itest 642 642 643 C allwrk_alloc( 4, itest )643 CALL wrk_alloc( 4, itest ) 644 644 !-------------------------------------------------------------------- 645 645 ! initialisation of variables -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
r6970 r7510 39 39 !!---------------------------------------------------------------------- 40 40 CONTAINS 41 41 42 42 43 SUBROUTINE lim_wri( kindic ) … … 61 62 IF( nn_timing == 1 ) CALL timing_start('limwri') 62 63 63 CALL wrk_alloc( jpi, jpj,jpl, zswi2 )64 CALL wrk_alloc( jpi, jpj, z2d, zswi )64 CALL wrk_alloc( jpi,jpj,jpl, zswi2 ) 65 CALL wrk_alloc( jpi,jpj , z2d, zswi ) 65 66 66 67 !----------------------------- -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90
r6515 r7510 5 5 !!===================================================================== 6 6 !! History : 3.0 ! 2002-11 (C. Ethe) F90: Free form and module 7 !!---------------------------------------------------------------------- 8 #if defined key_lim3 9 !!---------------------------------------------------------------------- 10 !! 'key_lim3' LIM3 sea-ice model 7 11 !!---------------------------------------------------------------------- 8 12 USE in_out_manager ! I/O manager … … 168 172 END FUNCTION thd_ice_alloc 169 173 174 #else 175 !!---------------------------------------------------------------------- 176 !! Default option : Empty module NO LIM sea-ice model 177 !!---------------------------------------------------------------------- 178 CONTAINS 179 SUBROUTINE thd_ice_alloc ! Empty routine 180 END SUBROUTINE thd_ice_alloc 181 #endif 182 170 183 !!====================================================================== 171 184 END MODULE thd_ice -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
r7379 r7510 18 18 USE dom_oce 19 19 USE nemogcm 20 ! 20 !! 21 21 IMPLICIT NONE 22 22 !!---------------------------------------------------------------------- … … 90 90 # if defined key_top 91 91 CALL Agrif_InitValues_cont_top 92 # endif 92 # endif 93 ! 93 94 END SUBROUTINE Agrif_initvalues 94 95 … … 109 110 USE agrif_opa_interp 110 111 USE agrif_opa_sponge 111 ! 112 IMPLICIT NONE 113 ! 114 !!---------------------------------------------------------------------- 115 112 !! 113 IMPLICIT NONE 114 !!---------------------------------------------------------------------- 115 ! 116 116 ! Declaration of the type of variable which have to be interpolated 117 ! ---------------------------------------------------------------------117 ! 118 118 CALL agrif_declare_var_dom 119 119 ! … … 130 130 USE par_oce 131 131 USE oce 132 !! 132 133 IMPLICIT NONE 133 134 !!---------------------------------------------------------------------- … … 178 179 USE agrif_opa_interp 179 180 USE agrif_opa_sponge 180 ! 181 !! 181 182 IMPLICIT NONE 182 183 ! … … 277 278 ENDIF 278 279 ENDIF 280 279 281 ! check if masks and bathymetries match 280 282 IF(ln_chk_bathy) THEN … … 320 322 nbcline = 0 321 323 lk_agrif_doupd = .FALSE. 322 323 324 ! 324 325 END SUBROUTINE Agrif_InitValues_cont … … 335 336 USE oce 336 337 USE agrif_oce 338 !! 337 339 IMPLICIT NONE 338 340 !!---------------------------------------------------------------------- … … 473 475 USE agrif_lim2_interp 474 476 USE lib_mpp 475 ! 476 IMPLICIT NONE 477 ! 477 !! 478 IMPLICIT NONE 478 479 !!---------------------------------------------------------------------- 479 480 … … 510 511 END SUBROUTINE Agrif_InitValues_cont_lim2 511 512 513 512 514 SUBROUTINE agrif_declare_var_lim2 513 515 !!---------------------------------------------------------------------- … … 518 520 USE agrif_util 519 521 USE ice_2 520 522 !! 521 523 IMPLICIT NONE 522 524 !!---------------------------------------------------------------------- … … 662 664 USE agrif_top_interp 663 665 USE agrif_top_sponge 664 ! 666 !! 665 667 IMPLICIT NONE 666 668 ! … … 760 762 USE dom_oce 761 763 USE trc 762 763 IMPLICIT NONE 764 !! 765 IMPLICIT NONE 766 !!---------------------------------------------------------------------- 764 767 765 768 ! 1. Declaration of the type of variable which have to be interpolated … … 792 795 SUBROUTINE Agrif_detect( kg, ksizex ) 793 796 !!---------------------------------------------------------------------- 794 !! *** ROUTINE Agrif_detect *** 795 !!---------------------------------------------------------------------- 796 ! 797 !! *** ROUTINE Agrif_detect *** 798 !!---------------------------------------------------------------------- 797 799 INTEGER, DIMENSION(2) :: ksizex 798 800 INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg … … 807 809 !!---------------------------------------------------------------------- 808 810 !! *** ROUTINE agrif_init *** 809 !! Read by Child model only810 811 !!---------------------------------------------------------------------- 811 812 USE agrif_oce … … 813 814 USE in_out_manager 814 815 USE lib_mpp 816 !! 815 817 IMPLICIT NONE 816 818 ! … … 866 868 !!---------------------------------------------------------------------- 867 869 USE dom_oce 870 !! 868 871 IMPLICIT NONE 869 872 ! … … 880 883 END SUBROUTINE Agrif_InvLoc 881 884 885 882 886 SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax ) 883 887 !!---------------------------------------------------------------------- … … 885 889 !!---------------------------------------------------------------------- 886 890 USE par_oce 891 !! 887 892 IMPLICIT NONE 888 893 ! … … 898 903 END SUBROUTINE Agrif_get_proc_info 899 904 905 900 906 SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost) 901 907 !!---------------------------------------------------------------------- … … 903 909 !!---------------------------------------------------------------------- 904 910 USE par_oce 911 !! 905 912 IMPLICIT NONE 906 913 ! -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90
r6994 r7510 59 59 !! 60 60 !!---------------------------------------------------------------------- 61 INTEGER, INTENT( in ) :: kt ! Main time step counter 62 INTEGER :: ib_bdy ! Loop index 63 61 INTEGER, INTENT( in ) :: kt ! Main time step counter 62 ! 63 INTEGER :: ib_bdy ! Loop index 64 !!---------------------------------------------------------------------- 65 ! 64 66 #if defined key_lim3 65 67 CALL lim_var_glo2eqv 66 68 #endif 67 69 ! 68 70 DO ib_bdy=1, nb_bdy 69 71 ! 70 72 SELECT CASE( cn_ice_lim(ib_bdy) ) 71 73 CASE('none') … … 76 78 CALL ctl_stop( 'bdy_ice_lim : unrecognised option for open boundaries for ice fields' ) 77 79 END SELECT 78 80 ! 79 81 END DO 80 82 ! 81 83 #if defined key_lim3 82 84 CALL lim_var_zapsmall … … 84 86 IF( ln_limctl ) CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' ) 85 87 #endif 86 88 ! 87 89 END SUBROUTINE bdy_ice_lim 90 88 91 89 92 SUBROUTINE bdy_ice_frs( idx, dta, kt, ib_bdy ) -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r7036 r7510 864 864 ! 865 865 END DO 866 866 867 867 CALL wrk_dealloc( jpi,jpj, U_zu, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd ) 868 868 CALL wrk_dealloc( jpi,jpj, zeta_u, stab ) -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r7365 r7510 24 24 USE ice ! LIM-3: ice variables 25 25 USE thd_ice ! LIM-3: thermodynamical variables 26 26 ! 27 27 USE sbc_oce ! Surface boundary condition: ocean fields 28 28 USE sbc_ice ! Surface boundary condition: ice fields … … 32 32 USE sbcana ! Surface boundary condition: analytic formulation 33 33 USE albedo ! ocean & ice albedo 34 34 ! 35 35 USE phycst ! Define parameters for the routines 36 36 USE eosbn2 ! equation of state … … 47 47 USE limupdate2 ! update of global variables 48 48 USE limvar ! Ice variables switch 49 49 USE limctl ! 50 50 USE limistate ! LIM initial state 51 51 USE limthd_sal ! LIM ice thermodynamics: salinity 52 52 ! 53 53 USE c1d ! 1D vertical configuration 54 USE in_out_manager ! I/O manager 55 USE iom ! I/O manager library 56 USE prtctl ! Print control 57 USE lib_fortran ! 54 58 USE lbclnk ! lateral boundary condition - MPP link 55 59 USE lib_mpp ! MPP library 56 60 USE wrk_nemo ! work arrays 57 61 USE timing ! Timing 58 USE iom ! I/O manager library59 USE in_out_manager ! I/O manager60 USE prtctl ! Print control61 USE lib_fortran !62 USE limctl63 62 64 63 #if defined key_bdy … … 76 75 PUBLIC sbc_ice_lim ! routine called by sbcmod.F90 77 76 PUBLIC sbc_lim_init ! routine called by sbcmod.F90 78 77 79 78 !! * Substitutions 80 79 # include "domzgr_substitute.h90" … … 87 86 CONTAINS 88 87 89 !!======================================================================90 91 88 SUBROUTINE sbc_ice_lim( kt, kblk ) 92 89 !!--------------------------------------------------------------------- 93 90 !! *** ROUTINE sbc_ice_lim *** 94 !! 95 !! ** Purpose : update the ocean surface boundary condition via the 96 !! Louvain la Neuve Sea Ice Model time stepping 91 !! 92 !! ** Purpose : update the ocean surface boundary condition via the 93 !! Louvain la Neuve Sea Ice Model time stepping 97 94 !! 98 95 !! ** Method : ice model time stepping 99 !! - call the ice dynamics routine 100 !! - call the ice advection/diffusion routine 101 !! - call the ice thermodynamics routine 102 !! - call the routine that computes mass and 96 !! - call the ice dynamics routine 97 !! - call the ice advection/diffusion routine 98 !! - call the ice thermodynamics routine 99 !! - call the routine that computes mass and 103 100 !! heat fluxes at the ice/ocean interface 104 !! - save the outputs 101 !! - save the outputs 105 102 !! - save the outputs for restart when necessary 106 103 !! 107 104 !! ** Action : - time evolution of the LIM sea-ice model 108 105 !! - update all sbc variables below sea-ice: 109 !! utau, vtau, taum, wndm, qns , qsr, emp , sfx 106 !! utau, vtau, taum, wndm, qns , qsr, emp , sfx 110 107 !!--------------------------------------------------------------------- 111 108 INTEGER, INTENT(in) :: kt ! ocean time step … … 117 114 !!---------------------------------------------------------------------- 118 115 119 IF( nn_timing == 1 ) CALL timing_start('sbc_ice_lim')116 IF( nn_timing == 1 ) CALL timing_start('sbc_ice_lim') 120 117 121 118 ! clem: it is important to initialize agrif_lim3 variables here and not in sbc_lim_init … … 138 135 u_oce(:,:) = ssu_m(:,:) * umask(:,:,1) 139 136 v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1) 140 137 141 138 ! masked sea surface freezing temperature [Kelvin] (set to rt0 over land) 142 139 CALL eos_fzp( sss_m(:,:) , t_bo(:,:) ) 143 140 t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) ) 144 141 145 142 ! Mask sea ice surface temperature (set to rt0 over land) 146 143 DO jl = 1, jpl 147 144 t_su(:,:,jl) = t_su(:,:,jl) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) ) 148 END DO 149 ! 150 !------------------------------------------------! 151 ! --- Dynamical coupling with the atmosphere --- ! 145 END DO 146 ! 147 !------------------------------------------------! 148 ! --- Dynamical coupling with the atmosphere --- ! 152 149 !------------------------------------------------! 153 150 ! It provides the following fields: … … 161 158 CASE( jp_purecpl ) ; CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) ! Coupled formulation 162 159 END SELECT 163 160 164 161 IF( ln_mixcpl) THEN ! Case of a mixed Bulk/Coupled formulation 165 162 CALL wrk_alloc( jpi,jpj , zutau_ice, zvtau_ice) … … 174 171 !-------------------------------------------------------! 175 172 numit = numit + nn_fsbc ! Ice model time step 176 ! 173 ! 177 174 CALL sbc_lim_diag0 ! set diag of mass, heat and salt fluxes to 0 178 175 CALL lim_rst_opn( kt ) ! Open Ice restart file … … 209 206 pfrld(:,:) = 1._wp - at_i(:,:) 210 207 phicif(:,:) = vt_i(:,:) 211 212 !------------------------------------------------------! 213 ! --- Thermodynamical coupling with the atmosphere --- ! 208 209 !------------------------------------------------------! 210 ! --- Thermodynamical coupling with the atmosphere --- ! 214 211 !------------------------------------------------------! 215 212 ! It provides the following fields: … … 296 293 ! 297 294 END SUBROUTINE sbc_ice_lim 298 295 299 296 300 297 SUBROUTINE sbc_lim_init … … 304 301 !! ** purpose : Allocate all the dynamic arrays of the LIM-3 modules 305 302 !!---------------------------------------------------------------------- 306 INTEGER :: ierr 307 INTEGER :: ji, jj 303 INTEGER :: ji, jj, ierr 308 304 !!---------------------------------------------------------------------- 309 305 IF(lwp) WRITE(numout,*) … … 311 307 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ via Louvain la Neuve Ice Model (LIM-3) time stepping' 312 308 ! 313 ! Open the reference and configuration namelist files and namelist output file314 CALL ctl_opn( numnam_ice_ref, 'namelist_ice_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 309 ! ! Open the reference and configuration namelist files and namelist output file 310 CALL ctl_opn( numnam_ice_ref, 'namelist_ice_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 315 311 CALL ctl_opn( numnam_ice_cfg, 'namelist_ice_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 316 312 IF(lwm) CALL ctl_opn( numoni, 'output.namelist.ice', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, 1 ) 317 318 CALL ice_run! set some ice run parameters313 ! 314 CALL lim_run_init ! set some ice run parameters 319 315 ! 320 316 ! ! Allocate the ice arrays … … 350 346 CALL lim_var_glo2eqv 351 347 ! 352 CALL lim_sbc_init ! ice surface boundary condition 348 CALL lim_sbc_init ! ice surface boundary condition 353 349 ! 354 350 IF( ln_limdiahsb) CALL lim_diahsb_init ! initialization for diags … … 362 358 ELSE ; rn_amax_2d(ji,jj) = rn_amax_s ! SH 363 359 ENDIF 364 ENDDO365 END DO366 ! 367 nstart = numit + nn_fsbc 368 nitrun = nitend - nit000 + 1 369 nlast = numit + nitrun 360 END DO 361 END DO 362 ! 363 nstart = numit + nn_fsbc 364 nitrun = nitend - nit000 + 1 365 nlast = numit + nitrun 370 366 ! 371 367 IF( nstock == 0 ) nstock = nlast + 1 372 368 ! 373 !374 369 END SUBROUTINE sbc_lim_init 375 370 376 371 377 SUBROUTINE ice_run372 SUBROUTINE lim_run_init 378 373 !!------------------------------------------------------------------- 379 !! *** ROUTINE ice_run***380 !! 374 !! *** ROUTINE lim_run_init *** 375 !! 381 376 !! ** Purpose : Definition some run parameter for ice model 382 377 !! 383 !! ** Method : Read the namicerun namelist and check the parameter 378 !! ** Method : Read the namicerun namelist and check the parameter 384 379 !! values called at the first timestep (nit000) 385 380 !! … … 391 386 NAMELIST/namicediag/ ln_limdiachk, ln_limdiahsb, ln_limctl, iiceprt, jiceprt 392 387 !!------------------------------------------------------------------- 393 ! 388 ! 394 389 REWIND( numnam_ice_ref ) ! Namelist namicerun in reference namelist : Parameters for ice 395 390 READ ( numnam_ice_ref, namicerun, IOSTAT = ios, ERR = 901) … … 412 407 IF(lwp) THEN ! control print 413 408 WRITE(numout,*) 414 WRITE(numout,*) ' ice_run : ice share~dparameters for dynamics/advection/thermo of sea-ice'409 WRITE(numout,*) 'lim_run_init : ice share parameters for dynamics/advection/thermo of sea-ice' 415 410 WRITE(numout,*) ' ~~~~~~' 416 411 WRITE(numout,*) ' number of ice categories = ', jpl … … 451 446 IF( lwp ) WRITE(numout,*) ' ice timestep rdt_ice = ', rdt_ice 452 447 ! 453 END SUBROUTINE ice_run448 END SUBROUTINE lim_run_init 454 449 455 450 … … 486 481 WRITE(numout,*) ' mean ice thickness in the domain (only active if nn_catbnd=2) rn_himean = ', rn_himean 487 482 ENDIF 488 483 ! 489 484 !---------------------------------- 490 !- Thickness categories boundaries 485 !- Thickness categories boundaries 491 486 !---------------------------------- 487 ! 492 488 hi_max(:) = 0._wp 493 494 SELECT CASE ( nn_catbnd ) 495 !---------------------- 496 CASE (1) ! tanh function (CICE) 497 !---------------------- 489 ! 490 SELECT CASE ( nn_catbnd ) ! type of ice categories distribution 491 ! 492 CASE (1) !== tanh function (CICE) ==! 498 493 zc1 = 3._wp / REAL( jpl, wp ) 499 494 zc2 = 10._wp * zc1 500 495 zc3 = 3._wp 501 502 496 DO jl = 1, jpl 503 497 zx1 = REAL( jl-1, wp ) / REAL( jpl, wp ) 504 498 hi_max(jl) = hi_max(jl-1) + zc1 + zc2 * (1._wp + TANH( zc3 * (zx1 - 1._wp ) ) ) 505 499 END DO 506 507 !---------------------- 508 CASE (2) ! h^(-alpha) function 509 !---------------------- 510 zalpha = 0.05 ! exponent of the transform function 511 512 zhmax = 3.*rn_himean 513 514 DO jl = 1, jpl 500 ! 501 CASE (2) !== h^(-alpha) function ==! 502 zalpha = 0.05_wp 503 zhmax = 3._wp * rn_himean 504 DO jl = 1, jpl 515 505 znum = jpl * ( zhmax+1 )**zalpha 516 zden = ( jpl - jl ) * ( zhmax+1 )**zalpha + jl506 zden = REAL( jpl-jl , wp ) * ( zhmax + 1._wp )**zalpha + REAL( jl , wp ) 517 507 hi_max(jl) = ( znum / zden )**(1./zalpha) - 1 518 508 END DO 519 509 ! 520 510 END SELECT 521 522 DO jl = 1, jpl 511 ! 512 DO jl = 1, jpl ! mean thickness by category 523 513 hi_mean(jl) = ( hi_max(jl) + hi_max(jl-1) ) * 0.5_wp 524 514 END DO 525 526 ! Set hi_max(jpl)to a big value to ensure that all ice is thinner than hi_max(jpl)527 hi_max(jpl) = 99._wp528 529 IF(lwp) WRITE(numout,*) ' Thickness category boundaries '530 IF(lwp) WRITE(numout,*) ' hi_max ', hi_max(0:jpl)515 ! 516 hi_max(jpl) = 99._wp ! set to a big value to ensure that all ice is thinner than hi_max(jpl) 517 ! 518 IF(lwp) WRITE(numout,*) 519 IF(lwp) WRITE(numout,*) ' Thickness category boundaries ' 520 IF(lwp) WRITE(numout,*) ' hi_max ', hi_max(0:jpl) 531 521 ! 532 522 END SUBROUTINE lim_itd_init 533 523 534 524 535 525 SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_limflx ) 536 526 !!--------------------------------------------------------------------- 537 527 !! *** ROUTINE ice_lim_flx *** 538 !! 528 !! 539 529 !! ** Purpose : update the ice surface boundary condition by averaging and / or 540 !! redistributing fluxes on ice categories 541 !! 542 !! ** Method : average then redistribute 543 !! 544 !! ** Action : 530 !! redistributing fluxes on ice categories 531 !! 532 !! ** Method : average then redistribute 533 !! 534 !! ** Action : 545 535 !!--------------------------------------------------------------------- 546 INTEGER , INTENT(in ) :: k_limflx ! =-1 do nothing; =0 average ; 547 ! =1 average and redistribute ; =2 redistribute548 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: ptn_ice ! ice surface temperature 536 INTEGER , INTENT(in ) :: k_limflx ! =-1 do nothing; =0 average ; 537 ! ! = 1 average and redistribute ; =2 redistribute 538 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: ptn_ice ! ice surface temperature 549 539 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: palb_ice ! ice albedo 550 540 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pqns_ice ! non solar flux … … 565 555 REAL(wp), POINTER, DIMENSION(:,:) :: z_devap_m ! Mean d(evap)/dT over all categories 566 556 !!---------------------------------------------------------------------- 567 557 ! 568 558 IF( nn_timing == 1 ) CALL timing_start('ice_lim_flx') 569 !570 559 ! 571 560 SELECT CASE( k_limflx ) !== averaged on all ice categories ==! … … 591 580 CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m) 592 581 END SELECT 593 582 ! 594 583 SELECT CASE( k_limflx ) !== redistribution on all ice categories ==! 595 584 CASE( 1 , 2 ) 596 585 CALL wrk_alloc( jpi,jpj, zalb_m, ztem_m ) 597 586 ! 598 zalb_m(:,:) = fice_ice_ave ( palb_ice (:,:,:) ) 599 ztem_m(:,:) = fice_ice_ave ( ptn_ice (:,:,:) ) 587 zalb_m(:,:) = fice_ice_ave ( palb_ice (:,:,:) ) 588 ztem_m(:,:) = fice_ice_ave ( ptn_ice (:,:,:) ) 600 589 DO jl = 1, jpl 601 590 pqns_ice (:,:,jl) = pqns_ice (:,:,jl) + pdqn_ice (:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) ) 602 591 pevap_ice(:,:,jl) = pevap_ice(:,:,jl) + pdevap_ice(:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) ) 603 pqsr_ice (:,:,jl) = pqsr_ice (:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) ) 592 pqsr_ice (:,:,jl) = pqsr_ice (:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) ) 604 593 END DO 605 594 ! … … 611 600 END SUBROUTINE ice_lim_flx 612 601 602 613 603 SUBROUTINE sbc_lim_bef 614 604 !!---------------------------------------------------------------------- 615 605 !! *** ROUTINE sbc_lim_bef *** 616 606 !! 617 !! ** purpose : store ice variables at "before" time step 607 !! ** purpose : store ice variables at "before" time step 618 608 !!---------------------------------------------------------------------- 619 609 a_i_b (:,:,:) = a_i (:,:,:) ! ice area 620 610 e_i_b (:,:,:,:) = e_i (:,:,:,:) ! ice thermal energy 621 611 v_i_b (:,:,:) = v_i (:,:,:) ! ice volume 622 v_s_b (:,:,:) = v_s (:,:,:) ! snow volume 612 v_s_b (:,:,:) = v_s (:,:,:) ! snow volume 623 613 e_s_b (:,:,:,:) = e_s (:,:,:,:) ! snow thermal energy 624 614 smv_i_b(:,:,:) = smv_i(:,:,:) ! salt content … … 626 616 u_ice_b(:,:) = u_ice(:,:) 627 617 v_ice_b(:,:) = v_ice(:,:) 618 ! 628 619 at_i_b (:,:) = SUM( a_i_b(:,:,:), dim=3 ) 629 620 630 621 END SUBROUTINE sbc_lim_bef 622 631 623 632 624 SUBROUTINE sbc_lim_diag0 … … 643 635 sfx_bom(:,:) = 0._wp ; sfx_sum(:,:) = 0._wp 644 636 sfx_res(:,:) = 0._wp ; sfx_sub(:,:) = 0._wp 645 637 ! 646 638 wfx_snw(:,:) = 0._wp ; wfx_ice(:,:) = 0._wp 647 639 wfx_sni(:,:) = 0._wp ; wfx_opw(:,:) = 0._wp … … 651 643 wfx_spr(:,:) = 0._wp ; wfx_lam(:,:) = 0._wp 652 644 653 hfx_thd(:,:) = 0._wp ; 645 hfx_thd(:,:) = 0._wp ; 654 646 hfx_snw(:,:) = 0._wp ; hfx_opw(:,:) = 0._wp 655 647 hfx_bog(:,:) = 0._wp ; hfx_dyn(:,:) = 0._wp 656 648 hfx_bom(:,:) = 0._wp ; hfx_sum(:,:) = 0._wp 657 649 hfx_res(:,:) = 0._wp ; hfx_sub(:,:) = 0._wp 658 hfx_spr(:,:) = 0._wp ; hfx_dif(:,:) = 0._wp 650 hfx_spr(:,:) = 0._wp ; hfx_dif(:,:) = 0._wp 659 651 hfx_err(:,:) = 0._wp ; hfx_err_rem(:,:) = 0._wp 660 652 hfx_err_dif(:,:) = 0._wp 661 653 wfx_err_sub(:,:) = 0._wp 662 654 ! 663 655 afx_tot(:,:) = 0._wp ; 664 656 afx_dyn(:,:) = 0._wp ; afx_thd(:,:) = 0._wp 665 666 diag_heat(:,:) = 0._wp ; diag_smvi(:,:) = 0._wp ;667 diag_vice(:,:) = 0._wp ; diag_vsnw(:,:) = 0._wp ;657 ! 658 diag_heat(:,:) = 0._wp ; diag_smvi(:,:) = 0._wp 659 diag_vice(:,:) = 0._wp ; diag_vsnw(:,:) = 0._wp 668 660 669 661 tau_icebfr(:,:) = 0._wp; ! landfast ice param only (clem: important to keep the init here) … … 671 663 END SUBROUTINE sbc_lim_diag0 672 664 673 665 674 666 FUNCTION fice_cell_ave ( ptab ) 675 667 !!-------------------------------------------------------------------------- … … 679 671 REAL (wp), DIMENSION (jpi,jpj,jpl), INTENT (in) :: ptab 680 672 INTEGER :: jl ! Dummy loop index 681 682 fice_cell_ave (:,:) = 0. 0_wp673 674 fice_cell_ave (:,:) = 0._wp 683 675 DO jl = 1, jpl 684 676 fice_cell_ave (:,:) = fice_cell_ave (:,:) + a_i (:,:,jl) * ptab (:,:,jl) 685 677 END DO 686 678 687 679 END FUNCTION fice_cell_ave 688 689 680 681 690 682 FUNCTION fice_ice_ave ( ptab ) 691 683 !!-------------------------------------------------------------------------- … … 699 691 700 692 END FUNCTION fice_ice_ave 701 702 693 703 694 #else -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r6584 r7510 96 96 97 97 !!---------------------------------------------------------------------- 98 !! NEMO/OPA 4.0 , NEMO Consortium (2011)98 !! NEMO/OPA 3.7 , NEMO Consortium (2016) 99 99 !! $Id$ 100 100 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/step.F90
r6971 r7510 338 338 ! 339 339 IF( ln_diahsb ) CALL dia_hsb( kstp ) ! - ML - global conservation diagnostics 340 ! 340 341 341 IF( lrst_oce ) CALL rst_write( kstp ) ! write output ocean restart file 342 342 IF( ln_sto_eos ) CALL sto_rst_write( kstp ) ! write restart file for stochastic parameters -
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
r7069 r7510 112 112 # endif 113 113 # if defined key_lim3 114 CALL Agrif_Declare_Var_lim3 ! " " " " " LIM3 clem: useless?114 CALL Agrif_Declare_Var_lim3 ! " " " " " LIM3 115 115 # endif 116 116 #endif
Note: See TracChangeset
for help on using the changeset viewer.