- Timestamp:
- 2020-05-14T21:46:00+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/SBC/sbcssr.F90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser
- Property svn:externals
-
old new 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@HEAD sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/SBC/sbcssr.F90
r12178 r12928 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_sssr_ice ! Control of restoring under ice 43 46 44 47 REAL(wp) , ALLOCATABLE, DIMENSION(:) :: buffer ! Temporary buffer for exchange … … 46 49 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_sss ! structure of input SSS (file informations, fields read) 47 50 51 !! * Substitutions 52 # include "do_loop_substitute.h90" 48 53 !!---------------------------------------------------------------------- 49 54 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 90 95 ! 91 96 IF( nn_sstr == 1 ) THEN !* Temperature restoring term 92 DO jj = 1, jpj 93 DO ji = 1, jpi 94 zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) * tmask(ji,jj,1) 95 qns(ji,jj) = qns(ji,jj) + zqrp 96 qrp(ji,jj) = zqrp 97 END DO 98 END DO 99 CALL iom_put( "qrp", qrp ) ! heat flux damping 97 DO_2D_11_11 98 zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) * tmask(ji,jj,1) 99 qns(ji,jj) = qns(ji,jj) + zqrp 100 qrp(ji,jj) = zqrp 101 END_2D 102 ENDIF 103 ! 104 IF( nn_sssr /= 0 .AND. nn_sssr_ice /= 1 ) THEN 105 ! use fraction of ice ( fr_i ) to adjust relaxation under ice if nn_sssr_ice .ne. 1 106 ! n.b. coefice is initialised and fixed to 1._wp if nn_sssr_ice = 1 107 DO_2D_11_11 108 SELECT CASE ( nn_sssr_ice ) 109 CASE ( 0 ) ; coefice(ji,jj) = 1._wp - fr_i(ji,jj) ! no/reduced damping under ice 110 CASE DEFAULT ; coefice(ji,jj) = 1._wp + ( nn_sssr_ice - 1 ) * fr_i(ji,jj) ! reinforced damping (x nn_sssr_ice) under ice ) 111 END SELECT 112 END_2D 100 113 ENDIF 101 114 ! 102 115 IF( nn_sssr == 1 ) THEN !* Salinity damping term (salt flux only (sfx)) 103 116 zsrp = rn_deds / rday ! from [mm/day] to [kg/m2/s] 104 DO jj = 1, jpj 105 DO ji = 1, jpi 106 zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths 107 & * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) * tmask(ji,jj,1) 108 sfx(ji,jj) = sfx(ji,jj) + zerp ! salt flux 109 erp(ji,jj) = zerp / MAX( sss_m(ji,jj), 1.e-20 ) ! converted into an equivalent volume flux (diagnostic only) 110 END DO 111 END DO 112 CALL iom_put( "erp", erp ) ! freshwater flux damping 117 DO_2D_11_11 118 zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths 119 & * coefice(ji,jj) & ! Optional control of damping under sea-ice 120 & * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) * tmask(ji,jj,1) 121 sfx(ji,jj) = sfx(ji,jj) + zerp ! salt flux 122 erp(ji,jj) = zerp / MAX( sss_m(ji,jj), 1.e-20 ) ! converted into an equivalent volume flux (diagnostic only) 123 END_2D 113 124 ! 114 125 ELSEIF( nn_sssr == 2 ) THEN !* Salinity damping term (volume flux (emp) and associated heat flux (qns) 115 126 zsrp = rn_deds / rday ! from [mm/day] to [kg/m2/s] 116 127 zerp_bnd = rn_sssr_bnd / rday ! - - 117 DO jj = 1, jpj 118 DO ji = 1, jpi 119 zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths 120 & * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) & 121 & / MAX( sss_m(ji,jj), 1.e-20 ) * tmask(ji,jj,1) 122 IF( ln_sssr_bnd ) zerp = SIGN( 1., zerp ) * MIN( zerp_bnd, ABS(zerp) ) 123 emp(ji,jj) = emp (ji,jj) + zerp 124 qns(ji,jj) = qns(ji,jj) - zerp * rcp * sst_m(ji,jj) 125 erp(ji,jj) = zerp 126 END DO 127 END DO 128 CALL iom_put( "erp", erp ) ! freshwater flux damping 128 DO_2D_11_11 129 zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths 130 & * coefice(ji,jj) & ! Optional control of damping under sea-ice 131 & * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) & 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) ) 134 emp(ji,jj) = emp (ji,jj) + zerp 135 qns(ji,jj) = qns(ji,jj) - zerp * rcp * sst_m(ji,jj) 136 erp(ji,jj) = zerp 137 END_2D 129 138 ENDIF 130 139 ! … … 154 163 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files 155 164 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 165 NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, & 166 & sn_sss, ln_sssr_bnd, rn_sssr_bnd, nn_sssr_ice 157 167 INTEGER :: ios 158 168 !!---------------------------------------------------------------------- … … 164 174 ENDIF 165 175 ! 166 REWIND( numnam_ref ) ! Namelist namsbc_ssr in reference namelist :167 176 READ ( numnam_ref, namsbc_ssr, IOSTAT = ios, ERR = 901) 168 177 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_ssr in reference namelist' ) 169 178 170 REWIND( numnam_cfg ) ! Namelist namsbc_ssr in configuration namelist :171 179 READ ( numnam_cfg, namsbc_ssr, IOSTAT = ios, ERR = 902 ) 172 180 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc_ssr in configuration namelist' ) … … 182 190 WRITE(numout,*) ' flag to bound erp term ln_sssr_bnd = ', ln_sssr_bnd 183 191 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' )192 WRITE(numout,*) ' Cntrl of surface restoration under ice nn_sssr_ice = ', nn_sssr_ice 193 WRITE(numout,*) ' ( 0 = no restoration under ice)' 194 WRITE(numout,*) ' ( 1 = restoration everywhere )' 195 WRITE(numout,*) ' (>1 = enhanced restoration under ice )' 196 ENDIF 189 197 ! 190 198 IF( nn_sstr == 1 ) THEN !* set sf_sst structure & allocate arrays … … 216 224 ENDIF 217 225 ! 226 coefice(:,:) = 1._wp ! Initialise coefice to 1._wp ; will not need to be changed if nn_sssr_ice=1 218 227 ! !* Initialize qrp and erp if no restoring 219 228 IF( nn_sstr /= 1 ) qrp(:,:) = 0._wp … … 221 230 ! 222 231 END SUBROUTINE sbc_ssr_init 232 233 INTEGER FUNCTION sbc_ssr_alloc() 234 !!---------------------------------------------------------------------- 235 !! *** FUNCTION sbc_ssr_alloc *** 236 !!---------------------------------------------------------------------- 237 sbc_ssr_alloc = 0 ! set to zero if no array to be allocated 238 IF( .NOT. ALLOCATED( erp ) ) THEN 239 ALLOCATE( qrp(jpi,jpj), erp(jpi,jpj), coefice(jpi,jpj), STAT= sbc_ssr_alloc ) 240 ! 241 IF( lk_mpp ) CALL mpp_sum ( 'sbcssr', sbc_ssr_alloc ) 242 IF( sbc_ssr_alloc /= 0 ) CALL ctl_warn('sbc_ssr_alloc: failed to allocate arrays.') 243 ! 244 ENDIF 245 END FUNCTION 223 246 224 247 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.
