Changeset 11993 for NEMO/trunk/src/OCE/SBC
- Timestamp:
- 2019-11-28T11:20:53+01:00 (5 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
r11989 r11993 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, ztmp2804 803 !!--------------------------------------------------------------------- 805 804 ! … … 914 913 qtr_ice_top(:,:,:) = 0._wp 915 914 END WHERE 916 !917 918 IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') ) THEN919 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 ENDIF923 IF( iom_use('hflx_rain_cea') ) THEN924 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 ENDIF927 IF( iom_use('hflx_snow_cea') .OR. iom_use('hflx_snow_ao_cea') .OR. iom_use('hflx_snow_ai_cea') ) THEN928 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 ENDWHERE931 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 ENDIF936 915 ! 937 916 IF(ln_ctl) THEN -
NEMO/trunk/src/OCE/SBC/sbccpl.F90
r11989 r11993 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)1777 1776 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) 1778 1777 IF( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) & … … 1898 1897 #endif 1899 1898 ! outputs 1900 IF ( srcv(jpr_cal)%laction ) CALL iom_put('hflx_cal_cea' , - frcv(jpr_cal)%z3(:,:,1) * rLfus ) ! latent heat from calving1901 IF ( srcv(jpr_icb)%laction ) CALL iom_put('hflx_icb_cea' , - frcv(jpr_icb)%z3(:,:,1) * rLfus ) ! latent heat from icebergs melting1902 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) &1899 IF ( srcv(jpr_cal)%laction ) CALL iom_put('hflx_cal_cea' , - frcv(jpr_cal)%z3(:,:,1) * rLfus ) ! latent heat from calving 1900 IF ( srcv(jpr_icb)%laction ) CALL iom_put('hflx_icb_cea' , - frcv(jpr_icb)%z3(:,:,1) * rLfus ) ! latent heat from icebergs melting 1901 IF ( iom_use('hflx_rain_cea') ) CALL iom_put('hflx_rain_cea' , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) ! heat flux from rain (cell average) 1902 IF ( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea' , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) & 1904 1903 & * picefr(:,:) ) * zcptn(:,:) * tmask(:,:,1) ) ! heat flux from evap (cell average) 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 ) & 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 ) & 1909 1906 & * ( 1._wp - zsnw(:,:) ) ) ! heat flux from snow (over ocean) 1910 IF ( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) &1907 IF ( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 1911 1908 & * zsnw(:,:) ) ! heat flux from snow (over ice) 1912 1909 ! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp. … … 2304 2301 ! ! CO2 flux from PISCES ! 2305 2302 ! ! ------------------------- ! 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 2303 IF( ssnd(jps_co2)%laction .AND. l_co2cpl ) CALL cpl_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info ) 2310 2304 ! 2311 2305 ! ! ------------------------- ! -
NEMO/trunk/src/OCE/SBC/sbcmod.F90
r11989 r11993 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 restoring249 qrp(:,:) = 0._wp250 erp(:,:) = 0._wp251 ENDIF252 !253 254 246 IF( nn_ice == 0 ) THEN !* No sea-ice in the domain : ice fraction is always zero 255 247 IF( nn_components /= jp_iam_opa ) fr_i(:,:) = 0._wp ! except for OPA in SAS-OPA coupled case … … 560 552 CALL iom_put( "taum" , taum ) ! wind stress module 561 553 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 damping563 CALL iom_put( "erp", erp ) ! freshwater flux damping564 554 ENDIF 565 555 ! -
NEMO/trunk/src/OCE/SBC/sbcrnf.F90
r11989 r11993 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 file46 45 LOGICAL :: ln_rnf_tem !: temperature river runoffs attribute specified in a file 47 46 LOGICAL , PUBLIC :: ln_rnf_sal !: salinity river runoffs attribute specified in a file 48 47 TYPE(FLD_N) , PUBLIC :: sn_rnf !: information about the runoff file to be read 49 48 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 read51 49 TYPE(FLD_N) :: sn_s_rnf !: information about the salinities of runoff file to be read 52 50 TYPE(FLD_N) :: sn_t_rnf !: information about the temperatures of runoff file to be read … … 67 65 68 66 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)70 67 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_s_rnf ! structure: river runoff salinity (file information, fields read) 71 68 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_t_rnf ! structure: river runoff temperature (file information, fields read) … … 115 112 ! !-------------------! 116 113 ! 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 114 IF( .NOT. l_rnfcpl ) CALL fld_read ( kt, nn_fsbc, sf_rnf ) ! Read Runoffs data and provide it at kt 122 115 IF( ln_rnf_tem ) CALL fld_read ( kt, nn_fsbc, sf_t_rnf ) ! idem for runoffs temperature if required 123 116 IF( ln_rnf_sal ) CALL fld_read ( kt, nn_fsbc, sf_s_rnf ) ! idem for runoffs salinity if required … … 125 118 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 126 119 ! 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 120 IF( .NOT. l_rnfcpl ) rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) ) * tmask(:,:,1) ! updated runoff value at time step kt 135 121 ! 136 122 ! ! set temperature & salinity content of runoffs … … 146 132 ELSE ! use SST as runoffs temperature 147 133 !CEOD River is fresh water so must at least be 0 unless we consider ice 148 rnf_tsc(:,:,jp_tem) = MAX( sst_m(:,:), 0.0_wp) * rnf(:,:) * r1_rau0134 rnf_tsc(:,:,jp_tem) = MAX(sst_m(:,:),0.0_wp) * rnf(:,:) * r1_rau0 149 135 ENDIF 150 136 ! ! use runoffs salinity data 151 137 IF( ln_rnf_sal ) rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 152 138 ! ! else use S=0 for runoffs (done one for all in the init) 153 139 IF( iom_use('runoffs') ) CALL iom_put( 'runoffs' , rnf(:,:) ) ! output runoff mass flux 154 140 IF( iom_use('hflx_rnf_cea') ) CALL iom_put( 'hflx_rnf_cea', rnf_tsc(:,:,jp_tem) * rau0 * rcp ) ! output runoff sensible heat (W/m2) 155 141 ENDIF … … 256 242 REAL(wp), DIMENSION(jpi,jpj,2) :: zrnfcl 257 243 !! 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, &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, & 260 246 & ln_rnf_mouth , rn_hrnf , rn_avt_rnf, rn_rfact, & 261 247 & ln_rnf_depth_ini , rn_dep_max , rn_rnf_max, nn_rnf_depth_file … … 313 299 IF( sn_rnf%ln_tint ) ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) ) 314 300 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 structure317 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 ) THEN321 CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_i_rnf structure' ) ; RETURN322 ENDIF323 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 ELSE327 fwficb(:,:) = 0._wp328 ENDIF329 330 301 ENDIF 331 302 ! -
NEMO/trunk/src/OCE/SBC/sbcssr.F90
r11989 r11993 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 sbcmod33 32 34 33 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: erp !: evaporation damping [kg/m2/s] 35 34 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qrp !: heat flux damping [w/m2] 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: coefice !: under ice relaxation coefficient37 35 38 36 ! !!* Namelist namsbc_ssr * … … 43 41 LOGICAL :: ln_sssr_bnd ! flag to bound erp term 44 42 REAL(wp) :: rn_sssr_bnd ! ABS(Max./Min.) value of erp term [mm/day] 45 INTEGER :: nn_icedmp ! Control of restoring under ice46 43 47 44 REAL(wp) , ALLOCATABLE, DIMENSION(:) :: buffer ! Temporary buffer for exchange … … 100 97 END DO 101 98 END DO 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 99 CALL iom_put( "qrp", qrp ) ! heat flux damping 115 100 ENDIF 116 101 ! … … 120 105 DO ji = 1, jpi 121 106 zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths 122 & * coefice(ji,jj) & ! Optional control of damping under sea-ice123 107 & * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) * tmask(ji,jj,1) 124 108 sfx(ji,jj) = sfx(ji,jj) + zerp ! salt flux … … 126 110 END DO 127 111 END DO 112 CALL iom_put( "erp", erp ) ! freshwater flux damping 128 113 ! 129 114 ELSEIF( nn_sssr == 2 ) THEN !* Salinity damping term (volume flux (emp) and associated heat flux (qns) … … 133 118 DO ji = 1, jpi 134 119 zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths 135 & * coefice(ji,jj) & ! Optional control of damping under sea-ice136 120 & * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) & 137 121 & / MAX( sss_m(ji,jj), 1.e-20 ) * tmask(ji,jj,1) … … 142 126 END DO 143 127 END DO 128 CALL iom_put( "erp", erp ) ! freshwater flux damping 144 129 ENDIF 145 130 ! … … 169 154 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files 170 155 TYPE(FLD_N) :: sn_sst, sn_sss ! informations about the fields to be read 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 156 NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd 173 157 INTEGER :: ios 174 158 !!---------------------------------------------------------------------- … … 198 182 WRITE(numout,*) ' flag to bound erp term ln_sssr_bnd = ', ln_sssr_bnd 199 183 WRITE(numout,*) ' ABS(Max./Min.) erp threshold rn_sssr_bnd = ', rn_sssr_bnd, ' mm/day' 200 WRITE(numout,*) ' Cntrl of surface restoration under ice nn_icedmp = ', nn_icedmp201 WRITE(numout,*) ' ( 0 = no restoration under ice)'202 WRITE(numout,*) ' ( 1 = restoration everywhere )'203 WRITE(numout,*) ' (>1 = enhanced restoration under ice )'204 ENDIF184 ENDIF 185 ! 186 ! !* Allocate erp and qrp array 187 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' ) 205 189 ! 206 190 IF( nn_sstr == 1 ) THEN !* set sf_sst structure & allocate arrays … … 232 216 ENDIF 233 217 ! 234 coefice(:,:) = 1._wp ! Initialise coefice to 1._wp ; will not need to be changed if nn_icedmp=1235 218 ! !* Initialize qrp and erp if no restoring 236 219 IF( nn_sstr /= 1 ) qrp(:,:) = 0._wp … … 238 221 ! 239 222 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 allocated246 IF( .NOT. ALLOCATED( erp ) ) THEN247 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 ENDIF253 END FUNCTION254 223 255 224 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.
