Changeset 11989 for NEMO/trunk/src/OCE/SBC
- Timestamp:
- 2019-11-27T16:13:52+01:00 (4 years ago)
- Location:
- NEMO/trunk/src/OCE/SBC
- Files:
-
- 5 edited
-
sbcblk.F90 (modified) (2 diffs)
-
sbccpl.F90 (modified) (3 diffs)
-
sbcmod.F90 (modified) (2 diffs)
-
sbcrnf.F90 (modified) (7 diffs)
-
sbcssr.F90 (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/SBC/sbcblk.F90
r11536 r11989 801 801 REAL(wp), DIMENSION(jpi,jpj) :: zevap, zsnw ! evaporation and snw distribution after wind blowing (SI3) 802 802 REAL(wp), DIMENSION(jpi,jpj) :: zrhoa 803 REAL(wp), DIMENSION(jpi,jpj) :: ztmp, ztmp2 803 804 !!--------------------------------------------------------------------- 804 805 ! … … 913 914 qtr_ice_top(:,:,:) = 0._wp 914 915 END WHERE 916 ! 917 918 IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') ) THEN 919 ztmp(:,:) = zevap(:,:) * ( 1._wp - at_i_b(:,:) ) 920 IF( iom_use('evap_ao_cea' ) ) CALL iom_put( 'evap_ao_cea' , ztmp(:,:) * tmask(:,:,1) ) ! ice-free oce evap (cell average) 921 IF( iom_use('hflx_evap_cea') ) CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * sst_m(:,:) * rcp * tmask(:,:,1) ) ! heat flux from evap (cell average) 922 ENDIF 923 IF( iom_use('hflx_rain_cea') ) THEN 924 ztmp(:,:) = rcp * ( SUM( (ptsu-rt0) * a_i_b, dim=3 ) + sst_m(:,:) * ( 1._wp - at_i_b(:,:) ) ) 925 IF( iom_use('hflx_rain_cea') ) CALL iom_put( 'hflx_rain_cea', ( tprecip(:,:) - sprecip(:,:) ) * ztmp(:,:) ) ! heat flux from rain (cell average) 926 ENDIF 927 IF( iom_use('hflx_snow_cea') .OR. iom_use('hflx_snow_ao_cea') .OR. iom_use('hflx_snow_ai_cea') ) THEN 928 WHERE( SUM( a_i_b, dim=3 ) > 1.e-10 ) ; ztmp(:,:) = rcpi * SUM( (ptsu-rt0) * a_i_b, dim=3 ) / SUM( a_i_b, dim=3 ) 929 ELSEWHERE ; ztmp(:,:) = rcp * sst_m(:,:) 930 ENDWHERE 931 ztmp2(:,:) = sprecip(:,:) * ( ztmp(:,:) - rLfus ) 932 IF( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea' , ztmp2(:,:) ) ! heat flux from snow (cell average) 933 IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', ztmp2(:,:) * ( 1._wp - zsnw(:,:) ) ) ! heat flux from snow (over ocean) 934 IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', ztmp2(:,:) * zsnw(:,:) ) ! heat flux from snow (over ice) 935 ENDIF 915 936 ! 916 937 IF(ln_ctl) THEN -
NEMO/trunk/src/OCE/SBC/sbccpl.F90
r11536 r11989 1774 1774 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average) 1775 1775 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average) 1776 IF( iom_use('rain_ao_cea') ) CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * picefr(:,:) ) ! liquid precipitation over ocean (cell average) 1776 1777 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * tmask(:,:,1) ) ! Sublimation over sea-ice (cell average) 1777 1778 IF( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) & … … 1897 1898 #endif 1898 1899 ! outputs 1899 IF 1900 IF 1901 IF 1902 IF 1900 IF( srcv(jpr_cal)%laction ) CALL iom_put('hflx_cal_cea' , - frcv(jpr_cal)%z3(:,:,1) * rLfus ) ! latent heat from calving 1901 IF( srcv(jpr_icb)%laction ) CALL iom_put('hflx_icb_cea' , - frcv(jpr_icb)%z3(:,:,1) * rLfus ) ! latent heat from icebergs melting 1902 IF( iom_use('hflx_rain_cea') ) CALL iom_put('hflx_rain_cea' , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) ! heat flux from rain (cell average) 1903 IF( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea' , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) & 1903 1904 & * picefr(:,:) ) * zcptn(:,:) * tmask(:,:,1) ) ! heat flux from evap (cell average) 1904 IF ( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea' , sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) ) ! heat flux from snow (cell average) 1905 IF ( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 1905 IF( iom_use('hflx_prec_cea') ) CALL iom_put('hflx_prec_cea' , sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) + & ! heat flux from all precip (cell avg) 1906 & ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) 1907 IF( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea' , sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) ) ! heat flux from snow (cell average) 1908 IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 1906 1909 & * ( 1._wp - zsnw(:,:) ) ) ! heat flux from snow (over ocean) 1907 IF 1910 IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 1908 1911 & * zsnw(:,:) ) ! heat flux from snow (over ice) 1909 1912 ! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp. … … 2301 2304 ! ! CO2 flux from PISCES ! 2302 2305 ! ! ------------------------- ! 2303 IF( ssnd(jps_co2)%laction .AND. l_co2cpl ) CALL cpl_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info ) 2306 IF( ssnd(jps_co2)%laction .AND. l_co2cpl ) THEN 2307 ztmp1(:,:) = oce_co2(:,:) * 1000. ! conversion in molC/m2/s 2308 CALL cpl_snd( jps_co2, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ) , info ) 2309 ENDIF 2304 2310 ! 2305 2311 ! ! ------------------------- ! -
NEMO/trunk/src/OCE/SBC/sbcmod.F90
r11536 r11989 244 244 fwfisf_b(:,:) = 0._wp ; risf_tsc_b(:,:,:) = 0._wp 245 245 END IF 246 ! 247 IF( sbc_ssr_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_ssr arrays' ) 248 IF( .NOT.ln_ssr ) THEN !* Initialize qrp and erp if no restoring 249 qrp(:,:) = 0._wp 250 erp(:,:) = 0._wp 251 ENDIF 252 ! 253 246 254 IF( nn_ice == 0 ) THEN !* No sea-ice in the domain : ice fraction is always zero 247 255 IF( nn_components /= jp_iam_opa ) fr_i(:,:) = 0._wp ! except for OPA in SAS-OPA coupled case … … 552 560 CALL iom_put( "taum" , taum ) ! wind stress module 553 561 CALL iom_put( "wspd" , wndm ) ! wind speed module over free ocean or leads in presence of sea-ice 562 CALL iom_put( "qrp", qrp ) ! heat flux damping 563 CALL iom_put( "erp", erp ) ! freshwater flux damping 554 564 ENDIF 555 565 ! -
NEMO/trunk/src/OCE/SBC/sbcrnf.F90
r11536 r11989 43 43 REAL(wp) :: rn_dep_max !: depth over which runoffs is spread (ln_rnf_depth_ini =T) 44 44 INTEGER :: nn_rnf_depth_file !: create (=1) a runoff depth file or not (=0) 45 LOGICAL :: ln_rnf_icb !: iceberg flux is specified in a file 45 46 LOGICAL :: ln_rnf_tem !: temperature river runoffs attribute specified in a file 46 47 LOGICAL , PUBLIC :: ln_rnf_sal !: salinity river runoffs attribute specified in a file 47 48 TYPE(FLD_N) , PUBLIC :: sn_rnf !: information about the runoff file to be read 48 49 TYPE(FLD_N) :: sn_cnf !: information about the runoff mouth file to be read 50 TYPE(FLD_N) :: sn_i_rnf !: information about the iceberg flux file to be read 49 51 TYPE(FLD_N) :: sn_s_rnf !: information about the salinities of runoff file to be read 50 52 TYPE(FLD_N) :: sn_t_rnf !: information about the temperatures of runoff file to be read … … 65 67 66 68 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_rnf ! structure: river runoff (file information, fields read) 69 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_i_rnf ! structure: iceberg flux (file information, fields read) 67 70 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_s_rnf ! structure: river runoff salinity (file information, fields read) 68 71 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_t_rnf ! structure: river runoff temperature (file information, fields read) … … 112 115 ! !-------------------! 113 116 ! 114 IF( .NOT. l_rnfcpl ) CALL fld_read ( kt, nn_fsbc, sf_rnf ) ! Read Runoffs data and provide it at kt 117 ! 118 IF( .NOT. l_rnfcpl ) THEN 119 CALL fld_read ( kt, nn_fsbc, sf_rnf ) ! Read Runoffs data and provide it at kt ( runoffs + iceberg ) 120 IF( ln_rnf_icb ) CALL fld_read ( kt, nn_fsbc, sf_i_rnf ) ! idem for iceberg flux if required 121 ENDIF 115 122 IF( ln_rnf_tem ) CALL fld_read ( kt, nn_fsbc, sf_t_rnf ) ! idem for runoffs temperature if required 116 123 IF( ln_rnf_sal ) CALL fld_read ( kt, nn_fsbc, sf_s_rnf ) ! idem for runoffs salinity if required … … 118 125 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 119 126 ! 120 IF( .NOT. l_rnfcpl ) rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) ) * tmask(:,:,1) ! updated runoff value at time step kt 127 IF( .NOT. l_rnfcpl ) THEN 128 rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) ) * tmask(:,:,1) ! updated runoff value at time step kt 129 IF( ln_rnf_icb ) THEN 130 fwficb(:,:) = rn_rfact * ( sf_i_rnf(1)%fnow(:,:,1) ) * tmask(:,:,1) ! updated runoff value at time step kt 131 CALL iom_put( 'iceberg_cea' , fwficb(:,:) ) ! output iceberg flux 132 CALL iom_put( 'hflx_icb_cea' , fwficb(:,:) * rLfus ) ! output Heat Flux into Sea Water due to Iceberg Thermodynamics --> 133 ENDIF 134 ENDIF 121 135 ! 122 136 ! ! set temperature & salinity content of runoffs … … 132 146 ELSE ! use SST as runoffs temperature 133 147 !CEOD River is fresh water so must at least be 0 unless we consider ice 134 rnf_tsc(:,:,jp_tem) = MAX( sst_m(:,:),0.0_wp) * rnf(:,:) * r1_rau0148 rnf_tsc(:,:,jp_tem) = MAX( sst_m(:,:), 0.0_wp ) * rnf(:,:) * r1_rau0 135 149 ENDIF 136 150 ! ! use runoffs salinity data 137 151 IF( ln_rnf_sal ) rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 138 152 ! ! else use S=0 for runoffs (done one for all in the init) 139 IF( iom_use('runoffs') )CALL iom_put( 'runoffs' , rnf(:,:) ) ! output runoff mass flux153 CALL iom_put( 'runoffs' , rnf(:,:) ) ! output runoff mass flux 140 154 IF( iom_use('hflx_rnf_cea') ) CALL iom_put( 'hflx_rnf_cea', rnf_tsc(:,:,jp_tem) * rau0 * rcp ) ! output runoff sensible heat (W/m2) 141 155 ENDIF … … 242 256 REAL(wp), DIMENSION(jpi,jpj,2) :: zrnfcl 243 257 !! 244 NAMELIST/namsbc_rnf/ cn_dir , ln_rnf_depth, ln_rnf_tem, ln_rnf_sal, &245 & sn_rnf, sn_cnf , sn_ s_rnf , sn_t_rnf , sn_dep_rnf, &258 NAMELIST/namsbc_rnf/ cn_dir , ln_rnf_depth, ln_rnf_tem, ln_rnf_sal, ln_rnf_icb, & 259 & sn_rnf, sn_cnf , sn_i_rnf, sn_s_rnf , sn_t_rnf , sn_dep_rnf, & 246 260 & ln_rnf_mouth , rn_hrnf , rn_avt_rnf, rn_rfact, & 247 261 & ln_rnf_depth_ini , rn_dep_max , rn_rnf_max, nn_rnf_depth_file … … 299 313 IF( sn_rnf%ln_tint ) ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) ) 300 314 CALL fld_fill( sf_rnf, (/ sn_rnf /), cn_dir, 'sbc_rnf_init', 'read runoffs data', 'namsbc_rnf', no_print ) 315 ! 316 IF( ln_rnf_icb ) THEN ! Create (if required) sf_i_rnf structure 317 IF(lwp) WRITE(numout,*) 318 IF(lwp) WRITE(numout,*) ' iceberg flux read in a file' 319 ALLOCATE( sf_i_rnf(1), STAT=ierror ) 320 IF( ierror > 0 ) THEN 321 CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_i_rnf structure' ) ; RETURN 322 ENDIF 323 ALLOCATE( sf_i_rnf(1)%fnow(jpi,jpj,1) ) 324 IF( sn_i_rnf%ln_tint ) ALLOCATE( sf_i_rnf(1)%fdta(jpi,jpj,1,2) ) 325 CALL fld_fill (sf_i_rnf, (/ sn_i_rnf /), cn_dir, 'sbc_rnf_init', 'read iceberg flux data', 'namsbc_rnf' ) 326 ELSE 327 fwficb(:,:) = 0._wp 328 ENDIF 329 301 330 ENDIF 302 331 ! -
NEMO/trunk/src/OCE/SBC/sbcssr.F90
r11536 r11989 30 30 PUBLIC sbc_ssr ! routine called in sbcmod 31 31 PUBLIC sbc_ssr_init ! routine called in sbcmod 32 PUBLIC sbc_ssr_alloc ! routine called in sbcmod 32 33 33 34 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: erp !: evaporation damping [kg/m2/s] 34 35 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qrp !: heat flux damping [w/m2] 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: coefice !: under ice relaxation coefficient 35 37 36 38 ! !!* Namelist namsbc_ssr * … … 41 43 LOGICAL :: ln_sssr_bnd ! flag to bound erp term 42 44 REAL(wp) :: rn_sssr_bnd ! ABS(Max./Min.) value of erp term [mm/day] 45 INTEGER :: nn_icedmp ! Control of restoring under ice 43 46 44 47 REAL(wp) , ALLOCATABLE, DIMENSION(:) :: buffer ! Temporary buffer for exchange … … 97 100 END DO 98 101 END DO 99 CALL iom_put( "qrp", qrp ) ! heat flux damping 102 ENDIF 103 ! 104 IF( nn_sssr /= 0 .AND. nn_icedmp /= 1 ) THEN 105 ! use fraction of ice ( fr_i ) to adjust relaxation under ice if nn_icedmp .ne. 1 106 ! n.b. coefice is initialised and fixed to 1._wp if nn_icedmp = 1 107 DO jj = 1, jpj 108 DO ji = 1, jpi 109 SELECT CASE ( nn_icedmp ) 110 CASE ( 0 ) ; coefice(ji,jj) = 1._wp - fr_i(ji,jj) ! no/reduced damping under ice 111 CASE DEFAULT ; coefice(ji,jj) = 1._wp +(nn_icedmp-1)*fr_i(ji,jj) ! reinforced damping (x nn_icedmp) under ice ) 112 END SELECT 113 END DO 114 END DO 100 115 ENDIF 101 116 ! … … 105 120 DO ji = 1, jpi 106 121 zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths 122 & * coefice(ji,jj) & ! Optional control of damping under sea-ice 107 123 & * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) * tmask(ji,jj,1) 108 124 sfx(ji,jj) = sfx(ji,jj) + zerp ! salt flux … … 110 126 END DO 111 127 END DO 112 CALL iom_put( "erp", erp ) ! freshwater flux damping113 128 ! 114 129 ELSEIF( nn_sssr == 2 ) THEN !* Salinity damping term (volume flux (emp) and associated heat flux (qns) … … 118 133 DO ji = 1, jpi 119 134 zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths 135 & * coefice(ji,jj) & ! Optional control of damping under sea-ice 120 136 & * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) & 121 137 & / MAX( sss_m(ji,jj), 1.e-20 ) * tmask(ji,jj,1) … … 126 142 END DO 127 143 END DO 128 CALL iom_put( "erp", erp ) ! freshwater flux damping129 144 ENDIF 130 145 ! … … 154 169 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files 155 170 TYPE(FLD_N) :: sn_sst, sn_sss ! informations about the fields to be read 156 NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd 171 NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, & 172 & sn_sss, ln_sssr_bnd, rn_sssr_bnd, nn_icedmp 157 173 INTEGER :: ios 158 174 !!---------------------------------------------------------------------- … … 182 198 WRITE(numout,*) ' flag to bound erp term ln_sssr_bnd = ', ln_sssr_bnd 183 199 WRITE(numout,*) ' ABS(Max./Min.) erp threshold rn_sssr_bnd = ', rn_sssr_bnd, ' mm/day' 184 ENDIF185 !186 ! !* Allocate erp and qrp array187 ALLOCATE( qrp(jpi,jpj), erp(jpi,jpj), STAT=ierror )188 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate erp and qrp array' )200 WRITE(numout,*) ' Cntrl of surface restoration under ice nn_icedmp = ', nn_icedmp 201 WRITE(numout,*) ' ( 0 = no restoration under ice)' 202 WRITE(numout,*) ' ( 1 = restoration everywhere )' 203 WRITE(numout,*) ' (>1 = enhanced restoration under ice )' 204 ENDIF 189 205 ! 190 206 IF( nn_sstr == 1 ) THEN !* set sf_sst structure & allocate arrays … … 216 232 ENDIF 217 233 ! 234 coefice(:,:) = 1._wp ! Initialise coefice to 1._wp ; will not need to be changed if nn_icedmp=1 218 235 ! !* Initialize qrp and erp if no restoring 219 236 IF( nn_sstr /= 1 ) qrp(:,:) = 0._wp … … 221 238 ! 222 239 END SUBROUTINE sbc_ssr_init 240 241 INTEGER FUNCTION sbc_ssr_alloc() 242 !!---------------------------------------------------------------------- 243 !! *** FUNCTION sbc_ssr_alloc *** 244 !!---------------------------------------------------------------------- 245 sbc_ssr_alloc = 0 ! set to zero if no array to be allocated 246 IF( .NOT. ALLOCATED( erp ) ) THEN 247 ALLOCATE( qrp(jpi,jpj), erp(jpi,jpj), coefice(jpi,jpj), STAT= sbc_ssr_alloc ) 248 ! 249 IF( lk_mpp ) CALL mpp_sum ( 'sbcssr', sbc_ssr_alloc ) 250 IF( sbc_ssr_alloc /= 0 ) CALL ctl_warn('sbc_ssr_alloc: failed to allocate arrays.') 251 ! 252 ENDIF 253 END FUNCTION 223 254 224 255 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.
