- Timestamp:
- 2019-11-11T10:26:36+01:00 (5 years ago)
- Location:
- branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r8280 r11883 151 151 INTEGER :: id_part 152 152 INTEGER :: paral(5) ! OASIS3 box partition 153 INTEGER :: ishape(2,2) ! shape of arrays passed to PSMILe 153 INTEGER :: ishape(4) ! Shape of 2D arrays passed to PSMILe. 154 ! Redundant from OASIS3-MCT vn4.0 onwards but required 155 ! to satisfy interface and for backward compatibility. 156 INTEGER :: ishape0d1d(2) ! Shape of 0D or 1D arrays passed to PSMILe. 157 INTEGER :: var_nodims(2) ! Number of coupling field dimensions. 158 ! var_nodims(1) is redundant from OASIS3-MCT vn4.0 onwards 159 ! but retained for backward compatibility. 160 ! var_nodims(2) is the number of fields in a bundle 161 ! or 1 for unbundled fields (bundles are not yet catered for 162 ! in NEMO hence we default to 1). 154 163 INTEGER :: ji,jc,jm ! local loop indicees 155 164 CHARACTER(LEN=64) :: zclname … … 182 191 ! nl* is set to the global values 1 and jp*glo. 183 192 ! 184 ishape(:,1) = (/ 1, nlei-nldi+1 /) 185 ishape(:,2) = (/ 1, nlej-nldj+1 /) 193 ishape(1) = 1 194 ishape(2) = nlei-nldi+1 195 ishape(3) = 1 196 ishape(4) = nlej-nldj+1 197 198 ishape0d1d(1) = 0 199 ishape0d1d(2) = 0 200 186 201 ! 187 202 ! ... Allocate memory for data exchange … … 243 258 #endif 244 259 IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_Out 245 CALL oasis_def_var (ssnd(ji)%nid(jc,jm), zclname, id_part , (/ 2, 0 /), & 260 261 ! 262 ! ... Set the field dimension and bundle count 263 var_nodims(1) = 2 264 var_nodims(2) = 1 ! Modify this value to cater for bundled fields. 265 266 CALL oasis_def_var (ssnd(ji)%nid(jc,jm), zclname, id_part , var_nodims, & 246 267 & OASIS_Out , ishape , OASIS_REAL, nerror ) 247 268 IF ( nerror /= OASIS_Ok ) THEN … … 288 309 #endif 289 310 IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In 290 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part , (/ 2, 0 /), & 291 & OASIS_In , ishape , OASIS_REAL, nerror ) 311 312 var_nodims(1) = 2 313 var_nodims(2) = 1 ! Modify this value to cater for bundled fields. 314 315 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part , var_nodims, & 316 OASIS_In , ishape , OASIS_REAL, nerror ) 292 317 IF ( nerror /= OASIS_Ok ) THEN 293 318 WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) -
branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90
r9975 r11883 124 124 #if defined key_lim2 || defined key_cice 125 125 ! already defined in ice.F90 for LIM3 126 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i 126 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i ! Sea ice fraction on categories 127 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i_last_couple ! Sea ice fraction on categories at the last coupling point 127 128 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ht_i, ht_s 128 129 #endif -
branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r9321 r11883 54 54 USE lib_fortran, ONLY: glob_sum 55 55 56 #if defined key_oasis3 57 USE mod_oasis, ONLY : OASIS_Sent, OASIS_ToRest, OASIS_SentOut, OASIS_ToRestOut 58 #endif 59 56 60 IMPLICIT NONE 57 61 PRIVATE … … 154 158 ! i.e. specifically nmol/L (= umol/m3) 155 159 160 #if ! defined key_oasis3 161 ! Dummy variables to enable compilation when oasis3 is not being used 162 INTEGER :: OASIS_Sent = -1 163 INTEGER :: OASIS_SentOut = -1 164 INTEGER :: OASIS_ToRest = -1 165 INTEGER :: OASIS_ToRestOut = -1 166 #endif 167 156 168 ! !!** namelist namsbc_cpl ** 157 169 TYPE :: FLD_C … … 175 187 LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models 176 188 ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 189 LOGICAL, PUBLIC :: ln_fix_sea_ice_fluxes ! Apply sea ice flux bug fixes (GMED#449) 190 177 191 TYPE :: DYNARR 178 192 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3 … … 200 214 !! *** FUNCTION sbc_cpl_alloc *** 201 215 !!---------------------------------------------------------------------- 202 INTEGER :: ierr( 3)216 INTEGER :: ierr(4) 203 217 !!---------------------------------------------------------------------- 204 218 ierr(:) = 0 … … 212 226 ! Hardwire only two models as nn_cplmodel has not been read in 213 227 ! from the namelist yet. 214 ALLOCATE( xcplmask(jpi,jpj,0:2) , STAT=ierr(3) ) 228 ALLOCATE( xcplmask(jpi,jpj,0:2) , STAT=ierr(3) ) 229 #if defined key_cice 230 ALLOCATE( a_i_last_couple(jpi,jpj,jpl) , STAT=ierr(4) ) 231 #endif 215 232 ! 216 233 sbc_cpl_alloc = MAXVAL( ierr ) … … 247 264 & ln_usecplmask, nn_coupled_iceshelf_fluxes, ln_iceshelf_init_atmos, & 248 265 & rn_greenland_total_fw_flux, rn_greenland_calving_fraction, & 249 & rn_antarctica_total_fw_flux, rn_antarctica_calving_fraction, rn_iceshelf_fluxes_tolerance 266 & rn_antarctica_total_fw_flux, rn_antarctica_calving_fraction, rn_iceshelf_fluxes_tolerance, & 267 & ln_fix_sea_ice_fluxes 250 268 !!--------------------------------------------------------------------- 251 269 … … 317 335 WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel 318 336 WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask 337 WRITE(numout,*)' ln_fix_sea_ice_fluxes = ', ln_fix_sea_ice_fluxes 319 338 WRITE(numout,*)' nn_coupled_iceshelf_fluxes = ', nn_coupled_iceshelf_fluxes 320 339 WRITE(numout,*)' ln_iceshelf_init_atmos = ', ln_iceshelf_init_atmos … … 1758 1777 IF ( TRIM(sn_rcv_emp%clcat) == 'yes' ) THEN 1759 1778 ! zemp_ice is the sum of frcv(jpr_ievp)%z3(:,:,1) over all layers - snow 1760 zemp_ice(:,:) = - frcv(jpr_snow)%z3(:,:,1) 1779 IF ( ln_fix_sea_ice_fluxes ) THEN 1780 zemp_ice(:,:) = - frcv(jpr_snow)%z3(:,:,1) * zicefr(:,:) 1781 ELSE 1782 zemp_ice(:,:) = - frcv(jpr_snow)%z3(:,:,1) 1783 ENDIF 1761 1784 DO jl=1,jpl 1762 zemp_ice(:,: ) = zemp_ice(:,:) + frcv(jpr_ievp)%z3(:,:,jl) 1785 IF ( ln_fix_sea_ice_fluxes ) THEN 1786 zemp_ice(:,: ) = zemp_ice(:,:) + frcv(jpr_ievp)%z3(:,:,jl) * a_i_last_couple(:,:,jl) 1787 ELSE 1788 zemp_ice(:,: ) = zemp_ice(:,:) + frcv(jpr_ievp)%z3(:,:,jl) 1789 ENDIF 1763 1790 ENDDO 1764 1791 ! latent heat coupled for each category in CICE … … 2269 2296 END SELECT 2270 2297 IF( ssnd(jps_fice)%laction ) CALL cpl_snd( jps_fice, isec, ztmp3, info ) 2298 2299 #if defined key_lim2 || defined key_cice 2300 ! If this coupling was successful then save ice fraction for use between coupling points. 2301 ! This is needed for some calculations where the ice fraction at the last coupling point 2302 ! is needed. 2303 IF( info == OASIS_Sent .OR. info == OASIS_ToRest .OR. & 2304 & info == OASIS_SentOut .OR. info == OASIS_ToRestOut ) THEN 2305 IF ( sn_snd_thick%clcat == 'yes' ) THEN 2306 a_i_last_couple(:,:,:) = a_i(:,:,:) 2307 ENDIF 2308 ENDIF 2309 #endif 2310 2271 2311 ENDIF 2272 2312 -
branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
r9975 r11883 395 395 ELSE IF (ksbc == jp_purecpl) THEN 396 396 DO jl=1,ncat 397 ztmpn(:,:,jl)=qla_ice(:,:,jl)*a_i(:,:,jl) 397 IF ( ln_fix_sea_ice_fluxes ) THEN 398 ztmpn(:,:,jl)=qla_ice(:,:,jl)*a_i_last_couple(:,:,jl) 399 ELSE 400 ztmpn(:,:,jl)=qla_ice(:,:,jl)*a_i(:,:,jl) 401 ENDIF 398 402 ENDDO 399 403 ELSE … … 408 412 ! Convert to GBM 409 413 IF (ksbc == jp_flx .OR. ksbc == jp_purecpl) THEN 410 ztmp(:,:) = botmelt(:,:,jl)*a_i(:,:,jl) 414 IF ( ln_fix_sea_ice_fluxes ) THEN 415 ztmp(:,:) = botmelt(:,:,jl)*a_i_last_couple(:,:,jl) 416 ELSE 417 ztmp(:,:) = botmelt(:,:,jl)*a_i(:,:,jl) 418 ENDIF 411 419 ELSE 412 420 ztmp(:,:) = botmelt(:,:,jl) … … 417 425 ! Convert to GBM 418 426 IF (ksbc == jp_flx .OR. ksbc == jp_purecpl) THEN 419 ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i(:,:,jl) 427 IF ( ln_fix_sea_ice_fluxes ) THEN 428 ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i_last_couple(:,:,jl) 429 ELSE 430 ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i(:,:,jl) 431 ENDIF 420 432 ELSE 421 433 ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))
Note: See TracChangeset
for help on using the changeset viewer.