Changeset 13258 for NEMO/branches/2020/dev_r12973_AGRIF_CMEMS/src/OCE/SBC
- Timestamp:
- 2020-07-07T12:23:18+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r12973_AGRIF_CMEMS
- Files:
-
- 15 edited
-
. (modified) (1 prop)
-
src/OCE/SBC/fldread.F90 (modified) (5 diffs)
-
src/OCE/SBC/geo2ocean.F90 (modified) (1 diff)
-
src/OCE/SBC/sbc_oce.F90 (modified) (1 diff)
-
src/OCE/SBC/sbcblk.F90 (modified) (19 diffs)
-
src/OCE/SBC/sbcblk_phy.F90 (modified) (2 diffs)
-
src/OCE/SBC/sbccpl.F90 (modified) (7 diffs)
-
src/OCE/SBC/sbcflx.F90 (modified) (1 diff)
-
src/OCE/SBC/sbcfwb.F90 (modified) (2 diffs)
-
src/OCE/SBC/sbcice_cice.F90 (modified) (10 diffs)
-
src/OCE/SBC/sbcmod.F90 (modified) (2 diffs)
-
src/OCE/SBC/sbcrnf.F90 (modified) (1 diff)
-
src/OCE/SBC/sbcssm.F90 (modified) (1 diff)
-
src/OCE/SBC/sbcssr.F90 (modified) (1 diff)
-
src/OCE/SBC/sbcwave.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12973_AGRIF_CMEMS
- Property svn:externals
-
old new 2 2 ^/utils/build/makenemo@HEAD makenemo 3 3 ^/utils/build/mk@HEAD mk 4 ^/utils/tools _dev_r12970_AGRIF_CMEMStools4 ^/utils/tools/@HEAD tools 5 5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM
-
- Property svn:externals
-
NEMO/branches/2020/dev_r12973_AGRIF_CMEMS/src/OCE/SBC/fldread.F90
r12489 r13258 127 127 !! * Substitutions 128 128 # include "do_loop_substitute.h90" 129 # include "domzgr_substitute.h90" 129 130 !!---------------------------------------------------------------------- 130 131 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 383 384 IF( sdjf%ln_tint ) THEN 384 385 CALL iom_get( sdjf%num, sdjf%clvar, sdjf%fdta(2,2,1,2), sdjf%nrec_a(1) ) 385 CALL lbc_lnk( 'fldread', sdjf%fdta(:,:,1,2),'Z',1. )386 CALL lbc_lnk( 'fldread', sdjf%fdta(:,:,1,2),'Z',1.0_wp ) 386 387 ELSE 387 388 CALL iom_get( sdjf%num, sdjf%clvar, sdjf%fnow(2,2,1 ), sdjf%nrec_a(1) ) 388 CALL lbc_lnk( 'fldread', sdjf%fnow(:,:,1 ),'Z',1. )389 CALL lbc_lnk( 'fldread', sdjf%fnow(:,:,1 ),'Z',1.0_wp ) 389 390 ENDIF 390 391 ELSE … … 397 398 IF( sdjf%ln_tint ) THEN 398 399 CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, sdjf%fdta(2,2,:,2), sdjf%nrec_a(1) ) 399 CALL lbc_lnk( 'fldread', sdjf%fdta(:,:,:,2),'Z',1. )400 CALL lbc_lnk( 'fldread', sdjf%fdta(:,:,:,2),'Z',1.0_wp ) 400 401 ELSE 401 402 CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, sdjf%fnow(2,2,: ), sdjf%nrec_a(1) ) 402 CALL lbc_lnk( 'fldread', sdjf%fnow(:,:,: ),'Z',1. )403 CALL lbc_lnk( 'fldread', sdjf%fnow(:,:,: ),'Z',1.0_wp ) 403 404 ENDIF 404 405 ELSE … … 632 633 zdhalf(jk) = zdhalf(jk-1) + e3v(ji,jj,jk-1,Kmm) 633 634 zdepth(jk) = zcoef * ( zdhalf(jk ) + 0.5_wp * e3vw(ji,jj,jk,Kmm)) & 634 &+ (1._wp-zcoef) * ( zdepth(jk-1) + e3vw(ji,jj,jk,Kmm))635 + (1._wp-zcoef) * ( zdepth(jk-1) + e3vw(ji,jj,jk,Kmm)) 635 636 END DO 636 637 END SELECT … … 1326 1327 !! D. Delrosso INGV 1327 1328 !!---------------------------------------------------------------------- 1328 INTEGER , INTENT(in ) :: ileni,ilenj ! lengths1329 REAL , DIMENSION (ileni,ilenj), INTENT(in ) :: zfieldn ! array of forcing field with undeff for land points1330 REAL , DIMENSION (ileni,ilenj), INTENT( out) :: zfield ! array of forcing field1331 ! 1332 REAL 1333 REAL 1334 REAL 1335 REAL 1336 LOGICAL , DIMENSION (ileni,ilenj,8) :: ll_msknan3d ! logical mask for undeff detection1337 LOGICAL , DIMENSION (ileni,ilenj) :: ll_msknan2d ! logical mask for undeff detection1329 INTEGER , INTENT(in ) :: ileni,ilenj ! lengths 1330 REAL(wp), DIMENSION (ileni,ilenj), INTENT(in ) :: zfieldn ! array of forcing field with undeff for land points 1331 REAL(wp), DIMENSION (ileni,ilenj), INTENT( out) :: zfield ! array of forcing field 1332 ! 1333 REAL(wp) , DIMENSION (ileni,ilenj) :: zmat1, zmat2, zmat3, zmat4 ! local arrays 1334 REAL(wp) , DIMENSION (ileni,ilenj) :: zmat5, zmat6, zmat7, zmat8 ! - - 1335 REAL(wp) , DIMENSION (ileni,ilenj) :: zlsm2d ! - - 1336 REAL(wp) , DIMENSION (ileni,ilenj,8) :: zlsm3d ! - - 1337 LOGICAL , DIMENSION (ileni,ilenj,8) :: ll_msknan3d ! logical mask for undeff detection 1338 LOGICAL , DIMENSION (ileni,ilenj) :: ll_msknan2d ! logical mask for undeff detection 1338 1339 !!---------------------------------------------------------------------- 1339 1340 zmat8 = eoshift( zfieldn , SHIFT=-1 , BOUNDARY = (/zfieldn(:,1)/) , DIM=2 ) -
NEMO/branches/2020/dev_r12973_AGRIF_CMEMS/src/OCE/SBC/geo2ocean.F90
r12377 r13258 272 272 ! =========================== ! 273 273 ! ! lateral boundary cond.: T-, U-, V-, F-pts, sgn 274 CALL lbc_lnk_multi( 'geo2ocean', gcost, 'T', -1. , gsint, 'T', -1., gcosu, 'U', -1., gsinu, 'U', -1., &275 & gcosv, 'V', -1. , gsinv, 'V', -1., gcosf, 'F', -1., gsinf, 'F', -1.)274 CALL lbc_lnk_multi( 'geo2ocean', gcost, 'T', -1.0_wp, gsint, 'T', -1.0_wp, gcosu, 'U', -1.0_wp, gsinu, 'U', -1.0_wp, & 275 & gcosv, 'V', -1.0_wp, gsinv, 'V', -1.0_wp, gcosf, 'F', -1.0_wp, gsinf, 'F', -1.0_wp ) 276 276 ! 277 277 END SUBROUTINE angle -
NEMO/branches/2020/dev_r12973_AGRIF_CMEMS/src/OCE/SBC/sbc_oce.F90
r12377 r13258 223 223 wndm(ji,jj) = SQRT ( ztau * zcoef ) * tmask(ji,jj,1) 224 224 END_2D 225 CALL lbc_lnk( 'sbc_oce', wndm(:,:) , 'T', 1. )225 CALL lbc_lnk( 'sbc_oce', wndm(:,:) , 'T', 1.0_wp ) 226 226 ! 227 227 END SUBROUTINE sbc_tau2wnd -
NEMO/branches/2020/dev_r12973_AGRIF_CMEMS/src/OCE/SBC/sbcblk.F90
r13185 r13258 74 74 #endif 75 75 76 INTEGER , PUBLIC :: jpfld ! maximum number of files to read 77 INTEGER , PUBLIC, PARAMETER :: jp_wndi = 1 ! index of 10m wind velocity (i-component) (m/s) at T-point 78 INTEGER , PUBLIC, PARAMETER :: jp_wndj = 2 ! index of 10m wind velocity (j-component) (m/s) at T-point 79 INTEGER , PUBLIC, PARAMETER :: jp_tair = 3 ! index of 10m air temperature (Kelvin) 80 INTEGER , PUBLIC, PARAMETER :: jp_humi = 4 ! index of specific humidity ( % ) 81 INTEGER , PUBLIC, PARAMETER :: jp_qsr = 5 ! index of solar heat (W/m2) 82 INTEGER , PUBLIC, PARAMETER :: jp_qlw = 6 ! index of Long wave (W/m2) 83 INTEGER , PUBLIC, PARAMETER :: jp_prec = 7 ! index of total precipitation (rain+snow) (Kg/m2/s) 84 INTEGER , PUBLIC, PARAMETER :: jp_snow = 8 ! index of snow (solid prcipitation) (kg/m2/s) 85 INTEGER , PUBLIC, PARAMETER :: jp_slp = 9 ! index of sea level pressure (Pa) 86 INTEGER , PUBLIC, PARAMETER :: jp_hpgi =10 ! index of ABL geostrophic wind or hpg (i-component) (m/s) at T-point 87 INTEGER , PUBLIC, PARAMETER :: jp_hpgj =11 ! index of ABL geostrophic wind or hpg (j-component) (m/s) at T-point 88 76 INTEGER , PUBLIC, PARAMETER :: jp_wndi = 1 ! index of 10m wind velocity (i-component) (m/s) at T-point 77 INTEGER , PUBLIC, PARAMETER :: jp_wndj = 2 ! index of 10m wind velocity (j-component) (m/s) at T-point 78 INTEGER , PUBLIC, PARAMETER :: jp_tair = 3 ! index of 10m air temperature (Kelvin) 79 INTEGER , PUBLIC, PARAMETER :: jp_humi = 4 ! index of specific humidity ( % ) 80 INTEGER , PUBLIC, PARAMETER :: jp_qsr = 5 ! index of solar heat (W/m2) 81 INTEGER , PUBLIC, PARAMETER :: jp_qlw = 6 ! index of Long wave (W/m2) 82 INTEGER , PUBLIC, PARAMETER :: jp_prec = 7 ! index of total precipitation (rain+snow) (Kg/m2/s) 83 INTEGER , PUBLIC, PARAMETER :: jp_snow = 8 ! index of snow (solid prcipitation) (kg/m2/s) 84 INTEGER , PUBLIC, PARAMETER :: jp_slp = 9 ! index of sea level pressure (Pa) 85 INTEGER , PUBLIC, PARAMETER :: jp_uoatm = 10 ! index of surface current (i-component) 86 ! ! seen by the atmospheric forcing (m/s) at T-point 87 INTEGER , PUBLIC, PARAMETER :: jp_voatm = 11 ! index of surface current (j-component) 88 ! ! seen by the atmospheric forcing (m/s) at T-point 89 INTEGER , PUBLIC, PARAMETER :: jp_hpgi = 12 ! index of ABL geostrophic wind or hpg (i-component) (m/s) at T-point 90 INTEGER , PUBLIC, PARAMETER :: jp_hpgj = 13 ! index of ABL geostrophic wind or hpg (j-component) (m/s) at T-point 91 INTEGER , PUBLIC, PARAMETER :: jpfld = 13 ! maximum number of files to read 92 93 ! Warning: keep this structure allocatable for Agrif... 89 94 TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf ! structure of input atmospheric fields (file informations, fields read) 90 95 … … 98 103 LOGICAL :: ln_Cd_L15 ! ice-atm drag = F( ice concentration, atmospheric stability ) (Lupkes et al. JGR2015) 99 104 ! 105 LOGICAL :: ln_crt_fbk ! Add surface current feedback to the wind stress computation (Renault et al. 2020) 106 REAL(wp) :: rn_stau_a ! Alpha and Beta coefficients of Renault et al. 2020, eq. 10: Stau = Alpha * Wnd + Beta 107 REAL(wp) :: rn_stau_b ! 108 ! 100 109 REAL(wp) :: rn_pfac ! multiplication factor for precipitation 101 110 REAL(wp), PUBLIC :: rn_efac ! multiplication factor for evaporation 102 REAL(wp), PUBLIC :: rn_vfac ! multiplication factor for ice/ocean velocity in the calculation of wind stress103 111 REAL(wp) :: rn_zqt ! z(q,t) : height of humidity and temperature measurements 104 112 REAL(wp) :: rn_zu ! z(u) : height of wind measurements 105 113 ! 106 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: Cd_ice , Ch_ice , Ce_ice ! transfert coefficients over ice107 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: Cdn_oce, Chn_oce, Cen_oce ! neutral coeffs over ocean (L15 bulk scheme)108 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: t_zu, q_zu ! air temp. and spec. hum. at wind speed height (L15 bulk scheme)114 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: Cdn_oce, Chn_oce, Cen_oce ! neutral coeffs over ocean (L15 bulk scheme and ABL) 115 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: Cd_ice , Ch_ice , Ce_ice ! transfert coefficients over ice 116 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: t_zu, q_zu ! air temp. and spec. hum. at wind speed height (L15 bulk scheme) 109 117 110 118 LOGICAL :: ln_skin_cs ! use the cool-skin (only available in ECMWF and COARE algorithms) !LB … … 113 121 LOGICAL :: ln_humi_dpt ! humidity read in files ("sn_humi") is dew-point temperature [K] if .true. !LB 114 122 LOGICAL :: ln_humi_rlh ! humidity read in files ("sn_humi") is relative humidity [%] if .true. !LB 123 LOGICAL :: ln_tpot !!GS: flag to compute or not potential temperature 115 124 ! 116 125 INTEGER :: nhumi ! choice of the bulk algorithm … … 162 171 !! 163 172 CHARACTER(len=100) :: cn_dir ! Root directory for location of atmospheric forcing files 164 TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i ! array of namelist informations on the fields to read 165 TYPE(FLD_N) :: sn_wndi, sn_wndj, sn_humi, sn_qsr ! informations about the fields to be read 166 TYPE(FLD_N) :: sn_qlw , sn_tair, sn_prec, sn_snow ! " " 167 TYPE(FLD_N) :: sn_slp , sn_hpgi, sn_hpgj ! " " 173 TYPE(FLD_N), DIMENSION(jpfld) :: slf_i ! array of namelist informations on the fields to read 174 TYPE(FLD_N) :: sn_wndi, sn_wndj , sn_humi, sn_qsr ! informations about the fields to be read 175 TYPE(FLD_N) :: sn_qlw , sn_tair , sn_prec, sn_snow ! " " 176 TYPE(FLD_N) :: sn_slp , sn_uoatm, sn_voatm ! " " 177 TYPE(FLD_N) :: sn_hpgi, sn_hpgj ! " " 178 INTEGER :: ipka ! number of levels in the atmospheric variable 168 179 NAMELIST/namsbc_blk/ sn_wndi, sn_wndj, sn_humi, sn_qsr, sn_qlw , & ! input fields 169 & sn_tair, sn_prec, sn_snow, sn_slp, sn_hpgi, sn_hpgj, & 180 & sn_tair, sn_prec, sn_snow, sn_slp, sn_uoatm, sn_voatm, & 181 & sn_hpgi, sn_hpgj, & 170 182 & ln_NCAR, ln_COARE_3p0, ln_COARE_3p6, ln_ECMWF, & ! bulk algorithm 171 183 & cn_dir , rn_zqt, rn_zu, & 172 & rn_pfac, rn_efac, rn_vfac, ln_Cd_L12, ln_Cd_L15, & 184 & rn_pfac, rn_efac, ln_Cd_L12, ln_Cd_L15, ln_tpot, & 185 & ln_crt_fbk, rn_stau_a, rn_stau_b, & ! current feedback 173 186 & ln_skin_cs, ln_skin_wl, ln_humi_sph, ln_humi_dpt, ln_humi_rlh ! cool-skin / warm-layer !LB 174 187 !!--------------------------------------------------------------------- … … 242 255 ! !* set the bulk structure 243 256 ! !- store namelist information in an array 244 IF( ln_blk ) jpfld = 9 245 IF( ln_abl ) jpfld = 11 246 ALLOCATE( slf_i(jpfld) ) 247 ! 248 slf_i(jp_wndi) = sn_wndi ; slf_i(jp_wndj) = sn_wndj 249 slf_i(jp_qsr ) = sn_qsr ; slf_i(jp_qlw ) = sn_qlw 250 slf_i(jp_tair) = sn_tair ; slf_i(jp_humi) = sn_humi 251 slf_i(jp_prec) = sn_prec ; slf_i(jp_snow) = sn_snow 252 slf_i(jp_slp ) = sn_slp 253 IF( ln_abl ) THEN 254 slf_i(jp_hpgi) = sn_hpgi ; slf_i(jp_hpgj) = sn_hpgj 255 END IF 257 ! 258 slf_i(jp_wndi ) = sn_wndi ; slf_i(jp_wndj ) = sn_wndj 259 slf_i(jp_qsr ) = sn_qsr ; slf_i(jp_qlw ) = sn_qlw 260 slf_i(jp_tair ) = sn_tair ; slf_i(jp_humi ) = sn_humi 261 slf_i(jp_prec ) = sn_prec ; slf_i(jp_snow ) = sn_snow 262 slf_i(jp_slp ) = sn_slp 263 slf_i(jp_uoatm) = sn_uoatm ; slf_i(jp_voatm) = sn_voatm 264 slf_i(jp_hpgi ) = sn_hpgi ; slf_i(jp_hpgj ) = sn_hpgj 265 ! 266 IF( .NOT. ln_abl ) THEN ! force to not use jp_hpgi and jp_hpgj, should already be done in namelist_* but we never know... 267 slf_i(jp_hpgi)%clname = 'NOT USED' 268 slf_i(jp_hpgj)%clname = 'NOT USED' 269 ENDIF 256 270 ! 257 271 ! !- allocate the bulk structure … … 264 278 DO jfpr= 1, jpfld 265 279 ! 266 IF( TRIM(sf(jfpr)%clrootname) == 'NOT USED' ) THEN !-- not used field --! (only now allocated and set to zero) 267 ALLOCATE( sf(jfpr)%fnow(jpi,jpj,1) ) 268 sf(jfpr)%fnow(:,:,1) = 0._wp 280 IF( ln_abl .AND. & 281 & ( jfpr == jp_wndi .OR. jfpr == jp_wndj .OR. jfpr == jp_humi .OR. & 282 & jfpr == jp_hpgi .OR. jfpr == jp_hpgj .OR. jfpr == jp_tair ) ) THEN 283 ipka = jpka ! ABL: some fields are 3D input 284 ELSE 285 ipka = 1 286 ENDIF 287 ! 288 ALLOCATE( sf(jfpr)%fnow(jpi,jpj,ipka) ) 289 ! 290 IF( TRIM(sf(jfpr)%clrootname) == 'NOT USED' ) THEN !-- not used field --! (only now allocated and set to default) 291 IF( jfpr == jp_slp ) THEN 292 sf(jfpr)%fnow(:,:,1:ipka) = 101325._wp ! use standard pressure in Pa 293 ELSEIF( jfpr == jp_prec .OR. jfpr == jp_snow .OR. jfpr == jp_uoatm .OR. jfpr == jp_voatm ) THEN 294 sf(jfpr)%fnow(:,:,1:ipka) = 0._wp ! no precip or no snow or no surface currents 295 ELSEIF( ( jfpr == jp_hpgi .OR. jfpr == jp_hpgj ) .AND. .NOT. ln_abl ) THEN 296 DEALLOCATE( sf(jfpr)%fnow ) ! deallocate as not used in this case 297 ELSE 298 WRITE(ctmp1,*) 'sbc_blk_init: no default value defined for field number', jfpr 299 CALL ctl_stop( ctmp1 ) 300 ENDIF 269 301 ELSE !-- used field --! 270 IF( ln_abl .AND. & 271 & ( jfpr == jp_wndi .OR. jfpr == jp_wndj .OR. jfpr == jp_humi .OR. & 272 & jfpr == jp_hpgi .OR. jfpr == jp_hpgj .OR. jfpr == jp_tair ) ) THEN ! ABL: some fields are 3D input 273 ALLOCATE( sf(jfpr)%fnow(jpi,jpj,jpka) ) 274 IF( sf(jfpr)%ln_tint ) ALLOCATE( sf(jfpr)%fdta(jpi,jpj,jpka,2) ) 275 ELSE ! others or Bulk fields are 2D fiels 276 ALLOCATE( sf(jfpr)%fnow(jpi,jpj,1) ) 277 IF( sf(jfpr)%ln_tint ) ALLOCATE( sf(jfpr)%fdta(jpi,jpj,1,2) ) 278 ENDIF 302 IF( sf(jfpr)%ln_tint ) ALLOCATE( sf(jfpr)%fdta(jpi,jpj,ipka,2) ) ! allocate array for temporal interpolation 279 303 ! 280 304 IF( sf(jfpr)%freqh > 0. .AND. MOD( NINT(3600. * sf(jfpr)%freqh), nn_fsbc * NINT(rn_Dt) ) /= 0 ) & … … 327 351 WRITE(numout,*) ' factor applied on precipitation (total & snow) rn_pfac = ', rn_pfac 328 352 WRITE(numout,*) ' factor applied on evaporation rn_efac = ', rn_efac 329 WRITE(numout,*) ' factor applied on ocean/ice velocity rn_vfac = ', rn_vfac330 353 WRITE(numout,*) ' (form absolute (=0) to relative winds(=1))' 331 354 WRITE(numout,*) ' use ice-atm drag from Lupkes2012 ln_Cd_L12 = ', ln_Cd_L12 332 355 WRITE(numout,*) ' use ice-atm drag from Lupkes2015 ln_Cd_L15 = ', ln_Cd_L15 356 WRITE(numout,*) ' use surface current feedback on wind stress ln_crt_fbk = ', ln_crt_fbk 357 IF(ln_crt_fbk) THEN 358 WRITE(numout,*) ' Renault et al. 2020, eq. 10: Stau = Alpha * Wnd + Beta' 359 WRITE(numout,*) ' Alpha rn_stau_a = ', rn_stau_a 360 WRITE(numout,*) ' Beta rn_stau_b = ', rn_stau_b 361 ENDIF 333 362 ! 334 363 WRITE(numout,*) … … 429 458 ! ! compute the surface ocean fluxes using bulk formulea 430 459 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 431 CALL blk_oce_1( kt, sf(jp_wndi)%fnow(:,:,1), sf(jp_wndj)%fnow(:,:,1), & ! <<= in 432 & sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), & ! <<= in 433 & sf(jp_slp )%fnow(:,:,1), sst_m, ssu_m, ssv_m, & ! <<= in 434 & sf(jp_qsr )%fnow(:,:,1), sf(jp_qlw )%fnow(:,:,1), & ! <<= in (wl/cs) 435 & tsk_m, zssq, zcd_du, zsen, zevp ) ! =>> out 436 437 CALL blk_oce_2( sf(jp_tair)%fnow(:,:,1), sf(jp_qsr )%fnow(:,:,1), & ! <<= in 438 & sf(jp_qlw )%fnow(:,:,1), sf(jp_prec)%fnow(:,:,1), & ! <<= in 439 & sf(jp_snow)%fnow(:,:,1), tsk_m, & ! <<= in 440 & zsen, zevp ) ! <=> in out 460 CALL blk_oce_1( kt, sf(jp_wndi )%fnow(:,:,1), sf(jp_wndj )%fnow(:,:,1), & ! <<= in 461 & sf(jp_tair )%fnow(:,:,1), sf(jp_humi )%fnow(:,:,1), & ! <<= in 462 & sf(jp_slp )%fnow(:,:,1), sst_m, ssu_m, ssv_m, & ! <<= in 463 & sf(jp_uoatm)%fnow(:,:,1), sf(jp_voatm)%fnow(:,:,1), & ! <<= in 464 & sf(jp_qsr )%fnow(:,:,1), sf(jp_qlw )%fnow(:,:,1), & ! <<= in (wl/cs) 465 & tsk_m, zssq, zcd_du, zsen, zevp ) ! =>> out 466 467 CALL blk_oce_2( sf(jp_tair )%fnow(:,:,1), sf(jp_qsr )%fnow(:,:,1), & ! <<= in 468 & sf(jp_qlw )%fnow(:,:,1), sf(jp_prec )%fnow(:,:,1), & ! <<= in 469 & sf(jp_snow )%fnow(:,:,1), tsk_m, & ! <<= in 470 & zsen, zevp ) ! <=> in out 441 471 ENDIF 442 472 ! … … 470 500 471 501 472 SUBROUTINE blk_oce_1( kt, pwndi, pwndj , ptair, phumi,& ! inp473 & pslp , pst , pu , pv,& ! inp474 & pqsr , pqlw ,& ! inp475 & ptsk, pssq , pcd_du, psen , pevp )! out502 SUBROUTINE blk_oce_1( kt, pwndi, pwndj, ptair, phumi, & ! inp 503 & pslp , pst , pu , pv, & ! inp 504 & puatm, pvatm, pqsr , pqlw , & ! inp 505 & ptsk , pssq , pcd_du, psen, pevp ) ! out 476 506 !!--------------------------------------------------------------------- 477 507 !! *** ROUTINE blk_oce_1 *** … … 498 528 REAL(wp), INTENT(in ), DIMENSION(:,:) :: pu ! surface current at U-point (i-component) [m/s] 499 529 REAL(wp), INTENT(in ), DIMENSION(:,:) :: pv ! surface current at V-point (j-component) [m/s] 530 REAL(wp), INTENT(in ), DIMENSION(:,:) :: puatm ! surface current seen by the atm at T-point (i-component) [m/s] 531 REAL(wp), INTENT(in ), DIMENSION(:,:) :: pvatm ! surface current seen by the atm at T-point (j-component) [m/s] 500 532 REAL(wp), INTENT(in ), DIMENSION(:,:) :: pqsr ! 501 533 REAL(wp), INTENT(in ), DIMENSION(:,:) :: pqlw ! … … 508 540 INTEGER :: ji, jj ! dummy loop indices 509 541 REAL(wp) :: zztmp ! local variable 542 REAL(wp) :: zstmax, zstau 543 #if defined key_cyclone 510 544 REAL(wp), DIMENSION(jpi,jpj) :: zwnd_i, zwnd_j ! wind speed components at T-point 545 #endif 546 REAL(wp), DIMENSION(jpi,jpj) :: ztau_i, ztau_j ! wind stress components at T-point 511 547 REAL(wp), DIMENSION(jpi,jpj) :: zU_zu ! bulk wind speed at height zu [m/s] 512 548 REAL(wp), DIMENSION(jpi,jpj) :: ztpot ! potential temperature of air at z=rn_zqt [K] … … 532 568 zwnd_j(:,:) = 0._wp 533 569 CALL wnd_cyc( kt, zwnd_i, zwnd_j ) ! add analytical tropical cyclone (Vincent et al. JGR 2012) 534 DO_2D_00_00 535 pwndi(ji,jj) = pwndi(ji,jj) + zwnd_i(ji,jj) 536 pwndj(ji,jj) = pwndj(ji,jj) + zwnd_j(ji,jj) 570 DO_2D_11_11 571 zwnd_i(ji,jj) = pwndi(ji,jj) + zwnd_i(ji,jj) 572 zwnd_j(ji,jj) = pwndj(ji,jj) + zwnd_j(ji,jj) 573 ! ... scalar wind at T-point (not masked) 574 wndm(ji,jj) = SQRT( zwnd_i(ji,jj) * zwnd_i(ji,jj) + zwnd_j(ji,jj) * zwnd_j(ji,jj) ) 575 END_2D 576 #else 577 ! ... scalar wind module at T-point (not masked) 578 DO_2D_11_11 579 wndm(ji,jj) = SQRT( pwndi(ji,jj) * pwndi(ji,jj) + pwndj(ji,jj) * pwndj(ji,jj) ) 537 580 END_2D 538 581 #endif 539 DO_2D_00_00540 zwnd_i(ji,jj) = ( pwndi(ji,jj) - rn_vfac * 0.5 * ( pu(ji-1,jj ) + pu(ji,jj) ) )541 zwnd_j(ji,jj) = ( pwndj(ji,jj) - rn_vfac * 0.5 * ( pv(ji ,jj-1) + pv(ji,jj) ) )542 END_2D543 CALL lbc_lnk_multi( 'sbcblk', zwnd_i, 'T', -1., zwnd_j, 'T', -1. )544 ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked)545 wndm(:,:) = SQRT( zwnd_i(:,:) * zwnd_i(:,:) &546 & + zwnd_j(:,:) * zwnd_j(:,:) ) * tmask(:,:,1)547 548 582 ! ----------------------------------------------------------------------------- ! 549 583 ! I Solar FLUX ! … … 593 627 !#LB: because AGRIF hates functions that return something else than a scalar, need to 594 628 ! use scalar version of gamma_moist() ... 595 DO_2D_11_11 596 ztpot(ji,jj) = ptair(ji,jj) + gamma_moist( ptair(ji,jj), zqair(ji,jj) ) * rn_zqt 597 END_2D 598 ENDIF 599 600 629 IF( ln_tpot ) THEN 630 DO_2D_11_11 631 ztpot(ji,jj) = ptair(ji,jj) + gamma_moist( ptair(ji,jj), zqair(ji,jj) ) * rn_zqt 632 END_2D 633 ELSE 634 ztpot = ptair(:,:) 635 ENDIF 636 ENDIF 601 637 602 638 !! Time to call the user-selected bulk parameterization for … … 674 710 pevp(:,:) = pevp(:,:) * tmask(:,:,1) 675 711 676 ! Tau i and j component on T-grid points, using array "zcd_oce" as a temporary array... 677 zcd_oce = 0._wp 678 WHERE ( wndm > 0._wp ) zcd_oce = taum / wndm 679 zwnd_i = zcd_oce * zwnd_i 680 zwnd_j = zcd_oce * zwnd_j 681 682 CALL iom_put( "taum_oce", taum ) ! output wind stress module 712 DO_2D_11_11 713 IF( wndm(ji,jj) > 0._wp ) THEN 714 zztmp = taum(ji,jj) / wndm(ji,jj) 715 #if defined key_cyclone 716 ztau_i(ji,jj) = zztmp * zwnd_i(ji,jj) 717 ztau_j(ji,jj) = zztmp * zwnd_j(ji,jj) 718 #else 719 ztau_i(ji,jj) = zztmp * pwndi(ji,jj) 720 ztau_j(ji,jj) = zztmp * pwndj(ji,jj) 721 #endif 722 ELSE 723 ztau_i(ji,jj) = 0._wp 724 ztau_j(ji,jj) = 0._wp 725 ENDIF 726 END_2D 727 728 IF( ln_crt_fbk ) THEN ! aply eq. 10 and 11 of Renault et al. 2020 (doi: 10.1029/2019MS001715) 729 zstmax = MIN( rn_stau_a * 3._wp + rn_stau_b, 0._wp ) ! set the max value of Stau corresponding to a wind of 3 m/s (<0) 730 DO_2D_01_01 ! end at jpj and jpi, as ztau_j(ji,jj+1) ztau_i(ji+1,jj) used in the next loop 731 zstau = MIN( rn_stau_a * wndm(ji,jj) + rn_stau_b, zstmax ) ! stau (<0) must be smaller than zstmax 732 ztau_i(ji,jj) = ztau_i(ji,jj) + zstau * ( 0.5_wp * ( pu(ji-1,jj ) + pu(ji,jj) ) - puatm(ji,jj) ) 733 ztau_j(ji,jj) = ztau_j(ji,jj) + zstau * ( 0.5_wp * ( pv(ji ,jj-1) + pv(ji,jj) ) - pvatm(ji,jj) ) 734 taum(ji,jj) = SQRT( ztau_i(ji,jj) * ztau_i(ji,jj) + ztau_j(ji,jj) * ztau_j(ji,jj) ) 735 END_2D 736 ENDIF 683 737 684 738 ! ... utau, vtau at U- and V_points, resp. 685 739 ! Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines 686 740 ! Note that coastal wind stress is not used in the code... so this extra care has no effect 687 DO_2D_00_00 688 utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( z wnd_i(ji,jj) + zwnd_i(ji+1,jj ) ) &689 & * MAX(tmask(ji,jj,1),tmask(ji+1,jj,1))690 vtau(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( z wnd_j(ji,jj) + zwnd_j(ji ,jj+1) ) &691 & * MAX(tmask(ji,jj,1),tmask(ji,jj+1,1))741 DO_2D_00_00 ! start loop at 2, in case ln_crt_fbk = T 742 utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( ztau_i(ji,jj) + ztau_i(ji+1,jj ) ) & 743 & * MAX(tmask(ji,jj,1),tmask(ji+1,jj,1)) 744 vtau(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( ztau_j(ji,jj) + ztau_j(ji ,jj+1) ) & 745 & * MAX(tmask(ji,jj,1),tmask(ji,jj+1,1)) 692 746 END_2D 693 CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1., vtau, 'V', -1. ) 747 748 IF( ln_crt_fbk ) THEN 749 CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1., vtau, 'V', -1., taum, 'T', -1. ) 750 ELSE 751 CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1., vtau, 'V', -1. ) 752 ENDIF 753 754 CALL iom_put( "taum_oce", taum ) ! output wind stress module 694 755 695 756 IF(sn_cfctl%l_prtctl) THEN … … 862 923 ! 863 924 INTEGER :: ji, jj ! dummy loop indices 864 REAL(wp) :: zwndi_t , zwndj_t ! relative wind components at T-point865 925 REAL(wp) :: zootm_su ! sea-ice surface mean temperature 866 926 REAL(wp) :: zztmp1, zztmp2 ! temporary arrays … … 873 933 ! ------------------------------------------------------------ ! 874 934 ! C-grid ice dynamics : U & V-points (same as ocean) 875 DO_2D_00_00 876 zwndi_t = ( pwndi(ji,jj) - rn_vfac * 0.5_wp * ( puice(ji-1,jj ) + puice(ji,jj) ) ) 877 zwndj_t = ( pwndj(ji,jj) - rn_vfac * 0.5_wp * ( pvice(ji ,jj-1) + pvice(ji,jj) ) ) 878 wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 935 DO_2D_11_11 936 wndm_ice(ji,jj) = SQRT( pwndi(ji,jj) * pwndi(ji,jj) + pwndj(ji,jj) * pwndj(ji,jj) ) 879 937 END_2D 880 CALL lbc_lnk( 'sbcblk', wndm_ice, 'T', 1. )881 938 ! 882 939 ! Make ice-atm. drag dependent on ice concentration … … 898 955 899 956 IF( ln_blk ) THEN 900 ! ---------------------------------------------------- ---------!901 ! Wind stress relative to the moving ice ( U10m - U_ice) !902 ! ---------------------------------------------------- ---------!903 zztmp1 = rn_vfac * 0.5_wp957 ! ---------------------------------------------------- ! 958 ! Wind stress relative to nonmoving ice ( U10m ) ! 959 ! ---------------------------------------------------- ! 960 ! supress moving ice in wind stress computation as we don't know how to do it properly... 904 961 DO_2D_01_01 ! at T point 905 putaui(ji,jj) = rhoa(ji,jj) * zcd_dui(ji,jj) * ( pwndi(ji,jj) - zztmp1 * ( puice(ji-1,jj ) + puice(ji,jj) ))906 pvtaui(ji,jj) = rhoa(ji,jj) * zcd_dui(ji,jj) * ( pwndj(ji,jj) - zztmp1 * ( pvice(ji ,jj-1) + pvice(ji,jj) ))962 putaui(ji,jj) = rhoa(ji,jj) * zcd_dui(ji,jj) * pwndi(ji,jj) 963 pvtaui(ji,jj) = rhoa(ji,jj) * zcd_dui(ji,jj) * pwndj(ji,jj) 907 964 END_2D 908 965 ! … … 914 971 pvtaui(ji,jj) = zztmp2 * ( pvtaui(ji,jj) + pvtaui(ji ,jj+1) ) 915 972 END_2D 916 CALL lbc_lnk_multi( 'sbcblk', putaui, 'U', -1. , pvtaui, 'V', -1.)973 CALL lbc_lnk_multi( 'sbcblk', putaui, 'U', -1._wp, pvtaui, 'V', -1._wp ) 917 974 ! 918 975 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=putaui , clinfo1=' blk_ice: putaui : ' & 919 976 & , tab2d_2=pvtaui , clinfo2=' pvtaui : ' ) 920 ELSE 977 ELSE ! ln_abl 921 978 zztmp1 = 11637800.0_wp 922 979 zztmp2 = -5897.8_wp … … 1382 1439 ! 1383 1440 END_2D 1384 CALL lbc_lnk_multi( 'sbcblk', pcd, 'T', 1. , pch, 'T', 1.)1441 CALL lbc_lnk_multi( 'sbcblk', pcd, 'T', 1.0_wp, pch, 'T', 1.0_wp ) 1385 1442 ! 1386 1443 END SUBROUTINE Cdn10_Lupkes2015 -
NEMO/branches/2020/dev_r12973_AGRIF_CMEMS/src/OCE/SBC/sbcblk_phy.F90
r12895 r13258 640 640 !! *** FUNCTION alpha_sw_vctr *** 641 641 !! 642 !! ** Purpose : ROUGH estimate of the thermal expansion coefficient of sea-water at the surface ( P =~ 1010 hpa)642 !! ** Purpose : ROUGH estimate of the thermal expansion coefficient of sea-water at the surface (i.e. P =~ 101000 Pa) 643 643 !! 644 644 !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) … … 654 654 !! *** FUNCTION alpha_sw_sclr *** 655 655 !! 656 !! ** Purpose : ROUGH estimate of the thermal expansion coefficient of sea-water at the surface ( P =~ 1010 hpa)656 !! ** Purpose : ROUGH estimate of the thermal expansion coefficient of sea-water at the surface (i.e. P =~ 101000 Pa) 657 657 !! 658 658 !! ** Author: L. Brodeau, june 2016 / AeroBulk (https://github.com/brodeau/aerobulk/) -
NEMO/branches/2020/dev_r12973_AGRIF_CMEMS/src/OCE/SBC/sbccpl.F90
r13103 r13258 199 199 !! Substitution 200 200 # include "do_loop_substitute.h90" 201 # include "domzgr_substitute.h90" 201 202 !!---------------------------------------------------------------------- 202 203 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 1173 1174 frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) ) 1174 1175 END_2D 1175 CALL lbc_lnk_multi( 'sbccpl', frcv(jpr_otx1)%z3(:,:,1), 'U', -1. , frcv(jpr_oty1)%z3(:,:,1), 'V', -1.)1176 CALL lbc_lnk_multi( 'sbccpl', frcv(jpr_otx1)%z3(:,:,1), 'U', -1.0_wp, frcv(jpr_oty1)%z3(:,:,1), 'V', -1.0_wp ) 1176 1177 ENDIF 1177 1178 llnewtx = .TRUE. … … 1198 1199 frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy ) 1199 1200 END_2D 1200 CALL lbc_lnk( 'sbccpl', frcv(jpr_taum)%z3(:,:,1), 'T', 1. )1201 CALL lbc_lnk( 'sbccpl', frcv(jpr_taum)%z3(:,:,1), 'T', 1.0_wp ) 1201 1202 llnewtau = .TRUE. 1202 1203 ELSE … … 2375 2376 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2376 2377 END_2D 2377 CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1. , zity1, 'T', -1.)2378 CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp ) 2378 2379 CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T 2379 2380 DO_2D_00_00 … … 2384 2385 END_2D 2385 2386 END SELECT 2386 CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1. , zoty1, ssnd(jps_ocy1)%clgrid, -1.)2387 CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocy1)%clgrid, -1.0_wp ) 2387 2388 ! 2388 2389 ENDIF … … 2452 2453 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2453 2454 END_2D 2454 CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1. , zity1, 'T', -1.)2455 CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp ) 2455 2456 CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T 2456 2457 DO_2D_00_00 … … 2461 2462 END_2D 2462 2463 END SELECT 2463 CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1. , zoty1, ssnd(jps_ocyw)%clgrid, -1.)2464 CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocyw)%clgrid, -1.0_wp ) 2464 2465 ! 2465 2466 ! -
NEMO/branches/2020/dev_r12973_AGRIF_CMEMS/src/OCE/SBC/sbcflx.F90
r12377 r13258 151 151 END_2D 152 152 taum(:,:) = taum(:,:) * tmask(:,:,1) ; wndm(:,:) = wndm(:,:) * tmask(:,:,1) 153 CALL lbc_lnk( 'sbcflx', taum(:,:), 'T', 1. ) ; CALL lbc_lnk( 'sbcflx', wndm(:,:), 'T', 1.)153 CALL lbc_lnk( 'sbcflx', taum(:,:), 'T', 1.0_wp ) ; CALL lbc_lnk( 'sbcflx', wndm(:,:), 'T', 1.0_wp ) 154 154 155 155 IF( nitend-nit000 <= 100 .AND. lwp ) THEN ! control print (if less than 100 time-step asked) -
NEMO/branches/2020/dev_r12973_AGRIF_CMEMS/src/OCE/SBC/sbcfwb.F90
r12489 r13258 71 71 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztmsk_tospread, zerp_cor ! - - 72 72 REAL(wp) ,DIMENSION(1) :: z_fwfprv 73 COMPLEX( wp),DIMENSION(1) :: y_fwfnow73 COMPLEX(dp),DIMENSION(1) :: y_fwfnow 74 74 !!---------------------------------------------------------------------- 75 75 ! … … 180 180 ! 181 181 !!gm ===>>>> lbc_lnk should be useless as all the computation is done over the whole domain ! 182 CALL lbc_lnk( 'sbcfwb', zerp_cor, 'T', 1. )182 CALL lbc_lnk( 'sbcfwb', zerp_cor, 'T', 1.0_wp ) 183 183 ! 184 184 emp(:,:) = emp(:,:) + zerp_cor(:,:) -
NEMO/branches/2020/dev_r12973_AGRIF_CMEMS/src/OCE/SBC/sbcice_cice.F90
r12489 r13258 12 12 USE oce ! ocean dynamics and tracers 13 13 USE dom_oce ! ocean space and time domain 14 # if ! defined key_qco 14 15 USE domvvl 16 # else 17 USE domqco 18 # endif 15 19 USE phycst, only : rcp, rho0, r1_rho0, rhos, rhoi 16 20 USE in_out_manager ! I/O manager … … 218 222 END_2D 219 223 220 CALL lbc_lnk_multi( 'sbcice_cice', fr_iu , 'U', 1. , fr_iv , 'V', 1.)224 CALL lbc_lnk_multi( 'sbcice_cice', fr_iu , 'U', 1.0_wp, fr_iv , 'V', 1.0_wp ) 221 225 222 226 ! set the snow+ice mass … … 233 237 !!gm This should be put elsewhere.... (same remark for limsbc) 234 238 !!gm especially here it is assumed zstar coordinate, but it can be ztilde.... 239 #if defined key_qco 240 IF( .NOT.ln_linssh ) CALL dom_qco_zgr( Kbb, Kmm, Kaa ) ! interpolation scale factor, depth and water column 241 #else 235 242 IF( .NOT.ln_linssh ) THEN 236 243 ! 237 244 DO jk = 1,jpkm1 ! adjust initial vertical scale factors 238 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk)*( 1._wp + ssh(:,:,Kmm)* tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )239 e3t(:,:,jk,Kbb) = e3t_0(:,:,jk)*( 1._wp + ssh(:,:,Kbb)* tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )245 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk)*( 1._wp + ssh(:,:,Kmm)*r1_ht_0(:,:)*tmask(:,:,jk) ) 246 e3t(:,:,jk,Kbb) = e3t_0(:,:,jk)*( 1._wp + ssh(:,:,Kbb)*r1_ht_0(:,:)*tmask(:,:,jk) ) 240 247 ENDDO 241 248 e3t(:,:,:,Krhs) = e3t(:,:,:,Kbb) … … 267 274 END DO 268 275 ENDIF 276 #endif 269 277 ENDIF 270 278 ENDIF … … 498 506 ss_iou(ji,jj) = 0.5 * ( ztmp1(ji,jj-1) + ztmp1(ji,jj) ) * umask(ji,jj,1) 499 507 END_2D 500 CALL lbc_lnk( 'sbcice_cice', ss_iou , 'U', -1. )508 CALL lbc_lnk( 'sbcice_cice', ss_iou , 'U', -1.0_wp ) 501 509 502 510 ! y comp of ocean-ice stress … … 508 516 ss_iov(ji,jj) = 0.5 * ( ztmp1(ji-1,jj) + ztmp1(ji,jj) ) * vmask(ji,jj,1) 509 517 END_2D 510 CALL lbc_lnk( 'sbcice_cice', ss_iov , 'V', -1. )518 CALL lbc_lnk( 'sbcice_cice', ss_iov , 'V', -1.0_wp ) 511 519 512 520 ! x and y comps of surface stress … … 561 569 fmmflx(:,:) = ztmp1(:,:) !!Joakim edit 562 570 563 CALL lbc_lnk_multi( 'sbcice_cice', emp , 'T', 1. , sfx , 'T', 1.)571 CALL lbc_lnk_multi( 'sbcice_cice', emp , 'T', 1.0_wp, sfx , 'T', 1.0_wp ) 564 572 565 573 ! Solar penetrative radiation and non solar surface heat flux … … 587 595 #endif 588 596 qsr(:,:)=qsr(:,:)+ztmp1(:,:) 589 CALL lbc_lnk( 'sbcice_cice', qsr , 'T', 1. )597 CALL lbc_lnk( 'sbcice_cice', qsr , 'T', 1.0_wp ) 590 598 591 599 DO_2D_11_11 … … 600 608 qns(:,:)=qns(:,:)+nfrzmlt(:,:)+ztmp1(:,:) 601 609 602 CALL lbc_lnk( 'sbcice_cice', qns , 'T', 1. )610 CALL lbc_lnk( 'sbcice_cice', qns , 'T', 1.0_wp ) 603 611 604 612 ! Prepare for the following CICE time-step … … 618 626 END_2D 619 627 620 CALL lbc_lnk_multi( 'sbcice_cice', fr_iu , 'U', 1. , fr_iv , 'V', 1.)628 CALL lbc_lnk_multi( 'sbcice_cice', fr_iu , 'U', 1.0_wp, fr_iv , 'V', 1.0_wp ) 621 629 622 630 ! set the snow+ice mass -
NEMO/branches/2020/dev_r12973_AGRIF_CMEMS/src/OCE/SBC/sbcmod.F90
r13058 r13258 461 461 ! A lbc_lnk is therefore needed to ensure reproducibility and restartability. 462 462 ! see ticket #2113 for discussion about this lbc_lnk. 463 IF( .NOT. ln_passive_mode ) CALL lbc_lnk( 'sbcmod', emp, 'T', 1. ) ! ensure restartability with icebergs463 IF( .NOT. ln_passive_mode ) CALL lbc_lnk( 'sbcmod', emp, 'T', 1.0_wp ) ! ensure restartability with icebergs 464 464 ENDIF 465 465 … … 476 476 !!$!RBbug do not understand why see ticket 667 477 477 !!$!clem: it looks like it is necessary for the north fold (in certain circumstances). Don't know why. 478 !!$ CALL lbc_lnk( 'sbcmod', emp, 'T', 1. )478 !!$ CALL lbc_lnk( 'sbcmod', emp, 'T', 1.0_wp ) 479 479 IF( ll_wd ) THEN ! If near WAD point limit the flux for now 480 480 zthscl = atanh(rn_wd_sbcfra) ! taper frac default is .999 -
NEMO/branches/2020/dev_r12973_AGRIF_CMEMS/src/OCE/SBC/sbcrnf.F90
r12489 r13258 72 72 !! * Substitutions 73 73 # include "do_loop_substitute.h90" 74 # include "domzgr_substitute.h90" 74 75 !!---------------------------------------------------------------------- 75 76 !! NEMO/OCE 4.0 , NEMO Consortium (2018) -
NEMO/branches/2020/dev_r12973_AGRIF_CMEMS/src/OCE/SBC/sbcssm.F90
r12377 r13258 32 32 LOGICAL, SAVE :: l_ssm_mean = .FALSE. ! keep track of whether means have been read from restart file 33 33 34 # include "domzgr_substitute.h90" 34 35 !!---------------------------------------------------------------------- 35 36 !! NEMO/OCE 4.0 , NEMO Consortium (2018) -
NEMO/branches/2020/dev_r12973_AGRIF_CMEMS/src/OCE/SBC/sbcssr.F90
r12377 r13258 131 131 & * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) & 132 132 & / MAX( sss_m(ji,jj), 1.e-20 ) * tmask(ji,jj,1) 133 IF( ln_sssr_bnd ) zerp = SIGN( 1. , zerp ) * MIN( zerp_bnd, ABS(zerp) )133 IF( ln_sssr_bnd ) zerp = SIGN( 1.0_wp, zerp ) * MIN( zerp_bnd, ABS(zerp) ) 134 134 emp(ji,jj) = emp (ji,jj) + zerp 135 135 qns(ji,jj) = qns(ji,jj) - zerp * rcp * sst_m(ji,jj) -
NEMO/branches/2020/dev_r12973_AGRIF_CMEMS/src/OCE/SBC/sbcwave.F90
r12965 r13258 73 73 !! * Substitutions 74 74 # include "do_loop_substitute.h90" 75 # include "domzgr_substitute.h90" 75 76 !!---------------------------------------------------------------------- 76 77 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 198 199 ENDIF 199 200 200 CALL lbc_lnk_multi( 'sbcwave', usd, 'U', -1. , vsd, 'V', -1.)201 CALL lbc_lnk_multi( 'sbcwave', usd, 'U', -1.0_wp, vsd, 'V', -1.0_wp ) 201 202 202 203 ! … … 207 208 & - e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * usd(ji-1,jj,jk) & 208 209 & + e1v(ji,jj ) * e3v(ji,jj ,jk,Kmm) * vsd(ji,jj ,jk) & 209 & - e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) * vsd(ji,jj-1,jk) ) * r1_e1e2t(ji,jj) 210 & - e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) * vsd(ji,jj-1,jk) ) & 211 & * r1_e1e2t(ji,jj) 210 212 END_3D 211 213 ! 212 CALL lbc_lnk( 'sbcwave', ze3divh, 'T', 1. )214 CALL lbc_lnk( 'sbcwave', ze3divh, 'T', 1.0_wp ) 213 215 ! 214 216 IF( ln_linssh ) THEN ; ik = 1 ! none zero velocity through the sea surface … … 269 271 taum(ji,jj) = SQRT( tauw_x(ji,jj)*tauw_x(ji,jj) + tauw_y(ji,jj)*tauw_y(ji,jj) ) 270 272 END_2D 271 CALL lbc_lnk_multi( 'sbcwave', utau(:,:), 'U', -1. , vtau(:,:), 'V', -1. , taum(:,:) , 'T', -1.)273 CALL lbc_lnk_multi( 'sbcwave', utau(:,:), 'U', -1.0_wp , vtau(:,:), 'V', -1.0_wp , taum(:,:) , 'T', -1.0_wp ) 272 274 ENDIF 273 275 !
Note: See TracChangeset
for help on using the changeset viewer.
