Changeset 10288 for NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC
- Timestamp:
- 2018-11-07T18:25:49+01:00 (6 years ago)
- Location:
- NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC
- Files:
-
- 30 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC/cpl_oasis3.F90
r9598 r10288 69 69 INTEGER, PUBLIC, PARAMETER :: nmaxcat=5 ! Maximum number of coupling fields 70 70 INTEGER, PUBLIC, PARAMETER :: nmaxcpl=5 ! Maximum number of coupling fields 71 LOGICAL, PARAMETER :: ltmp_wapatch = .TRUE. ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define 72 INTEGER :: nldi_save, nlei_save 73 INTEGER :: nldj_save, nlej_save 71 74 72 75 TYPE, PUBLIC :: FLD_CPL !: Type for coupling field information … … 87 90 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 88 91 !! $Id$ 89 !! Software governed by the CeCILL licen ce (./LICENSE)92 !! Software governed by the CeCILL license (see ./LICENSE) 90 93 !!---------------------------------------------------------------------- 91 94 CONTAINS … … 145 148 !!-------------------------------------------------------------------- 146 149 150 ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define 151 IF ( ltmp_wapatch ) THEN 152 nldi_save = nldi ; nlei_save = nlei 153 nldj_save = nldj ; nlej_save = nlej 154 IF( nimpp == 1 ) nldi = 1 155 IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi 156 IF( njmpp == 1 ) nldj = 1 157 IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj 158 ENDIF 147 159 IF(lwp) WRITE(numout,*) 148 160 IF(lwp) WRITE(numout,*) 'cpl_define : initialization in coupled ocean/atmosphere case' … … 296 308 IF( nerror /= OASIS_Ok ) CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef') 297 309 ! 310 IF ( ltmp_wapatch ) THEN 311 nldi = nldi_save ; nlei = nlei_save 312 nldj = nldj_save ; nlej = nlej_save 313 ENDIF 298 314 END SUBROUTINE cpl_define 299 315 … … 313 329 INTEGER :: jc,jm ! local loop index 314 330 !!-------------------------------------------------------------------- 331 ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define 332 IF ( ltmp_wapatch ) THEN 333 nldi_save = nldi ; nlei_save = nlei 334 nldj_save = nldj ; nlej_save = nlej 335 IF( nimpp == 1 ) nldi = 1 336 IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi 337 IF( njmpp == 1 ) nldj = 1 338 IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj 339 ENDIF 315 340 ! 316 341 ! snd data to OASIS3 … … 341 366 ENDDO 342 367 ENDDO 368 IF ( ltmp_wapatch ) THEN 369 nldi = nldi_save ; nlei = nlei_save 370 nldj = nldj_save ; nlej = nlej_save 371 ENDIF 343 372 ! 344 373 END SUBROUTINE cpl_snd … … 361 390 LOGICAL :: llaction, llfisrt 362 391 !!-------------------------------------------------------------------- 392 ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define 393 IF ( ltmp_wapatch ) THEN 394 nldi_save = nldi ; nlei_save = nlei 395 nldj_save = nldj ; nlej_save = nlej 396 ENDIF 363 397 ! 364 398 ! receive local data from OASIS3 on every process … … 367 401 ! 368 402 DO jc = 1, srcv(kid)%nct 403 IF ( ltmp_wapatch ) THEN 404 IF( nimpp == 1 ) nldi = 1 405 IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi 406 IF( njmpp == 1 ) nldj = 1 407 IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj 408 ENDIF 369 409 llfisrt = .TRUE. 370 410 … … 408 448 ENDDO 409 449 450 IF ( ltmp_wapatch ) THEN 451 nldi = nldi_save ; nlei = nlei_save 452 nldj = nldj_save ; nlej = nlej_save 453 ENDIF 410 454 !--- Fill the overlap areas and extra hallows (mpp) 411 455 !--- check periodicity conditions (all cases) -
NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC/cyclone.F90
r9598 r10288 39 39 # include "vectopt_loop_substitute.h90" 40 40 !!---------------------------------------------------------------------- 41 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 41 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 42 42 !! $Id$ 43 !! Software governed by the CeCILL licen ce (modipsl/doc/NEMO_CeCILL.txt)43 !! Software governed by the CeCILL license (see ./LICENSE) 44 44 !!---------------------------------------------------------------------- 45 45 -
NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC/fldread.F90
r9807 r10288 125 125 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 126 126 !! $Id$ 127 !! Software governed by the CeCILL licen ce (./LICENSE)127 !! Software governed by the CeCILL license (see ./LICENSE) 128 128 !!---------------------------------------------------------------------- 129 129 CONTAINS -
NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC/geo2ocean.F90
r9598 r10288 55 55 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 56 56 !! $Id$ 57 !! Software governed by the CeCILL licen ce (./LICENSE)57 !! Software governed by the CeCILL license (see ./LICENSE) 58 58 !!---------------------------------------------------------------------- 59 59 CONTAINS -
NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC/ocealb.F90
- Property svn:keywords set to Id
r9598 r10288 21 21 !!---------------------------------------------------------------------- 22 22 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 23 !! $Id : ocealb.F90 8268 2017-07-03 15:01:04Z clem$24 !! Software governed by the CeCILL licen ce (./LICENSE)23 !! $Id$ 24 !! Software governed by the CeCILL license (see ./LICENSE) 25 25 !!---------------------------------------------------------------------- 26 26 CONTAINS -
NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC/sbc_ice.F90
r9767 r10288 49 49 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qml_ice !: heat available for snow / ice surface melting [W/m2] 50 50 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qcn_ice !: heat conduction flux in the layer below surface [W/m2] 51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: q sr_ice_tr!: solar flux transmitted below the ice surface [W/m2]51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qtr_ice_top !: solar flux transmitted below the ice surface [W/m2] 52 52 53 53 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_ice !: atmos-ice u-stress. VP: I-pt ; EVP: U,V-pts [N/m2] … … 109 109 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 110 110 !! $Id$ 111 !! Software governed by the CeCILL licen ce (./LICENSE)111 !! Software governed by the CeCILL license (see ./LICENSE) 112 112 !!---------------------------------------------------------------------- 113 113 CONTAINS … … 126 126 ALLOCATE( qns_ice (jpi,jpj,jpl) , qsr_ice (jpi,jpj,jpl) , & 127 127 & qla_ice (jpi,jpj,jpl) , dqla_ice (jpi,jpj,jpl) , & 128 & dqns_ice(jpi,jpj,jpl) , tn_ice (jpi,jpj,jpl) , alb_ice (jpi,jpj,jpl) , &129 & qml_ice (jpi,jpj,jpl) , qcn_ice (jpi,jpj,jpl) , q sr_ice_tr(jpi,jpj,jpl) , &130 & utau_ice(jpi,jpj) , vtau_ice (jpi,jpj) , wndm_ice (jpi,jpj) , &131 & evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice (jpi,jpj) , &132 & qemp_ice(jpi,jpj) , qevap_ice(jpi,jpj,jpl) , qemp_oce (jpi,jpj) , &133 & qns_oce (jpi,jpj) , qsr_oce (jpi,jpj) , emp_oce (jpi,jpj) , &134 & emp_ice (jpi,jpj) , tsfc_ice (jpi,jpj,jpl) , sstfrz (jpi,jpj) , STAT= ierr(2) )128 & dqns_ice(jpi,jpj,jpl) , tn_ice (jpi,jpj,jpl) , alb_ice (jpi,jpj,jpl) , & 129 & qml_ice (jpi,jpj,jpl) , qcn_ice (jpi,jpj,jpl) , qtr_ice_top(jpi,jpj,jpl) , & 130 & utau_ice(jpi,jpj) , vtau_ice (jpi,jpj) , wndm_ice (jpi,jpj) , & 131 & evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice (jpi,jpj) , & 132 & qemp_ice(jpi,jpj) , qevap_ice(jpi,jpj,jpl) , qemp_oce (jpi,jpj) , & 133 & qns_oce (jpi,jpj) , qsr_oce (jpi,jpj) , emp_oce (jpi,jpj) , & 134 & emp_ice (jpi,jpj) , tsfc_ice (jpi,jpj,jpl) , sstfrz (jpi,jpj) , STAT= ierr(2) ) 135 135 #endif 136 136 -
NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC/sbc_oce.F90
r9598 r10288 154 154 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 155 155 !! $Id$ 156 !! Software governed by the CeCILL licen ce (./LICENSE)156 !! Software governed by the CeCILL license (see ./LICENSE) 157 157 !!---------------------------------------------------------------------- 158 158 CONTAINS -
NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC/sbcapr.F90
r9598 r10288 41 41 42 42 !!---------------------------------------------------------------------- 43 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 43 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 44 44 !! $Id$ 45 !! Software governed by the CeCILL licen ce (./LICENSE)45 !! Software governed by the CeCILL license (see ./LICENSE) 46 46 !!---------------------------------------------------------------------- 47 47 CONTAINS -
NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC/sbcblk.F90
- Property svn:keywords set to Id
r9767 r10288 46 46 USE lib_fortran ! to use key_nosignedzero 47 47 #if defined key_si3 48 USE ice , ONLY : u_ice, v_ice, jpl, a_i_b, at_i_b, tm_su, rn_cnd_s 48 USE ice , ONLY : u_ice, v_ice, jpl, a_i_b, at_i_b, tm_su, rn_cnd_s, hfx_err_dif 49 49 USE icethd_dh ! for CALL ice_thd_snwblow 50 50 #endif … … 135 135 !!---------------------------------------------------------------------- 136 136 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 137 !! $Id : sbcblk.F90 6416 2016-04-01 12:22:17Z clem$138 !! Software governed by the CeCILL licen ce (./LICENSE)137 !! $Id$ 138 !! Software governed by the CeCILL license (see ./LICENSE) 139 139 !!---------------------------------------------------------------------- 140 140 CONTAINS … … 239 239 !drag coefficient read from wave model definable only with mfs bulk formulae and core 240 240 ELSEIF (ln_cdgw .AND. .NOT. ln_NCAR ) THEN 241 CALL ctl_stop( 'drag coefficient read from wave model definable only with mfs bulk formulae and core')241 CALL ctl_stop( 'drag coefficient read from wave model definable only with NCAR and CORE bulk formulae') 242 242 ELSEIF (ln_stcor .AND. .NOT. ln_sdw) THEN 243 243 CALL ctl_stop( 'Stokes-Coriolis term calculated only if activated Stokes Drift ln_sdw=T') … … 526 526 ! 527 527 qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) & ! Downward Non Solar 528 & - sf(jp_snow)%fnow(:,:,1) * rn_pfac * lfus& ! remove latent melting heat for solid precip528 & - sf(jp_snow)%fnow(:,:,1) * rn_pfac * rLfus & ! remove latent melting heat for solid precip 529 529 & - zevap(:,:) * pst(:,:) * rcp & ! remove evap heat content at SST 530 530 & + ( sf(jp_prec)%fnow(:,:,1) - sf(jp_snow)%fnow(:,:,1) ) * rn_pfac & ! add liquid precip heat content at Tair 531 531 & * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp & 532 532 & + sf(jp_snow)%fnow(:,:,1) * rn_pfac & ! add solid precip heat content at min(Tair,Tsnow) 533 & * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 _snow ) - rt0 ) * cpic533 & * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi 534 534 qns(:,:) = qns(:,:) * tmask(:,:,1) 535 535 ! … … 659 659 zrv = pqa(ji,jj) / (1. - pqa(ji,jj)) 660 660 ziRT = 1. / (R_dry*ptak(ji,jj)) ! 1/RT 661 gamma_moist(ji,jj) = grav * ( 1. + cevap*zrv*ziRT ) / ( Cp_dry + cevap*cevap*zrv*reps0*ziRT/ptak(ji,jj) )661 gamma_moist(ji,jj) = grav * ( 1. + rLevap*zrv*ziRT ) / ( Cp_dry + rLevap*rLevap*zrv*reps0*ziRT/ptak(ji,jj) ) 662 662 END DO 663 663 END DO … … 792 792 REAL(wp) :: zst3 ! local variable 793 793 REAL(wp) :: zcoef_dqlw, zcoef_dqla ! - - 794 REAL(wp) :: zztmp, z1_ lsub ! - -794 REAL(wp) :: zztmp, z1_rLsub ! - - 795 795 REAL(wp) :: zfr1, zfr2 ! local variables 796 796 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z1_st ! inverse of surface temperature … … 868 868 869 869 ! --- evaporation --- ! 870 z1_ lsub = 1._wp /Lsub871 evap_ice (:,:,:) = rn_efac * qla_ice (:,:,:) * z1_ lsub ! sublimation872 devap_ice(:,:,:) = rn_efac * dqla_ice(:,:,:) * z1_ lsub ! d(sublimation)/dT873 zevap (:,:) = rn_efac * ( emp(:,:) + tprecip(:,:) ) ! evaporation over ocean870 z1_rLsub = 1._wp / rLsub 871 evap_ice (:,:,:) = rn_efac * qla_ice (:,:,:) * z1_rLsub ! sublimation 872 devap_ice(:,:,:) = rn_efac * dqla_ice(:,:,:) * z1_rLsub ! d(sublimation)/dT 873 zevap (:,:) = rn_efac * ( emp(:,:) + tprecip(:,:) ) ! evaporation over ocean 874 874 875 875 ! --- evaporation minus precipitation --- ! … … 884 884 & + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp & ! liquid precip at Tair 885 885 & + sprecip(:,:) * ( 1._wp - zsnw ) * & ! solid precip at min(Tair,Tsnow) 886 & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 _snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus )886 & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus ) 887 887 qemp_ice(:,:) = sprecip(:,:) * zsnw * & ! solid precip (only) 888 & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 _snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus )888 & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus ) 889 889 890 890 ! --- total solar and non solar fluxes --- ! … … 894 894 895 895 ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 896 qprec_ice(:,:) = rhos n * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus )896 qprec_ice(:,:) = rhos * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus ) 897 897 898 898 ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- 899 899 DO jl = 1, jpl 900 qevap_ice(:,:,jl) = 0._wp ! should be -evap_ice(:,:,jl)*( ( Tice - rt0 ) * cpic* tmask(:,:,1) )900 qevap_ice(:,:,jl) = 0._wp ! should be -evap_ice(:,:,jl)*( ( Tice - rt0 ) * rcpi * tmask(:,:,1) ) 901 901 ! ! But we do not have Tice => consider it at 0degC => evap=0 902 902 END DO … … 907 907 ! 908 908 WHERE ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 909 q sr_ice_tr(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) )909 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 910 910 ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp ) ! constant (zfr1) when hi>10cm 911 q sr_ice_tr(:,:,:) = qsr_ice(:,:,:) * zfr1911 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1 912 912 ELSEWHERE ! zero when hs>0 913 q sr_ice_tr(:,:,:) = 0._wp913 qtr_ice_top(:,:,:) = 0._wp 914 914 END WHERE 915 915 ! … … 971 971 CASE ( 1 , 2 ) 972 972 ! 973 zfac = 1._wp / ( rn_cnd_s + rc dic)973 zfac = 1._wp / ( rn_cnd_s + rcnd_i ) 974 974 zfac2 = EXP(1._wp) * 0.5_wp * zepsilon 975 975 zfac3 = 2._wp / zepsilon … … 978 978 DO jj = 1 , jpj 979 979 DO ji = 1, jpi 980 zhe = ( rn_cnd_s * phi(ji,jj,jl) + rc dic * phs(ji,jj,jl) ) * zfac! Effective thickness980 zhe = ( rn_cnd_s * phi(ji,jj,jl) + rcnd_i * phs(ji,jj,jl) ) * zfac ! Effective thickness 981 981 IF( zhe >= zfac2 ) zgfac(ji,jj,jl) = MIN( 2._wp, 0.5_wp * ( 1._wp + LOG( zhe * zfac3 ) ) ) ! Enhanced conduction factor 982 982 END DO … … 990 990 ! -------------------------------------------------------------! 991 991 ! 992 zfac = rc dic* rn_cnd_s992 zfac = rcnd_i * rn_cnd_s 993 993 ! 994 994 DO jl = 1, jpl … … 997 997 ! 998 998 zkeff_h = zfac * zgfac(ji,jj,jl) / & ! Effective conductivity of the snow-ice system divided by thickness 999 & ( rc dic* phs(ji,jj,jl) + rn_cnd_s * MAX( 0.01, phi(ji,jj,jl) ) )999 & ( rcnd_i * phs(ji,jj,jl) + rn_cnd_s * MAX( 0.01, phi(ji,jj,jl) ) ) 1000 1000 ztsu = ptsu(ji,jj,jl) ! Store current iteration temperature 1001 1001 ztsu0 = ptsu(ji,jj,jl) ! Store initial surface temperature 1002 zqa0 = qsr_ice(ji,jj,jl) - q sr_ice_tr(ji,jj,jl) + qns_ice(ji,jj,jl)! Net initial atmospheric heat flux1002 zqa0 = qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + qns_ice(ji,jj,jl) ! Net initial atmospheric heat flux 1003 1003 ! 1004 1004 DO iter = 1, nit ! --- Iterative loop … … 1011 1011 qcn_ice(ji,jj,jl) = zkeff_h * ( ptsu(ji,jj,jl) - ptb(ji,jj) ) 1012 1012 qns_ice(ji,jj,jl) = qns_ice(ji,jj,jl) + dqns_ice(ji,jj,jl) * ( ptsu(ji,jj,jl) - ztsu0 ) 1013 qml_ice(ji,jj,jl) = ( qsr_ice(ji,jj,jl) - q sr_ice_tr(ji,jj,jl) + qns_ice(ji,jj,jl) - qcn_ice(ji,jj,jl) )&1013 qml_ice(ji,jj,jl) = ( qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + qns_ice(ji,jj,jl) - qcn_ice(ji,jj,jl) ) & 1014 1014 & * MAX( 0._wp , SIGN( 1._wp, ptsu(ji,jj,jl) - rt0 ) ) 1015 1016 ! --- Diagnose the heat loss due to changing non-solar flux (as in icethd_zdf_bl99) --- ! 1017 hfx_err_dif(ji,jj) = hfx_err_dif(ji,jj) - ( dqns_ice(ji,jj,jl) * ( ptsu(ji,jj,jl) - ztsu0 ) ) * a_i_b(ji,jj,jl) 1015 1018 1016 1019 END DO -
NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC/sbcblk_algo_coare.F90
- Property svn:keywords set to Id
-
NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC/sbcblk_algo_coare3p5.F90
- Property svn:keywords set to Id
-
NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC/sbcblk_algo_ecmwf.F90
- Property svn:keywords set to Id
-
NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC/sbcblk_algo_ncar.F90
- Property svn:keywords set to Id
r9570 r10288 149 149 Ch = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1. - stab)) 150 150 stab = sqrt_Cd_n10 ! Temporaty array !!! stab == SQRT(Cd) 151 152 IF( ln_cdgw ) Cen = Ce ; Chn = Ch 151 153 152 154 !! Initializing values at z_u with z_t values: … … 186 188 IF( ln_cdgw ) THEN ! surface wave case 187 189 stab = vkarmn / ( vkarmn / sqrt_Cd_n10 - ztmp2 ) ! (stab == SQRT(Cd)) 188 Cd = stab * stab 190 Cd = stab * stab 191 ztmp0 = (LOG(zu/10.) - zpsi_h_u) / vkarmn / sqrt_Cd_n10 192 ztmp2 = stab / sqrt_Cd_n10 ! (stab == SQRT(Cd)) 193 ztmp1 = 1. + Chn * ztmp0 194 Ch = Chn * ztmp2 / ztmp1 ! L&Y 2004 eq. (10b) 195 ztmp1 = 1. + Cen * ztmp0 196 Ce = Cen * ztmp2 / ztmp1 ! L&Y 2004 eq. (10c) 197 189 198 ELSE 190 199 ! Update neutral wind speed at 10m and neutral Cd at 10m (L&Y 2004 eq. 9a)... … … 205 214 Cd = ztmp0 / ( ztmp1*ztmp1 ) 206 215 stab = SQRT( Cd ) ! Temporary array !!! (stab == SQRT(Cd)) 207 ENDIF 208 209 ztmp0 = (LOG(zu/10.) - zpsi_h_u) / vkarmn / sqrt_Cd_n10210 ztmp2 = stab / sqrt_Cd_n10 ! (stab == SQRT(Cd))211 ztmp1 = 1. + Cx_n10*ztmp0 ! (Cx_n10 == Ch_n10)212 Ch = Cx_n10*ztmp2 / ztmp1 ! L&Y 2004 eq. (10b) 213 214 Cx_n10 = 1.e-3 * (34.6 * sqrt_Cd_n10) ! L&Y 2004 eq. (6b) ! Cx_n10 == Ce_n10215 Cen(:,:) = Cx_n10216 ztmp1 = 1. + Cx_n10*ztmp0217 Ce = Cx_n10*ztmp2 / ztmp1 ! L&Y 2004 eq. (10c)216 217 ztmp0 = (LOG(zu/10.) - zpsi_h_u) / vkarmn / sqrt_Cd_n10 218 ztmp2 = stab / sqrt_Cd_n10 ! (stab == SQRT(Cd)) 219 ztmp1 = 1. + Cx_n10*ztmp0 ! (Cx_n10 == Ch_n10) 220 Ch = Cx_n10*ztmp2 / ztmp1 ! L&Y 2004 eq. (10b) 221 222 Cx_n10 = 1.e-3 * (34.6 * sqrt_Cd_n10) ! L&Y 2004 eq. (6b) ! Cx_n10 == Ce_n10 223 Cen(:,:) = Cx_n10 224 ztmp1 = 1. + Cx_n10*ztmp0 225 Ce = Cx_n10*ztmp2 / ztmp1 ! L&Y 2004 eq. (10c) 226 ENDIF 218 227 ! 219 228 END DO -
NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC/sbccpl.F90
r9767 r10288 202 202 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 203 203 !! $Id$ 204 !! Software governed by the CeCILL licen ce (./LICENSE)204 !! Software governed by the CeCILL license (see ./LICENSE) 205 205 !!---------------------------------------------------------------------- 206 206 CONTAINS … … 1352 1352 IF( srcv(jpr_ocx1)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1353 1353 ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) 1354 ub (:,:,1) = ssu_m(:,:) ! will be used in icestp in the call of lim_sbc_tau1354 ub (:,:,1) = ssu_m(:,:) ! will be used in icestp in the call of ice_forcing_tau 1355 1355 un (:,:,1) = ssu_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling 1356 1356 CALL iom_put( 'ssu_m', ssu_m ) … … 1358 1358 IF( srcv(jpr_ocy1)%laction ) THEN 1359 1359 ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) 1360 vb (:,:,1) = ssv_m(:,:) ! will be used in icestp in the call of lim_sbc_tau1360 vb (:,:,1) = ssv_m(:,:) ! will be used in icestp in the call of ice_forcing_tau 1361 1361 vn (:,:,1) = ssv_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling 1362 1362 CALL iom_put( 'ssv_m', ssv_m ) … … 1418 1418 zqns(:,:) = zqns(:,:) - zemp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST) 1419 1419 IF( srcv(jpr_snow )%laction ) THEN 1420 zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus! energy for melting solid precipitation over the free ocean1420 zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * rLfus ! energy for melting solid precipitation over the free ocean 1421 1421 ENDIF 1422 1422 ENDIF 1423 1423 ! 1424 IF( srcv(jpr_icb)%laction ) zqns(:,:) = zqns(:,:) - frcv(jpr_icb)%z3(:,:,1) * lfus ! remove heat content associated to iceberg melting1424 IF( srcv(jpr_icb)%laction ) zqns(:,:) = zqns(:,:) - frcv(jpr_icb)%z3(:,:,1) * rLfus ! remove heat content associated to iceberg melting 1425 1425 ! 1426 1426 IF( ln_mixcpl ) THEN ; qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:) … … 1811 1811 ! 1812 1812 ! --- calving (removed from qns_tot) --- ! 1813 IF( srcv(jpr_cal)%laction ) zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) * lfus ! remove latent heat of calving1814 ! we suppose it melts at 0deg, though it should be temp. of surrounding ocean1813 IF( srcv(jpr_cal)%laction ) zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) * rLfus ! remove latent heat of calving 1814 ! we suppose it melts at 0deg, though it should be temp. of surrounding ocean 1815 1815 ! --- iceberg (removed from qns_tot) --- ! 1816 IF( srcv(jpr_icb)%laction ) zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_icb)%z3(:,:,1) * lfus ! remove latent heat of iceberg melting1816 IF( srcv(jpr_icb)%laction ) zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_icb)%z3(:,:,1) * rLfus ! remove latent heat of iceberg melting 1817 1817 1818 1818 #if defined key_si3 … … 1823 1823 1824 1824 ! Heat content per unit mass of snow (J/kg) 1825 WHERE( SUM( a_i, dim=3 ) > 1.e-10 ) ; zcptsnw(:,:) = cpic* SUM( (tn_ice - rt0) * a_i, dim=3 ) / SUM( a_i, dim=3 )1825 WHERE( SUM( a_i, dim=3 ) > 1.e-10 ) ; zcptsnw(:,:) = rcpi * SUM( (tn_ice - rt0) * a_i, dim=3 ) / SUM( a_i, dim=3 ) 1826 1826 ELSEWHERE ; zcptsnw(:,:) = zcptn(:,:) 1827 1827 ENDWHERE … … 1830 1830 1831 1831 ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- ! 1832 zqprec_ice(:,:) = rhos n * ( zcptsnw(:,:) - lfus )1832 zqprec_ice(:,:) = rhos * ( zcptsnw(:,:) - rLfus ) 1833 1833 1834 1834 ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- ! 1835 1835 DO jl = 1, jpl 1836 zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * cpic) but atm. does not take it into account1836 zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * rcpi ) but atm. does not take it into account 1837 1837 END DO 1838 1838 … … 1840 1840 zqemp_oce(:,:) = - zevap_oce(:,:) * zcptn (:,:) & ! evap 1841 1841 & + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptrain(:,:) & ! liquid precip 1842 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptsnw (:,:) - lfus )! solid precip over ocean + snow melting1843 zqemp_ice(:,:) = zsprecip(:,:) * zsnw * ( zcptsnw (:,:) - lfus )! solid precip over ice (qevap_ice=0 since atm. does not take it into account)1842 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptsnw (:,:) - rLfus ) ! solid precip over ocean + snow melting 1843 zqemp_ice(:,:) = zsprecip(:,:) * zsnw * ( zcptsnw (:,:) - rLfus ) ! solid precip over ice (qevap_ice=0 since atm. does not take it into account) 1844 1844 !! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * zcptsnw (:,:) & ! ice evap 1845 !! & + zsprecip(:,:) * zsnw * zqprec_ice(:,:) * r1_rhos n! solid precip over ice1845 !! & + zsprecip(:,:) * zsnw * zqprec_ice(:,:) * r1_rhos ! solid precip over ice 1846 1846 1847 1847 ! --- total non solar flux (including evap/precip) --- ! … … 1874 1874 1875 1875 ! clem: this formulation is certainly wrong... but better than it was... 1876 zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with:1877 & - ( ziceld(:,:) * zsprecip(:,:) * lfus ) & ! remove the latent heat flux of solid precip. melting1878 & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST)1876 zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: 1877 & - ( ziceld(:,:) * zsprecip(:,:) * rLfus ) & ! remove the latent heat flux of solid precip. melting 1878 & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 1879 1879 & - zemp_ice(:,:) ) * zcptn(:,:) 1880 1880 … … 1892 1892 #endif 1893 1893 ! outputs 1894 IF ( srcv(jpr_cal)%laction ) CALL iom_put('hflx_cal_cea' , - frcv(jpr_cal)%z3(:,:,1) * lfus )! latent heat from calving1895 IF ( srcv(jpr_icb)%laction ) CALL iom_put('hflx_icb_cea' , - frcv(jpr_icb)%z3(:,:,1) * lfus )! latent heat from icebergs melting1894 IF ( srcv(jpr_cal)%laction ) CALL iom_put('hflx_cal_cea' , - frcv(jpr_cal)%z3(:,:,1) * rLfus ) ! latent heat from calving 1895 IF ( srcv(jpr_icb)%laction ) CALL iom_put('hflx_icb_cea' , - frcv(jpr_icb)%z3(:,:,1) * rLfus ) ! latent heat from icebergs melting 1896 1896 IF ( iom_use('hflx_rain_cea') ) CALL iom_put('hflx_rain_cea' , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) ! heat flux from rain (cell average) 1897 1897 IF ( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea' , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) & 1898 1898 & * picefr(:,:) ) * zcptn(:,:) * tmask(:,:,1) ) ! heat flux from evap (cell average) 1899 IF ( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea' , sprecip(:,:) * ( zcptsnw(:,:) - Lfus )) ! heat flux from snow (cell average)1900 IF ( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - Lfus ) &1899 IF ( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea' , sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) ) ! heat flux from snow (cell average) 1900 IF ( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 1901 1901 & * ( 1._wp - zsnw(:,:) ) ) ! heat flux from snow (over ocean) 1902 IF ( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - Lfus ) &1902 IF ( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 1903 1903 & * zsnw(:,:) ) ! heat flux from snow (over ice) 1904 1904 ! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp. … … 1999 1999 ! ! ========================= ! 2000 2000 CASE ('coupled') 2001 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i(:,:,:)2002 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i(:,:,:)2001 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 2002 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 2003 2003 END SELECT 2004 2004 ! … … 2012 2012 ztri = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ! surface transmission parameter (Grenfell Maykut 77) 2013 2013 ! 2014 q sr_ice_tr(:,:,:) = ztri * qsr_ice(:,:,:)2015 WHERE( phs(:,:,:) >= 0.0_wp ) q sr_ice_tr(:,:,:) = 0._wp ! snow fully opaque2016 WHERE( phi(:,:,:) <= 0.1_wp ) q sr_ice_tr(:,:,:) = qsr_ice(:,:,:) ! thin ice transmits all solar radiation2014 qtr_ice_top(:,:,:) = ztri * qsr_ice(:,:,:) 2015 WHERE( phs(:,:,:) >= 0.0_wp ) qtr_ice_top(:,:,:) = 0._wp ! snow fully opaque 2016 WHERE( phi(:,:,:) <= 0.1_wp ) qtr_ice_top(:,:,:) = qsr_ice(:,:,:) ! thin ice transmits all solar radiation 2017 2017 ! 2018 2018 CASE( np_jules_ACTIVE ) !== Jules coupler is active ==! 2019 2019 ! 2020 ! ! ===> here we must receive the q sr_ice_trarray from the coupler2020 ! ! ===> here we must receive the qtr_ice_top array from the coupler 2021 2021 ! for now just assume zero (fully opaque ice) 2022 q sr_ice_tr(:,:,:) = 0._wp2022 qtr_ice_top(:,:,:) = 0._wp 2023 2023 ! 2024 2024 END SELECT -
NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC/sbcdcy.F90
r9598 r10288 31 31 32 32 !!---------------------------------------------------------------------- 33 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 33 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 34 34 !! $Id$ 35 !! Software governed by the CeCILL licen ce (./LICENSE)35 !! Software governed by the CeCILL license (see ./LICENSE) 36 36 !!---------------------------------------------------------------------- 37 37 CONTAINS -
NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC/sbcflx.F90
r9727 r10288 40 40 # include "vectopt_loop_substitute.h90" 41 41 !!---------------------------------------------------------------------- 42 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 42 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 43 43 !! $Id$ 44 !! Software governed by the CeCILL licen ce (./LICENSE)44 !! Software governed by the CeCILL license (see ./LICENSE) 45 45 !!---------------------------------------------------------------------- 46 46 CONTAINS -
NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC/sbcfwb.F90
r9598 r10288 44 44 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 45 45 !! $Id$ 46 !! Software governed by the CeCILL licen ce (./LICENSE)46 !! Software governed by the CeCILL license (see ./LICENSE) 47 47 !!---------------------------------------------------------------------- 48 48 CONTAINS … … 155 155 ztmsk_neg(:,:) = tmask_i(:,:) - ztmsk_pos(:,:) 156 156 ! 157 zsurf_neg = glob_sum( e1e2t(:,:)*ztmsk_neg(:,:) ) ! Area filled by <0 and >0 erp158 zsurf_pos = glob_sum( e1e2t(:,:)*ztmsk_pos(:,:) )159 157 ! ! fwf global mean (excluding ocean to ice/snow exchanges) 160 158 z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) - snwice_fmass(:,:) ) ) / area 161 159 ! 162 160 IF( z_fwf < 0._wp ) THEN ! spread out over >0 erp area to increase evaporation 161 zsurf_pos = glob_sum( e1e2t(:,:)*ztmsk_pos(:,:) ) 163 162 zsurf_tospread = zsurf_pos 164 163 ztmsk_tospread(:,:) = ztmsk_pos(:,:) 165 164 ELSE ! spread out over <0 erp area to increase precipitation 165 zsurf_neg = glob_sum( e1e2t(:,:)*ztmsk_neg(:,:) ) ! Area filled by <0 and >0 erp 166 166 zsurf_tospread = zsurf_neg 167 167 ztmsk_tospread(:,:) = ztmsk_neg(:,:) -
NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC/sbcice_cice.F90
r9598 r10288 13 13 USE dom_oce ! ocean space and time domain 14 14 USE domvvl 15 USE phycst, only : rcp, rau0, r1_rau0, rhos n, rhoic15 USE phycst, only : rcp, rau0, r1_rau0, rhos, rhoi 16 16 USE in_out_manager ! I/O manager 17 17 USE iom, ONLY : iom_put,iom_use ! I/O manager library !!Joakim edit … … 89 89 90 90 !!---------------------------------------------------------------------- 91 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 91 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 92 92 !! $Id$ 93 !! Software governed by the CeCILL licen ce (./LICENSE)93 !! Software governed by the CeCILL license (see ./LICENSE) 94 94 !!---------------------------------------------------------------------- 95 95 CONTAINS … … 222 222 CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. ) 223 223 CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. ) 224 snwice_mass (:,:) = ( rhos n * ztmp1(:,:) + rhoic* ztmp2(:,:) )224 snwice_mass (:,:) = ( rhos * ztmp1(:,:) + rhoi * ztmp2(:,:) ) 225 225 snwice_mass_b(:,:) = snwice_mass(:,:) 226 226 … … 328 328 ELSE 329 329 ! emp_ice is set in sbc_cpl_ice_flx as sublimation-snow 330 qla_ice(:,:,1)= - ( emp_ice(:,:)+sprecip(:,:) ) * Lsub330 qla_ice(:,:,1)= - ( emp_ice(:,:)+sprecip(:,:) ) * rLsub 331 331 ! End of temporary code 332 332 DO jj=1,jpj … … 644 644 CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. ) 645 645 CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. ) 646 snwice_mass (:,:) = ( rhos n * ztmp1(:,:) + rhoic* ztmp2(:,:) )646 snwice_mass (:,:) = ( rhos * ztmp1(:,:) + rhoi * ztmp2(:,:) ) 647 647 snwice_mass_b(:,:) = snwice_mass(:,:) 648 648 snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) / dt … … 801 801 tprecip(:,:) = sf(jp_snow)%fnow(:,:,1)+sf(jp_rain)%fnow(:,:,1) 802 802 ! May be better to do this conversion somewhere else 803 qla_ice(:,:,1) = - Lsub*sf(jp_sblm)%fnow(:,:,1)803 qla_ice(:,:,1) = -rLsub*sf(jp_sblm)%fnow(:,:,1) 804 804 topmelt(:,:,1) = sf(jp_top1)%fnow(:,:,1) 805 805 topmelt(:,:,2) = sf(jp_top2)%fnow(:,:,1) … … 1051 1051 1052 1052 SUBROUTINE sbc_ice_cice ( kt, ksbc ) ! Dummy routine 1053 IMPLICIT NONE 1054 INTEGER, INTENT( in ) :: kt, ksbc 1053 1055 WRITE(*,*) 'sbc_ice_cice: You should not have seen this print! error?', kt 1054 1056 END SUBROUTINE sbc_ice_cice 1055 1057 1056 1058 SUBROUTINE cice_sbc_init (ksbc) ! Dummy routine 1057 WRITE(*,*) 'cice_sbc_init: You should not have seen this print! error?' 1059 IMPLICIT NONE 1060 INTEGER, INTENT( in ) :: ksbc 1061 WRITE(*,*) 'cice_sbc_init: You should not have seen this print! error?', ksbc 1058 1062 END SUBROUTINE cice_sbc_init 1059 1063 1060 1064 SUBROUTINE cice_sbc_final ! Dummy routine 1065 IMPLICIT NONE 1061 1066 WRITE(*,*) 'cice_sbc_final: You should not have seen this print! error?' 1062 1067 END SUBROUTINE cice_sbc_final -
NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC/sbcice_if.F90
r9598 r10288 38 38 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 39 39 !! $Id$ 40 !! Software governed by the CeCILL licen ce (./LICENSE)40 !! Software governed by the CeCILL license (see ./LICENSE) 41 41 !!---------------------------------------------------------------------- 42 42 CONTAINS -
NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC/sbcisf.F90
r9865 r10288 52 52 LOGICAL, PUBLIC :: l_isfcpl = .false. !: isf recieved from oasis 53 53 54 REAL(wp), PUBLIC, SAVE :: rcpi 54 REAL(wp), PUBLIC, SAVE :: rcpisf = 2000.0_wp !: specific heat of ice shelf [J/kg/K] 55 55 REAL(wp), PUBLIC, SAVE :: rkappa = 1.54e-6_wp !: heat diffusivity through the ice-shelf [m2/s] 56 56 REAL(wp), PUBLIC, SAVE :: rhoisf = 920.0_wp !: volumic mass of ice shelf [kg/m3] 57 57 REAL(wp), PUBLIC, SAVE :: tsurf = -20.0_wp !: air temperature on top of ice shelf [C] 58 REAL(wp), PUBLIC, SAVE :: r lfusisf = 0.334e6_wp !: latent heat of fusion of ice shelf [J/kg]58 REAL(wp), PUBLIC, SAVE :: rLfusisf = 0.334e6_wp !: latent heat of fusion of ice shelf [J/kg] 59 59 60 60 !: Variable used in fldread to read the forcing file (nn_isf == 4 .OR. nn_isf == 3) … … 71 71 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 72 72 !! $Id$ 73 !! Software governed by the CeCILL licen ce (modipsl/doc/NEMO_CeCILL.txt)73 !! Software governed by the CeCILL license (see ./LICENSE) 74 74 !!---------------------------------------------------------------------- 75 75 CONTAINS … … 114 114 ! compute fwf and heat flux 115 115 IF( .NOT.l_isfcpl ) THEN ; CALL sbc_isf_cav (kt) 116 ELSE ; qisf(:,:) = fwfisf(:,:) * r lfusisf ! heat flux116 ELSE ; qisf(:,:) = fwfisf(:,:) * rLfusisf ! heat flux 117 117 ENDIF 118 118 ! … … 127 127 fwfisf(:,:) = - sf_rnfisf(1)%fnow(:,:,1) ! fresh water flux from the isf (fwfisf <0 mean melting) 128 128 ENDIF 129 qisf(:,:) = fwfisf(:,:) * r lfusisf ! heat flux129 qisf(:,:) = fwfisf(:,:) * rLfusisf ! heat flux 130 130 stbl(:,:) = soce 131 131 ! … … 137 137 fwfisf(:,:) = -sf_fwfisf(1)%fnow(:,:,1) ! fwf 138 138 ENDIF 139 qisf(:,:) = fwfisf(:,:) * r lfusisf ! heat flux139 qisf(:,:) = fwfisf(:,:) * rLfusisf ! heat flux 140 140 stbl(:,:) = soce 141 141 ! … … 454 454 & * r1_e1e2t(ji,jj) * tmask(ji,jj,jk) 455 455 456 fwfisf(ji,jj) = qisf(ji,jj) / r lfusisf !fresh water flux kg/(m2s)456 fwfisf(ji,jj) = qisf(ji,jj) / rLfusisf !fresh water flux kg/(m2s) 457 457 fwfisf(ji,jj) = fwfisf(ji,jj) * ( soce / stbl(ji,jj) ) 458 458 !add to salinity trend … … 526 526 DO ji = 1, jpi 527 527 zhtflx(ji,jj) = zgammat(ji,jj)*rcp*rau0*(ttbl(ji,jj)-zfrz(ji,jj)) 528 zfwflx(ji,jj) = - zhtflx(ji,jj)/r lfusisf528 zfwflx(ji,jj) = - zhtflx(ji,jj)/rLfusisf 529 529 END DO 530 530 END DO … … 544 544 ! compute coeficient to solve the 2nd order equation 545 545 zeps1 = rcp*rau0*zgammat(ji,jj) 546 zeps2 = r lfusisf*rau0*zgammas(ji,jj)547 zeps3 = rhoisf*rcpi *rkappa/MAX(risfdep(ji,jj),zeps)546 zeps2 = rLfusisf*rau0*zgammas(ji,jj) 547 zeps3 = rhoisf*rcpisf*rkappa/MAX(risfdep(ji,jj),zeps) 548 548 zeps4 = zlamb2+zlamb3*risfdep(ji,jj) 549 549 zeps6 = zeps4-ttbl(ji,jj) -
NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC/sbcmod.F90
r9656 r10288 46 46 USE sbcfwb ! surface boundary condition: freshwater budget 47 47 USE icbstp ! Icebergs 48 USE icb_oce , ONLY : ln_passive_mode ! iceberg interaction mode 48 49 USE traqsr ! active tracers: light penetration 49 50 USE sbcwave ! Wave module … … 68 69 69 70 !!---------------------------------------------------------------------- 70 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 71 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 71 72 !! $Id$ 72 !! Software governed by the CeCILL licen ce (./LICENSE)73 !! Software governed by the CeCILL license (see ./LICENSE) 73 74 !!---------------------------------------------------------------------- 74 75 CONTAINS … … 156 157 WRITE(numout,*) ' wave modified ocean stress component ln_tauw = ', ln_tauw 157 158 WRITE(numout,*) ' Stokes coriolis term ln_stcor = ', ln_stcor 158 WRITE(numout,*) ' neutral drag coefficient (CORE, MFS) ln_cdgw = ', ln_cdgw 159 ENDIF 160 ! 159 WRITE(numout,*) ' neutral drag coefficient (CORE,NCAR) ln_cdgw = ', ln_cdgw 160 ENDIF 161 ! 162 IF( .NOT.ln_wave ) THEN 163 ln_sdw = .false. ; ln_cdgw = .false. ; ln_tauwoc = .false. ; ln_tauw = .false. ; ln_stcor = .false. 164 ENDIF 161 165 IF( ln_sdw ) THEN 162 166 IF( .NOT.(nn_sdrift==jp_breivik_2014 .OR. nn_sdrift==jp_li_2017 .OR. nn_sdrift==jp_peakfr) ) & … … 432 436 END SELECT 433 437 434 IF( ln_icebergs ) CALL icb_stp( kt ) ! compute icebergs 438 IF( ln_icebergs ) THEN 439 CALL icb_stp( kt ) ! compute icebergs 440 ! icebergs may advect into haloes during the icb step and alter emp. 441 ! A lbc_lnk is necessary here to ensure restartability (#2113) 442 IF( .NOT. ln_passive_mode ) CALL lbc_lnk( emp, 'T', 1. ) ! ensure restartability with icebergs 443 ENDIF 435 444 436 445 IF( ln_isf ) CALL sbc_isf( kt ) ! compute iceshelves -
NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC/sbcrnf.F90
r9727 r10288 71 71 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 72 72 !! $Id$ 73 !! Software governed by the CeCILL licen ce (./LICENSE)73 !! Software governed by the CeCILL license (see ./LICENSE) 74 74 !!---------------------------------------------------------------------- 75 75 CONTAINS … … 128 128 END WHERE 129 129 WHERE( sf_t_rnf(1)%fnow(:,:,1) == -222._wp ) ! where fwf comes from melting of ice shelves or iceberg 130 rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rau0 - rnf(:,:) * r lfusisf * r1_rau0_rcp130 rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rau0 - rnf(:,:) * rLfusisf * r1_rau0_rcp 131 131 END WHERE 132 132 ELSE ! use SST as runoffs temperature -
NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC/sbcssm.F90
r9598 r10288 34 34 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 35 35 !! $Id$ 36 !! Software governed by the CeCILL licen ce (./LICENSE)36 !! Software governed by the CeCILL license (see ./LICENSE) 37 37 !!---------------------------------------------------------------------- 38 38 CONTAINS -
NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC/sbcssr.F90
r9727 r10288 49 49 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 50 50 !! $Id$ 51 !! Software governed by the CeCILL licen ce (./LICENSE)51 !! Software governed by the CeCILL license (see ./LICENSE) 52 52 !!---------------------------------------------------------------------- 53 53 CONTAINS -
NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC/sbctide.F90
r9598 r10288 35 35 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 36 36 !! $Id$ 37 !! Software governed by the CeCILL licen ce (./LICENSE)37 !! Software governed by the CeCILL license (see ./LICENSE) 38 38 !!---------------------------------------------------------------------- 39 39 CONTAINS -
NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC/sbcwave.F90
r9821 r10288 74 74 # include "vectopt_loop_substitute.h90" 75 75 !!---------------------------------------------------------------------- 76 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 76 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 77 77 !! $Id$ 78 !! Software governed by the CeCILL licen ce (./LICENSE)78 !! Software governed by the CeCILL license (see ./LICENSE) 79 79 !!---------------------------------------------------------------------- 80 80 CONTAINS … … 131 131 END DO 132 132 ELSE IF( ll_st_peakfr ) THEN ! peak wave number calculated from the peak frequency received by the wave model 133 DO jj = 1, jpj 134 DO ji = 1, jpi 135 zk_t(ji,jj) = ( 2.0_wp * rpi * wfreq(ji,jj) ) * ( 2.0_wp * rpi * wfreq(ji,jj) ) / grav 136 END DO 137 END DO 133 138 DO jj = 1, jpjm1 134 139 DO ji = 1, jpim1 135 zk_u(ji,jj) = 0.5_wp * ( wfreq(ji,jj)*wfreq(ji,jj) + wfreq(ji+1,jj)*wfreq(ji+1,jj) ) / grav136 zk_v(ji,jj) = 0.5_wp * ( wfreq(ji,jj)*wfreq(ji,jj) + wfreq(ji,jj+1)*wfreq(ji,jj+1) ) / grav140 zk_u(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji+1,jj) ) 141 zk_v(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji,jj+1) ) 137 142 ! 138 143 zu0_sd(ji,jj) = 0.5_wp * ( ut0sd(ji,jj) + ut0sd(ji+1,jj) ) -
NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC/tide.h90
- Property svn:keywords set to Id
-
NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC/tide_mod.F90
r9598 r10288 34 34 35 35 !!---------------------------------------------------------------------- 36 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 36 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 37 37 !! $Id$ 38 !! Software governed by the CeCILL licen ce (modipsl/doc/NEMO_CeCILL.txt)38 !! Software governed by the CeCILL license (see ./LICENSE) 39 39 !!---------------------------------------------------------------------- 40 40 CONTAINS -
NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC/tideini.F90
r9598 r10288 41 41 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 42 42 !! $Id$ 43 !! Software governed by the CeCILL licen ce (./LICENSE)43 !! Software governed by the CeCILL license (see ./LICENSE) 44 44 !!---------------------------------------------------------------------- 45 45 CONTAINS -
NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/OCE/SBC/updtide.F90
r9598 r10288 23 23 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 24 24 !! $Id$ 25 !! Software governed by the CeCILL licen ce (./LICENSE)25 !! Software governed by the CeCILL license (see ./LICENSE) 26 26 !!---------------------------------------------------------------------- 27 27 CONTAINS
Note: See TracChangeset
for help on using the changeset viewer.