- Timestamp:
- 2020-09-14T17:40:34+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/ICE/icesbc.F90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@13382 sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/ICE/icesbc.F90
r10535 r13463 27 27 USE lbclnk ! lateral boundary conditions (or mpp links) 28 28 USE timing ! Timing 29 USE fldread !!GS: needed by agrif 29 30 30 31 IMPLICIT NONE … … 36 37 37 38 !! * Substitutions 38 # include " vectopt_loop_substitute.h90"39 # include "do_loop_substitute.h90" 39 40 !!---------------------------------------------------------------------- 40 41 !! NEMO/ICE 4.0 , NEMO Consortium (2018) … … 71 72 SELECT CASE( ksbc ) 72 73 CASE( jp_usr ) ; CALL usrdef_sbc_ice_tau( kt ) ! user defined formulation 73 CASE( jp_blk ) ; CALL blk_ice_tau ! Bulk formulation 74 CASE( jp_blk ) ; CALL blk_ice_1( sf(jp_wndi)%fnow(:,:,1), sf(jp_wndj)%fnow(:,:,1), & 75 & sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), & 76 & sf(jp_slp )%fnow(:,:,1), u_ice, v_ice, tm_su , & ! inputs 77 & putaui = utau_ice, pvtaui = vtau_ice ) ! outputs 78 ! CASE( jp_abl ) utau_ice & vtau_ice are computed in ablmod 74 79 CASE( jp_purecpl ) ; CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) ! Coupled formulation 75 80 END SELECT … … 77 82 IF( ln_mixcpl) THEN ! Case of a mixed Bulk/Coupled formulation 78 83 CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 79 DO jj = 2, jpjm1 80 DO ji = 2, jpim1 81 utau_ice(ji,jj) = utau_ice(ji,jj) * xcplmask(ji,jj,0) + zutau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 82 vtau_ice(ji,jj) = vtau_ice(ji,jj) * xcplmask(ji,jj,0) + zvtau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 83 END DO 84 END DO 85 CALL lbc_lnk_multi( 'icesbc', utau_ice, 'U', -1., vtau_ice, 'V', -1. ) 84 DO_2D( 0, 0, 0, 0 ) 85 utau_ice(ji,jj) = utau_ice(ji,jj) * xcplmask(ji,jj,0) + zutau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 86 vtau_ice(ji,jj) = vtau_ice(ji,jj) * xcplmask(ji,jj,0) + zvtau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 87 END_2D 88 CALL lbc_lnk_multi( 'icesbc', utau_ice, 'U', -1.0_wp, vtau_ice, 'V', -1.0_wp ) 86 89 ENDIF 87 90 ! … … 114 117 INTEGER, INTENT(in) :: ksbc ! flux formulation (user defined, bulk or Pure Coupled) 115 118 ! 116 INTEGER :: ji, jj, jl ! dummy loop index 117 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zalb_os, zalb_cs ! ice albedo under overcast/clear sky 118 REAL(wp), DIMENSION(jpi,jpj) :: zalb ! 2D workspace 119 INTEGER :: ji, jj, jl ! dummy loop index 120 REAL(wp) :: zmiss_val ! missing value retrieved from xios 121 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zalb_os, zalb_cs ! ice albedo under overcast/clear sky 122 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: zalb, zmsk00 ! 2D workspace 119 123 !!-------------------------------------------------------------------- 120 124 ! … … 127 131 ENDIF 128 132 133 ! get missing value from xml 134 CALL iom_miss_val( "icetemp", zmiss_val ) 135 129 136 ! --- cloud-sky and overcast-sky ice albedos --- ! 130 137 CALL ice_alb( t_su, h_i, h_s, ln_pnd_alb, a_ip_frac, h_ip, zalb_cs, zalb_os ) … … 139 146 CASE( jp_usr ) !--- user defined formulation 140 147 CALL usrdef_sbc_ice_flx( kt, h_s, h_i ) 141 CASE( jp_blk ) !--- bulk formulation 142 CALL blk_ice_flx ( t_su, h_s, h_i, alb_ice ) ! 148 CASE( jp_blk, jp_abl ) !--- bulk formulation & ABL formulation 149 CALL blk_ice_2 ( t_su, h_s, h_i, alb_ice, sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), & 150 & sf(jp_slp)%fnow(:,:,1), sf(jp_qlw)%fnow(:,:,1), sf(jp_prec)%fnow(:,:,1), sf(jp_snow)%fnow(:,:,1) ) ! 143 151 IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su, phs=h_s, phi=h_i ) 144 152 IF( nn_flxdist /= -1 ) CALL ice_flx_dist ( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_flxdist ) … … 152 160 153 161 !--- output ice albedo and surface albedo ---! 154 IF( iom_use('icealb') ) THEN 155 WHERE( at_i_b <= epsi06 ) ; zalb(:,:) = rn_alb_oce 156 ELSEWHERE ; zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b 162 IF( iom_use('icealb') .OR. iom_use('albedo') ) THEN 163 164 ALLOCATE( zalb(jpi,jpj), zmsk00(jpi,jpj) ) 165 166 WHERE( at_i_b < 1.e-03 ) 167 zmsk00(:,:) = 0._wp 168 zalb (:,:) = rn_alb_oce 169 ELSEWHERE 170 zmsk00(:,:) = 1._wp 171 zalb (:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b 157 172 END WHERE 158 CALL iom_put( "icealb" , zalb(:,:) )159 ENDIF160 IF( iom_use('albedo') ) THEN173 ! ice albedo 174 CALL iom_put( 'icealb' , zalb * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) 175 ! ice+ocean albedo 161 176 zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + rn_alb_oce * ( 1._wp - at_i_b ) 162 CALL iom_put( "albedo" , zalb(:,:) ) 177 CALL iom_put( 'albedo' , zalb ) 178 179 DEALLOCATE( zalb, zmsk00 ) 180 163 181 ENDIF 164 182 ! … … 270 288 !!------------------------------------------------------------------- 271 289 ! 272 REWIND( numnam_ice_ref ) ! Namelist namsbc in reference namelist : Ice dynamics273 290 READ ( numnam_ice_ref, namsbc, IOSTAT = ios, ERR = 901) 274 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc in reference namelist', lwp ) 275 REWIND( numnam_ice_cfg ) ! Namelist namsbc in configuration namelist : Ice dynamics 291 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc in reference namelist' ) 276 292 READ ( numnam_ice_cfg, namsbc, IOSTAT = ios, ERR = 902 ) 277 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc in configuration namelist' , lwp)293 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc in configuration namelist' ) 278 294 IF(lwm) WRITE( numoni, namsbc ) 279 295 !
Note: See TracChangeset
for help on using the changeset viewer.
