Changeset 4161 for branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/SBC
- Timestamp:
- 2013-11-07T11:01:27+01:00 (11 years ago)
- Location:
- branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/SBC
- Files:
-
- 7 edited
-
sbc_oce.F90 (modified) (4 diffs)
-
sbcblk_core.F90 (modified) (13 diffs)
-
sbccpl.F90 (modified) (3 diffs)
-
sbcfwb.F90 (modified) (1 diff)
-
sbcice_if.F90 (modified) (1 diff)
-
sbcice_lim.F90 (modified) (16 diffs)
-
sbcmod.F90 (modified) (6 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
r4148 r4161 9 9 !! - ! 2010-11 (G. Madec) ice-ocean stress always computed at each ocean time-step 10 10 !! 3.3 ! 2010-10 (J. Chanut, C. Bricaud) add the surface pressure forcing 11 !! 4.0 ! 2012-05 (C. Rousset) add attenuation coef for use in ice model 11 12 !!---------------------------------------------------------------------- 12 13 … … 53 54 ! 54 55 LOGICAL , PUBLIC :: ln_icebergs !: Icebergs 55 56 ! 57 CHARACTER (len=8), PUBLIC :: cn_iceflx = 'none' !: Flux handling over ice categories 58 LOGICAL, PUBLIC :: ln_iceflx_ave = .FALSE. ! Average heat fluxes over all ice categories 59 LOGICAL, PUBLIC :: ln_iceflx_linear = .FALSE. ! Redistribute mean heat fluxes over all ice categories, using ice temperature and albedo 60 ! 56 61 !!---------------------------------------------------------------------- 57 62 !! Ocean Surface Boundary Condition fields … … 76 81 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sbc_tsc, sbc_tsc_b !: sbc content trend [K.m/s] jpi,jpj,jpts 77 82 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_hc , qsr_hc_b !: heat content trend due to qsr flux [K.m/s] jpi,jpj,jpk 83 !! 84 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: oatte, iatte !: clem attenuation coef of the input solar flux [unitless] 78 85 !! 79 86 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tprecip !: total precipitation [Kg/m2/s] … … 120 127 ! 121 128 ALLOCATE( rnf (jpi,jpj) , sbc_tsc (jpi,jpj,jpts) , qsr_hc (jpi,jpj,jpk) , & 122 & rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) , STAT=ierr(3) ) 129 & rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) , & 130 & iatte(jpi,jpj) , oatte (jpi,jpj) , STAT=ierr(3) ) 123 131 ! 124 132 ALLOCATE( tprecip(jpi,jpj) , sprecip(jpi,jpj) , fr_i(jpi,jpj) , & -
branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r4147 r4161 42 42 USE sbc_ice ! Surface boundary condition: ice fields 43 43 #endif 44 USE lib_fortran ! to use key_nosignedzero 44 45 45 46 IMPLICIT NONE … … 69 70 REAL(wp), PARAMETER :: Ls = 2.839e6 ! latent heat of sublimation 70 71 REAL(wp), PARAMETER :: Stef = 5.67e-8 ! Stefan Boltzmann constant 71 REAL(wp), PARAMETER :: Cice = 1. 63e-3 ! transfer coefficient over ice72 REAL(wp), PARAMETER :: Cice = 1.4e-3 ! iovi 1.63e-3 ! transfer coefficient over ice 72 73 REAL(wp), PARAMETER :: albo = 0.066 ! ocean albedo assumed to be constant 73 74 … … 76 77 LOGICAL :: ln_taudif ! logical flag to use the "mean of stress module - module of mean stress" data 77 78 REAL(wp) :: rn_pfac ! multiplication factor for precipitation 79 REAL(wp) :: rn_efac ! multiplication factor for evaporation (clem) 80 REAL(wp) :: rn_vfac ! multiplication factor for ice/ocean velocity in the calculation of wind stress (clem) 78 81 79 82 !! * Substitutions … … 126 129 CHARACTER(len=100) :: cn_dir ! Root directory for location of core files 127 130 TYPE(FLD_N), DIMENSION(jpfld) :: slf_i ! array of namelist informations on the fields to read 128 TYPE(FLD_N) :: sn_wndi, sn_wndj, sn_humi, sn_qsr ! informations about the fields to be read 129 TYPE(FLD_N) :: sn_qlw , sn_tair, sn_prec, sn_snow, sn_tdif ! - - 130 NAMELIST/namsbc_core/ cn_dir , ln_2m , ln_taudif, rn_pfac, & 131 TYPE(FLD_N) :: sn_wndi, sn_wndj, sn_humi, sn_qsr ! informations about the fields to be read 132 TYPE(FLD_N) :: sn_qlw , sn_tair, sn_prec, sn_snow ! " " 133 TYPE(FLD_N) :: sn_tdif ! " " 134 NAMELIST/namsbc_core/ cn_dir , ln_2m , ln_taudif, rn_pfac, rn_efac, rn_vfac, & 131 135 & sn_wndi, sn_wndj, sn_humi , sn_qsr , & 132 136 & sn_qlw , sn_tair, sn_prec , sn_snow, sn_tdif … … 274 278 DO jj = 2, jpjm1 275 279 DO ji = fs_2, fs_jpim1 ! vect. opt. 276 zwnd_i(ji,jj) = ( sf(jp_wndi)%fnow(ji,jj,1) - 0.5 * ( pu(ji-1,jj ) + pu(ji,jj) ) )277 zwnd_j(ji,jj) = ( sf(jp_wndj)%fnow(ji,jj,1) - 0.5 * ( pv(ji ,jj-1) + pv(ji,jj) ) )280 zwnd_i(ji,jj) = ( sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pu(ji-1,jj ) + pu(ji,jj) ) ) 281 zwnd_j(ji,jj) = ( sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pv(ji ,jj-1) + pv(ji,jj) ) ) 278 282 END DO 279 283 END DO … … 359 363 IF( ln_2m ) THEN 360 364 ! Values of temp. and hum. adjusted to 10m must be used instead of 2m values 361 zevap(:,:) = MAX( 0.e0, rhoa *Ce(:,:)*( zqsatw(:,:) - zq_zu(:,:) ) * wndm(:,:) ) ! Evaporation362 zqsb (:,:) = rhoa*cpa*Ch(:,:)*( zst (:,:) - zt_zu(:,:) ) * wndm(:,:) ! Sensible Heat365 zevap(:,:) = rn_efac * MAX( 0.e0, rhoa *Ce(:,:)*( zqsatw(:,:) - zq_zu(:,:) ) * wndm(:,:) ) ! Evaporation 366 zqsb (:,:) = rhoa*cpa*Ch(:,:)*( zst (:,:) - zt_zu(:,:) ) * wndm(:,:) ! Sensible Heat 363 367 ELSE 364 368 !CDIR COLLAPSE 365 zevap(:,:) = MAX( 0.e0, rhoa *Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,:,1) ) * wndm(:,:) ) ! Evaporation369 zevap(:,:) = rn_efac * MAX( 0.e0, rhoa *Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,:,1) ) * wndm(:,:) ) ! Evaporation 366 370 !CDIR COLLAPSE 367 371 zqsb (:,:) = rhoa*cpa*Ch(:,:)*( zst (:,:) - sf(jp_tair)%fnow(:,:,1) ) * wndm(:,:) ! Sensible Heat … … 505 509 ! ... scalar wind at I-point (fld being at T-point) 506 510 zwndi_f = 0.25 * ( sf(jp_wndi)%fnow(ji-1,jj ,1) + sf(jp_wndi)%fnow(ji ,jj ,1) & 507 & + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji ,jj-1,1) ) - pui(ji,jj)511 & + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji ,jj-1,1) ) - rn_vfac * pui(ji,jj) 508 512 zwndj_f = 0.25 * ( sf(jp_wndj)%fnow(ji-1,jj ,1) + sf(jp_wndj)%fnow(ji ,jj ,1) & 509 & + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji ,jj-1,1) ) - pvi(ji,jj)513 & + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji ,jj-1,1) ) - rn_vfac * pvi(ji,jj) 510 514 zwnorm_f = zcoef_wnorm * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f ) 511 515 ! ... ice stress at I-point … … 513 517 p_tauj(ji,jj) = zwnorm_f * zwndj_f 514 518 ! ... scalar wind at T-point (fld being at T-point) 515 zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - 0.25 * ( pui(ji,jj+1) + pui(ji+1,jj+1) &516 & + pui(ji,jj ) + pui(ji+1,jj ) )517 zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - 0.25 * ( pvi(ji,jj+1) + pvi(ji+1,jj+1) &518 & + pvi(ji,jj ) + pvi(ji+1,jj ) )519 zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.25 * ( pui(ji,jj+1) + pui(ji+1,jj+1) & 520 & + pui(ji,jj ) + pui(ji+1,jj ) ) 521 zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.25 * ( pvi(ji,jj+1) + pvi(ji+1,jj+1) & 522 & + pvi(ji,jj ) + pvi(ji+1,jj ) ) 519 523 z_wnds_t(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 520 524 END DO … … 530 534 DO jj = 2, jpj 531 535 DO ji = fs_2, jpi ! vect. opt. 532 zwndi_t = ( sf(jp_wndi)%fnow(ji,jj,1) - 0.5 * ( pui(ji-1,jj ) + pui(ji,jj) ) )533 zwndj_t = ( sf(jp_wndj)%fnow(ji,jj,1) - 0.5 * ( pvi(ji ,jj-1) + pvi(ji,jj) ) )536 zwndi_t = ( sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pui(ji-1,jj ) + pui(ji,jj) ) ) 537 zwndj_t = ( sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pvi(ji ,jj-1) + pvi(ji,jj) ) ) 534 538 z_wnds_t(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 535 539 END DO … … 541 545 DO ji = fs_2, fs_jpim1 ! vect. opt. 542 546 p_taui(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji+1,jj ) + z_wnds_t(ji,jj) ) & 543 & * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - pui(ji,jj) )547 & * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * pui(ji,jj) ) 544 548 p_tauj(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji,jj+1 ) + z_wnds_t(ji,jj) ) & 545 & * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - pvi(ji,jj) )549 & * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * pvi(ji,jj) ) 546 550 END DO 547 551 END DO … … 569 573 p_qsr(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj) 570 574 ! Long Wave (lw) 571 z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 575 ! iovino 576 IF( ff(ji,jj) .GT. 0._wp ) THEN 577 z_qlw(ji,jj,jl) = ( 0.95 * sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 578 ELSE 579 z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 580 ENDIF 572 581 ! lw sensitivity 573 582 z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3 … … 581 590 z_qsb(ji,jj,jl) = rhoa * cpa * Cice * z_wnds_t(ji,jj) * ( pst(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) ) 582 591 ! Latent Heat 583 p_qla(ji,jj,jl) = MAX( 0.e0, rhoa * Ls * Cice * z_wnds_t(ji,jj) &584 & * ( 11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1) ) )592 p_qla(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa * Ls * Cice * z_wnds_t(ji,jj) & 593 & * ( 11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1) ) ) 585 594 ! Latent heat sensitivity for ice (Dqla/Dt) 586 p_dqla(ji,jj,jl) = zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) )595 p_dqla(ji,jj,jl) = rn_efac * zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) ) 587 596 ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice) 588 597 z_dqsb(ji,jj,jl) = zcoef_dqsb * z_wnds_t(ji,jj) … … 615 624 !CDIR COLLAPSE 616 625 p_spr(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac ! solid precipitation [kg/m2/s] 617 CALL iom_put( 'snowpre', p_spr ) ! Snow precipitation 626 CALL iom_put( 'snowpre', p_spr * 86400. ) ! Snow precipitation 627 CALL iom_put( 'precip', p_tpr * 86400. ) ! Total precipitation 618 628 ! 619 629 IF(ln_ctl) THEN -
branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r4148 r4161 456 456 ! Coupled case: since cloud cover is not received from atmosphere 457 457 ! ===> defined as constant value -> definition done in sbc_cpl_init 458 fr1_i0(:,:) = 0.18459 fr2_i0(:,:) = 0.82458 IF ( ALLOCATED (fr1_i0)) fr1_i0 (:,:) = 0.18 459 IF ( ALLOCATED (fr2_i0)) fr2_i0 (:,:) = 0.82 460 460 ! ! ------------------------- ! 461 461 ! ! 10m wind module ! … … 916 916 CALL wrk_alloc( jpi,jpj, ztx, zty ) 917 917 918 IF( srcv(jpr_itx1)%laction ) THEN ; itx = jpr_itx1 918 !AC Pour eviter un stress nul sur la glace dans le cas mixed oce-ice 919 IF( srcv(jpr_itx1)%laction .AND. TRIM( sn_rcv_tau%cldes ) == 'oce and ice') THEN ; itx = jpr_itx1 919 920 ELSE ; itx = jpr_otx1 920 921 ENDIF … … 923 924 IF( nrcvinfo(itx) == OASIS_Rcv ) THEN 924 925 925 ! ! ======================= ! 926 IF( srcv(jpr_itx1)%laction ) THEN ! ice stress received ! 927 ! ! ======================= ! 926 ! ! ======================= ! 927 !AC Pour eviter un stress nul sur la glace dans le cas mixes oce-ice 928 IF( srcv(jpr_itx1)%laction .AND. TRIM( sn_rcv_tau%cldes ) == 'oce and ice') THEN ! ice stress received ! 929 ! ! ======================= ! 928 930 ! 929 931 IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere -
branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90
r3625 r4161 129 129 ! sum over the global domain 130 130 a_fwb = glob_sum( e1e2t(:,:) * ( sshn(:,:) + snwice_mass(:,:) * r1_rau0 ) ) 131 a_fwb = a_fwb * 1.e+3 / ( area * 86400.* 365. ) ! convert in Kg/m3/s = mm/s131 a_fwb = a_fwb * 1.e+3 / ( area * rday * 365. ) ! convert in Kg/m3/s = mm/s 132 132 !!gm ! !!bug 365d year 133 133 fwfold = a_fwb ! current year freshwater budget correction -
branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90
r4147 r4161 100 100 101 101 fr_i(:,:) = tfreez( sss_m ) * tmask(:,:,1) ! sea surface freezing temperature [Celcius] 102 #if defined key_coupled 102 103 ! OM : probleme. a_i pas defini dans les cas lim3 et cice 104 #if defined key_coupled && defined key_lim2 103 105 a_i(:,:,1) = fr_i(:,:) 104 106 #endif -
branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r3625 r4161 11 11 !! 3.3 ! 2010-11 (G. Madec) ice-ocean stress always computed at each ocean time-step 12 12 !! 3.4 ! 2011-01 (A Porter) dynamical allocation 13 !! - ! 2012-10 (C. Rousset) add lim_diahsb 13 14 !!---------------------------------------------------------------------- 14 15 #if defined key_lim3 … … 31 32 USE sbcblk_core ! Surface boundary condition: CORE bulk 32 33 USE sbcblk_clio ! Surface boundary condition: CLIO bulk 34 USE sbccpl ! Surface boundary condition: coupled interface 33 35 USE albedo ! ocean & ice albedo 34 36 … … 41 43 USE limitd_me ! Mechanics on ice thickness distribution 42 44 USE limsbc ! sea surface boundary condition 43 USE limdia ! Icediagnostics45 USE limdiahsb ! Ice budget diagnostics 44 46 USE limwri ! Ice outputs 45 47 USE limrst ! Ice restarts 46 USE limupdate ! update of global variables 48 USE limupdate1 ! update of global variables 49 USE limupdate2 ! update of global variables 47 50 USE limvar ! Ice variables switch 48 51 … … 51 54 USE lib_mpp ! MPP library 52 55 USE wrk_nemo ! work arrays 56 USE timing ! Timing 53 57 USE iom ! I/O manager library 54 58 USE in_out_manager ! I/O manager 55 59 USE prtctl ! Print control 60 61 #if defined key_bdy 62 USE bdyice_lim ! unstructured open boundary data (bdy_ice_lim routine) 63 #endif 56 64 57 65 IMPLICIT NONE … … 69 77 !!---------------------------------------------------------------------- 70 78 CONTAINS 79 80 FUNCTION fice_cell_ave ( ptab) 81 !!-------------------------------------------------------------------------- 82 !! * Compute average over categories, for grid cell (ice covered and free ocean) 83 !!-------------------------------------------------------------------------- 84 REAL (wp), DIMENSION (jpi,jpj) :: fice_cell_ave 85 REAL (wp), DIMENSION (jpi,jpj,jpl), INTENT (in) :: ptab 86 INTEGER :: jl ! Dummy loop index 87 88 fice_cell_ave (:,:) = 0.0_wp 89 90 DO jl = 1, jpl 91 fice_cell_ave (:,:) = fice_cell_ave (:,:) & 92 & + a_i (:,:,jl) * ptab (:,:,jl) 93 END DO 94 95 END FUNCTION fice_cell_ave 96 97 FUNCTION fice_ice_ave ( ptab) 98 !!-------------------------------------------------------------------------- 99 !! * Compute average over categories, for ice covered part of grid cell 100 !!-------------------------------------------------------------------------- 101 REAL (kind=wp), DIMENSION (jpi,jpj) :: fice_ice_ave 102 REAL (kind=wp), DIMENSION (jpi,jpj,jpl), INTENT(in) :: ptab 103 104 fice_ice_ave (:,:) = 0.0_wp 105 WHERE ( at_i (:,:) .GT. 0.0_wp ) fice_ice_ave (:,:) = fice_cell_ave ( ptab (:,:,:)) / at_i (:,:) 106 107 END FUNCTION fice_ice_ave 108 109 !!====================================================================== 71 110 72 111 SUBROUTINE sbc_ice_lim( kt, kblk ) … … 96 135 REAL(wp) :: zcoef ! local scalar 97 136 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_ice_os, zalb_ice_cs ! albedo of the ice under overcast/clear sky 137 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_ice ! mean albedo of ice (for coupled) 138 139 REAL(wp), POINTER, DIMENSION(:,:) :: zalb_ice_all ! Mean albedo over all categories 140 REAL(wp), POINTER, DIMENSION(:,:) :: ztem_ice_all ! Mean temperature over all categories 141 142 REAL(wp), POINTER, DIMENSION(:,:) :: z_qsr_ice_all ! Mean solar heat flux over all categories 143 REAL(wp), POINTER, DIMENSION(:,:) :: z_qns_ice_all ! Mean non solar heat flux over all categories 144 REAL(wp), POINTER, DIMENSION(:,:) :: z_qla_ice_all ! Mean latent heat flux over all categories 145 REAL(wp), POINTER, DIMENSION(:,:) :: z_dqns_ice_all ! Mean d(qns)/dT over all categories 146 REAL(wp), POINTER, DIMENSION(:,:) :: z_dqla_ice_all ! Mean d(qla)/dT over all categories 98 147 !!---------------------------------------------------------------------- 99 148 149 !- O.M. : why do we allocate all these arrays even when MOD( kt-1, nn_fsbc ) /= 0 ????? 150 151 IF( nn_timing == 1 ) CALL timing_start('sbc_ice_lim') 152 100 153 CALL wrk_alloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs ) 154 155 IF ( ln_cpl .OR. ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 156 CALL wrk_alloc( jpi,jpj,jpl, zalb_ice) 157 END IF 158 IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 159 CALL wrk_alloc( jpi,jpj, ztem_ice_all, zalb_ice_all, z_qsr_ice_all, z_qns_ice_all, z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all) 160 ENDIF 161 101 162 102 163 IF( kt == nit000 ) THEN … … 108 169 ! 109 170 IF( ln_nicep ) THEN ! control print at a given point 110 jiindx = 44 ; jjindx = 140171 jiindx = 15 ; jjindx = 46 111 172 WRITE(numout,*) ' The debugging point is : jiindx : ',jiindx, ' jjindx : ',jjindx 112 173 ENDIF … … 129 190 t_su(:,:,jl) = t_su(:,:,jl) + rt0 * ( 1. - tmask(:,:,1) ) 130 191 END DO 192 193 IF ( ln_cpl ) zalb_ice (:,:,:) = 0.5 * ( zalb_ice_cs (:,:,:) + zalb_ice_os (:,:,:) ) 194 195 IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 196 ! 197 ! Compute mean albedo and temperature 198 zalb_ice_all (:,:) = fice_ice_ave ( zalb_ice (:,:,:) ) 199 ztem_ice_all (:,:) = fice_ice_ave ( tn_ice (:,:,:) ) 200 ! 201 ENDIF 131 202 ! Bulk formulea - provides the following fields: 132 203 ! utau_ice, vtau_ice : surface ice stress (U- & V-points) [N/m2] … … 151 222 & tprecip , sprecip , & 152 223 & fr1_i0 , fr2_i0 , cp_ice_msh, jpl ) 224 ! 225 CASE ( 5 ) 226 zalb_ice (:,:,:) = 0.5 * ( zalb_ice_cs (:,:,:) + zalb_ice_os (:,:,:) ) 227 228 CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) 229 230 CALL sbc_cpl_ice_flx( p_frld=ato_i, palbi=zalb_ice, psst=sst_m, pist=tn_ice ) 231 232 ! Latent heat flux is forced to 0 in coupled : 233 ! it is included in qns (non-solar heat flux) 234 qla_ice (:,:,:) = 0.0e0_wp 235 dqla_ice (:,:,:) = 0.0e0_wp 236 ! 153 237 END SELECT 238 239 ! Average over all categories 240 IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 241 242 z_qns_ice_all (:,:) = fice_ice_ave ( qns_ice (:,:,:) ) 243 z_qsr_ice_all (:,:) = fice_ice_ave ( qsr_ice (:,:,:) ) 244 z_dqns_ice_all (:,:) = fice_ice_ave ( dqns_ice (:,:,:) ) 245 z_qla_ice_all (:,:) = fice_ice_ave ( qla_ice (:,:,:) ) 246 z_dqla_ice_all (:,:) = fice_ice_ave ( dqla_ice (:,:,:) ) 247 248 DO jl = 1, jpl 249 dqns_ice (:,:,jl) = z_dqns_ice_all (:,:) 250 dqla_ice (:,:,jl) = z_dqla_ice_all (:,:) 251 END DO 252 ! 253 IF ( ln_iceflx_ave ) THEN 254 DO jl = 1, jpl 255 qns_ice (:,:,jl) = z_qns_ice_all (:,:) 256 qsr_ice (:,:,jl) = z_qsr_ice_all (:,:) 257 qla_ice (:,:,jl) = z_qla_ice_all (:,:) 258 END DO 259 END IF 260 ! 261 IF ( ln_iceflx_linear ) THEN 262 DO jl = 1, jpl 263 qns_ice (:,:,jl) = z_qns_ice_all(:,:) + z_dqns_ice_all(:,:) * (tn_ice(:,:,jl) - ztem_ice_all(:,:)) 264 qla_ice (:,:,jl) = z_qla_ice_all(:,:) + z_dqla_ice_all(:,:) * (tn_ice(:,:,jl) - ztem_ice_all(:,:)) 265 qsr_ice (:,:,jl) = (1.0e0_wp-zalb_ice(:,:,jl)) / (1.0e0_wp-zalb_ice_all(:,:)) * z_qsr_ice_all(:,:) 266 END DO 267 END IF 268 END IF 154 269 155 270 ! !----------------------! … … 178 293 d_oa_i_thd (:,:,:) = 0._wp ; d_oa_i_trp (:,:,:) = 0._wp 179 294 ! 180 sfx (:,:) = 0._wp 295 sfx (:,:) = 0._wp ; sfx_thd (:,:) = 0._wp 181 296 sfx_bri(:,:) = 0._wp ; sfx_mec (:,:) = 0._wp ; sfx_res (:,:) = 0._wp 182 297 fhbri (:,:) = 0._wp ; fheat_mec(:,:) = 0._wp ; fheat_res(:,:) = 0._wp … … 185 300 focea2D(:,:) = 0._wp 186 301 fsup2D (:,:) = 0._wp 187 ! 302 303 ! used in limthd.F90 304 rdvosif(:,:) = 0._wp ! variation of ice volume at surface 305 rdvobif(:,:) = 0._wp ! variation of ice volume at bottom 306 fdvolif(:,:) = 0._wp ! total variation of ice volume 307 rdvonif(:,:) = 0._wp ! lateral variation of ice volume 308 fstric (:,:) = 0._wp ! part of solar radiation transmitted through the ice 309 ffltbif(:,:) = 0._wp ! linked with fstric 310 qfvbq (:,:) = 0._wp ! linked with fstric 311 rdm_snw(:,:) = 0._wp ! variation of snow mass per unit area 312 rdm_ice(:,:) = 0._wp ! variation of ice mass per unit area 313 hicifp (:,:) = 0._wp ! daily thermodynamic ice production. 314 ! 188 315 diag_sni_gr(:,:) = 0._wp ; diag_lat_gr(:,:) = 0._wp 189 316 diag_bot_gr(:,:) = 0._wp ; diag_dyn_gr(:,:) = 0._wp 190 317 diag_bot_me(:,:) = 0._wp ; diag_sur_me(:,:) = 0._wp 318 diag_res_pr(:,:) = 0._wp ; diag_trp_vi(:,:) = 0._wp 191 319 ! dynamical invariants 192 320 delta_i(:,:) = 0._wp ; divu_i(:,:) = 0._wp ; shear_i(:,:) = 0._wp … … 199 327 CALL lim_dyn( kt ) ! Ice dynamics ( rheology/dynamics ) 200 328 CALL lim_trp( kt ) ! Ice transport ( Advection/diffusion ) 201 CALL lim_var_agg(1) ! aggregate categories, requested202 329 CALL lim_var_glo2eqv ! equivalent variables, requested for rafting 203 330 IF( ln_nicep ) CALL lim_prt_state( jiindx, jjindx,-1, ' - ice dyn & trp - ' ) ! control print 204 331 CALL lim_itd_me ! Mechanical redistribution ! (ridging/rafting) 332 CALL lim_var_agg( 1 ) 333 CALL lim_update1 205 334 ENDIF 335 ! !- Change old values for new values 336 old_u_ice(:,:) = u_ice (:,:) 337 old_v_ice(:,:) = v_ice (:,:) 338 old_a_i(:,:,:) = a_i (:,:,:) 339 old_v_s(:,:,:) = v_s (:,:,:) 340 old_v_i(:,:,:) = v_i (:,:,:) 341 old_e_s(:,:,:,:) = e_s (:,:,:,:) 342 old_e_i(:,:,:,:) = e_i (:,:,:,:) 343 old_oa_i(:,:,:) = oa_i(:,:,:) 344 old_smv_i(:,:,:) = smv_i (:,:,:) 206 345 ! ! Ice thermodynamics 207 346 CALL lim_var_glo2eqv ! equivalent variables … … 217 356 ! ! Global variables update 218 357 CALL lim_var_agg( 1 ) ! requested by limupdate 219 CALL lim_update ! Global variables update 358 CALL lim_update2 ! Global variables update 359 #if defined key_bdy 360 CALL bdy_ice_lim( kt ) ! clem modif: bdy ice 361 #endif 220 362 CALL lim_var_glo2eqv ! equivalent variables (outputs) 221 363 CALL lim_var_agg(2) ! aggregate ice thickness categories … … 227 369 ! 228 370 ! ! Diagnostics and outputs 229 IF ( ( MOD( kt+nn_fsbc-1, ninfo ) == 0 .OR. ntmoy == 1 ) .AND. .NOT. lk_mpp ) &230 & CALL lim_dia 371 IF (ln_limdiaout) CALL lim_diahsb 372 !clem # if ! defined key_iomput 231 373 CALL lim_wri( 1 ) ! Ice outputs 374 !clem # endif 375 IF( kt == nit000 ) CALL iom_close( numrir ) ! clem: close input ice restart file 232 376 IF( lrst_ice ) CALL lim_rst_write( kt ) ! Ice restart file 233 377 CALL lim_var_glo2eqv ! ??? … … 248 392 ! 249 393 CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs ) 394 IF ( ln_cpl .OR. ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 395 CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice) 396 END IF 397 IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 398 CALL wrk_dealloc( jpi,jpj, ztem_ice_all, zalb_ice_all, z_qsr_ice_all, z_qns_ice_all, z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all) 399 ENDIF 400 ! 401 IF( nn_timing == 1 ) CALL timing_stop('sbc_ice_lim') 250 402 ! 251 403 END SUBROUTINE sbc_ice_lim … … 607 759 ! WRITE(numout,*) ' sfx_bri : ', sfx_bri (ki,kj) 608 760 ! WRITE(numout,*) ' sfx : ', sfx (ki,kj) 609 ! WRITE(numout,*) ' fsalt_res : ', fsalt_res(ki,kj)761 ! WRITE(numout,*) ' sfx_res : ', sfx_res(ki,kj) 610 762 WRITE(numout,*) ' fmmec : ', fmmec (ki,kj) 611 763 WRITE(numout,*) ' fhmec : ', fhmec (ki,kj) -
branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r4153 r4161 42 42 USE sbcfwb ! surface boundary condition: freshwater budget 43 43 USE closea ! closed sea 44 USE bdy_par ! for lk_bdy45 USE bdyice_lim2 ! unstructured open boundary data (bdy_ice_lim_2 routine)46 44 USE icbstp ! Icebergs! 47 45 … … 86 84 NAMELIST/namsbc/ nn_fsbc , ln_ana , ln_flx, ln_blk_clio, ln_blk_core, ln_cpl, & 87 85 & ln_blk_mfs, ln_apr_dyn, nn_ice, nn_ice_embd, ln_dm2dc , ln_rnf, & 88 & ln_ssr , nn_fwb , ln_cdgw , ln_wave , ln_sdw 86 & ln_ssr , nn_fwb , ln_cdgw , ln_wave , ln_sdw, cn_iceflx 89 87 INTEGER :: ios 90 88 !!---------------------------------------------------------------------- … … 126 124 WRITE(numout,*) ' MFS bulk formulation ln_blk_mfs = ', ln_blk_mfs 127 125 WRITE(numout,*) ' coupled formulation (T if key_sbc_cpl) ln_cpl = ', ln_cpl 126 WRITE(numout,*) ' Flux handling over ice categories cn_iceflx = ', TRIM (cn_iceflx) 128 127 WRITE(numout,*) ' Misc. options of sbc : ' 129 128 WRITE(numout,*) ' Patm gradient added in ocean & ice Eqs. ln_apr_dyn = ', ln_apr_dyn … … 137 136 ENDIF 138 137 138 ! Flux handling over ice categories 139 SELECT CASE ( TRIM (cn_iceflx)) 140 CASE ('ave') 141 ln_iceflx_ave = .TRUE. 142 ln_iceflx_linear = .FALSE. 143 CASE ('linear') 144 ln_iceflx_ave = .FALSE. 145 ln_iceflx_linear = .TRUE. 146 CASE default 147 ln_iceflx_ave = .FALSE. 148 ln_iceflx_linear = .FALSE. 149 END SELECT 150 IF(lwp) WRITE(numout,*) ' Fluxes averaged over all ice categories ln_iceflx_ave = ', ln_iceflx_ave 151 IF(lwp) WRITE(numout,*) ' Fluxes distributed linearly over ice categories ln_iceflx_linear = ', ln_iceflx_linear 152 ! 139 153 ! ! allocate sbc arrays 140 154 IF( sbc_oce_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_oce arrays' ) … … 175 189 IF( ( nn_ice == 3 .OR. nn_ice == 4 ) .AND. nn_ice_embd == 0 ) & 176 190 & CALL ctl_stop( 'LIM3 and CICE sea-ice models require nn_ice_embd = 1 or 2' ) 191 192 IF( ln_iceflx_ave .AND. ln_iceflx_linear ) & 193 & CALL ctl_stop( ' ln_iceflx_ave and ln_iceflx_linear options are not compatible' ) 194 195 IF( ( nn_ice ==3 .AND. lk_cpl) .AND. .NOT. ( ln_iceflx_ave .OR. ln_iceflx_linear ) ) & 196 & CALL ctl_stop( ' With lim3 coupled, either ln_iceflx_ave or ln_iceflx_linear must be set to .TRUE.' ) 177 197 178 198 IF( ln_dm2dc ) nday_qsr = -1 ! initialisation flag … … 307 327 CASE( 1 ) ; CALL sbc_ice_if ( kt ) ! Ice-cover climatology ("Ice-if" model) 308 328 CASE( 2 ) ; CALL sbc_ice_lim_2( kt, nsbc ) ! LIM-2 ice model 309 IF( lk_bdy ) CALL bdy_ice_lim_2( kt ) ! BDY boundary condition310 329 CASE( 3 ) ; CALL sbc_ice_lim ( kt, nsbc ) ! LIM-3 ice model 311 CASE( 4 ) ; CALL sbc_ice_cice ( kt, nsbc ) ! CICE ice model 330 !is it useful? 331 !CASE( 4 ) ; CALL sbc_ice_cice ( kt, nsbc ) ! CICE ice model 312 332 END SELECT 313 333
Note: See TracChangeset
for help on using the changeset viewer.
