Changeset 13778
- Timestamp:
- 2020-11-11T14:27:17+01:00 (4 years ago)
- Location:
- NEMO/branches/UKMO/NEMO_4.0.3_icesheet_and_river_coupling
- Files:
-
- 8 edited
- 1 copied
-
cfgs/SHARED/field_def_nemo-oce.xml (modified) (1 diff)
-
cfgs/SHARED/namelist_ref (modified) (1 diff)
-
src/OCE/ICB/icbclv.F90 (modified) (3 diffs)
-
src/OCE/IOM/restart.F90 (modified) (3 diffs)
-
src/OCE/SBC/cpl_oasis3.F90 (modified) (12 diffs)
-
src/OCE/SBC/cpl_rnf_1d.F90 (copied) (copied from NEMO/branches/UKMO/NEMO_4.0.1_icesheet_and_river_coupling/src/OCE/SBC/cpl_rnf_1d.F90)
-
src/OCE/SBC/sbc_oce.F90 (modified) (3 diffs)
-
src/OCE/SBC/sbccpl.F90 (modified) (18 diffs)
-
src/OCE/SBC/sbcisf.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO_4.0.3_icesheet_and_river_coupling/cfgs/SHARED/field_def_nemo-oce.xml
r13340 r13778 289 289 290 290 <!-- * variable related to ice shelf forcing * --> 291 <field id="berg_calve" long_name="Iceberg calving" unit="kg/m2/s" /> 291 292 <field id="fwfisf" long_name="Ice shelf melting" unit="kg/m2/s" /> 292 293 <field id="fwfisf3d" long_name="Ice shelf melting" unit="kg/m2/s" grid_ref="grid_T_3D" /> -
NEMO/branches/UKMO/NEMO_4.0.3_icesheet_and_river_coupling/cfgs/SHARED/namelist_ref
r13587 r13778 292 292 ln_scale_ice_flux = .false. ! use ice fluxes that are already "ice weighted" ( i.e. multiplied ice concentration) 293 293 nn_cats_cpl = 5 ! Number of sea ice categories over which coupling is to be carried out (if not 1) 294 nn_coupled_iceshelf_fluxes = 0 ! =0 : total freshwater input from iceberg calving and ice shelf basal melting 295 ! taken from climatologies used (no action in coupling routines). 296 ! =1 : use rate of change of mass of Greenland and Antarctic icesheets to set the 297 ! combined magnitude of the iceberg calving and iceshelf melting freshwater fluxes. 298 ! =2 : specify constant freshwater inputs in this namelist to set the combined 299 ! magnitude of iceberg calving and iceshelf melting freshwater fluxes. 300 ln_iceshelf_init_atmos = .true. ! If true force ocean to initialise icesheet masses from atmospheric values rather than 301 ! from values in ocean restart file. 302 rn_greenland_total_fw_flux = 0.0 ! Constant total rate of freshwater input (kg/s) for Greenland (if nn_coupled_iceshelf_fluxes=2) 303 rn_greenland_calving_fraction = 0.5 ! Set fraction of total freshwater flux for iceberg calving - remainder goes to iceshelf melting. 304 rn_antarctica_total_fw_flux = 0.0 ! Constant total rate of freshwater input (kg/s) for Antarctica (if nn_coupled_iceshelf_fluxes=2) 305 rn_antarctica_calving_fraction = 0.5 ! Set fraction of total freshwater flux for iceberg calving - remainder goes to iceshelf melting. 306 rn_iceshelf_fluxes_tolerance = 1e-6 ! Fractional threshold for detecting differences in icesheet masses (must be positive definite). 307 294 308 !_____________!__________________________!____________!_____________!______________________!________! 295 309 ! ! description ! multiple ! vector ! vector ! vector ! -
NEMO/branches/UKMO/NEMO_4.0.3_icesheet_and_river_coupling/src/OCE/ICB/icbclv.F90
r13587 r13778 26 26 USE icb_oce ! iceberg parameters 27 27 28 USE sbc_oce ! for icesheet freshwater input variables 29 USE in_out_manager 30 USE iom 31 28 32 IMPLICIT NONE 29 33 PRIVATE … … 49 53 ! 50 54 REAL(wp) :: zcalving_used, zdist, zfact 55 REAL(wp), DIMENSION(1) :: zgreenland_calving_sum, zantarctica_calving_sum 56 LOGICAL :: ll_write 51 57 INTEGER :: jn, ji, jj ! loop counters 52 58 INTEGER :: imx ! temporary integer for max berg class … … 63 69 ! Heat in units of W/m2, and mask (just in case) 64 70 berg_grid%calving_hflx(:,:) = src_calving_hflx(:,:) * tmask_i(:,:) * tmask(:,:,1) 71 72 IF( lk_oasis) THEN 73 ! nn_coupled_iceshelf_fluxes uninitialised unless lk_oasis=true 74 IF( nn_coupled_iceshelf_fluxes .gt. 0 ) THEN 75 ll_write = ((MOD( kt, sn_cfctl%ptimincr ) == 0) .OR. ( kt == nitend )) .AND. lwp .AND. ((nn_print>0)) 76 ! Adjust total calving rates so that sum of iceberg calving and iceshelf melting in the northern 77 ! and southern hemispheres equals rate of increase of mass of greenland and antarctic ice sheets 78 ! to preserve total freshwater conservation in coupled models without an active ice sheet model. 79 80 zgreenland_calving_sum(1) = SUM( berg_grid%calving(:,:) * greenland_icesheet_mask(:,:) ) 81 IF( lk_mpp ) CALL mpp_sum( 'icbclv', zgreenland_calving_sum ) 82 WHERE( greenland_icesheet_mask(:,:) == 1.0 ) & 83 & berg_grid%calving(:,:) = berg_grid%calving(:,:) * greenland_icesheet_mass_rate_of_change * rn_greenland_calving_fraction & 84 & / ( zgreenland_calving_sum(1) + 1.0e-10_wp ) 85 86 ! check 87 IF(ll_write) WRITE(numout, *) 'Greenland iceberg calving climatology (kg/s) : ',zgreenland_calving_sum(1) 88 zgreenland_calving_sum(1) = SUM( berg_grid%calving(:,:) * greenland_icesheet_mask(:,:) ) 89 IF( lk_mpp ) CALL mpp_sum( 'icbclv', zgreenland_calving_sum ) 90 IF(ll_write) WRITE(numout, *) 'Greenland iceberg calving adjusted value (kg/s) : ',zgreenland_calving_sum(1) 91 92 zantarctica_calving_sum(1) = SUM( berg_grid%calving(:,:) * antarctica_icesheet_mask(:,:) ) 93 IF( lk_mpp ) CALL mpp_sum( 'icbclv', zantarctica_calving_sum ) 94 WHERE( antarctica_icesheet_mask(:,:) == 1.0 ) & 95 berg_grid%calving(:,:) = berg_grid%calving(:,:) * antarctica_icesheet_mass_rate_of_change * rn_antarctica_calving_fraction & 96 & / ( zantarctica_calving_sum(1) + 1.0e-10_wp ) 97 98 ! check 99 IF(ll_write) WRITE(numout, *) 'Antarctica iceberg calving climatology (kg/s) : ',zantarctica_calving_sum(1) 100 zantarctica_calving_sum(1) = SUM( berg_grid%calving(:,:) * antarctica_icesheet_mask(:,:) ) 101 IF( lk_mpp ) CALL mpp_sum( 'icbclv', zantarctica_calving_sum ) 102 IF(ll_write) WRITE(numout, *) 'Antarctica iceberg calving adjusted value (kg/s) : ',zantarctica_calving_sum(1) 103 104 ENDIF 105 ENDIF 106 107 CALL iom_put( 'berg_calve', berg_grid%calving(:,:) ) 108 65 109 66 110 IF( ll_first_call .AND. .NOT. l_restarted_bergs ) THEN ! This is a hack to simplify initialization -
NEMO/branches/UKMO/NEMO_4.0.3_icesheet_and_river_coupling/src/OCE/IOM/restart.F90
r13587 r13778 29 29 USE diurnal_bulk 30 30 USE lib_mpp ! distribued memory computing library 31 USE sbc_oce ! for icesheet freshwater input variables 31 32 32 33 IMPLICIT NONE … … 161 162 CALL iom_rstput( kt, nitrst, numrow, 'sshn' , sshn, ldxios = lwxios ) 162 163 CALL iom_rstput( kt, nitrst, numrow, 'rhop' , rhop, ldxios = lwxios ) 164 165 IF( lk_oasis) THEN 166 ! nn_coupled_iceshelf_fluxes uninitialised unless lk_oasis=true 167 IF( nn_coupled_iceshelf_fluxes .eq. 1 ) THEN 168 CALL iom_rstput( kt, nitrst, numrow, 'greenland_icesheet_mass', greenland_icesheet_mass ) 169 CALL iom_rstput( kt, nitrst, numrow, 'greenland_icesheet_timelapsed', greenland_icesheet_timelapsed ) 170 CALL iom_rstput( kt, nitrst, numrow, 'greenland_icesheet_mass_roc', greenland_icesheet_mass_rate_of_change ) 171 CALL iom_rstput( kt, nitrst, numrow, 'antarctica_icesheet_mass', antarctica_icesheet_mass ) 172 CALL iom_rstput( kt, nitrst, numrow, 'antarctica_icesheet_timelapsed', antarctica_icesheet_timelapsed ) 173 CALL iom_rstput( kt, nitrst, numrow, 'antarctica_icesheet_mass_roc', antarctica_icesheet_mass_rate_of_change ) 174 ENDIF 175 ENDIF 163 176 ! extra variable needed for the ice sheet coupling 164 177 IF ( ln_iscpl ) THEN … … 295 308 ENDIF 296 309 ! 310 IF( iom_varid( numror, 'greenland_icesheet_mass', ldstop = .FALSE. ) > 0 ) THEN 311 CALL iom_get( numror, 'greenland_icesheet_mass', greenland_icesheet_mass ) 312 CALL iom_get( numror, 'greenland_icesheet_timelapsed', greenland_icesheet_timelapsed ) 313 CALL iom_get( numror, 'greenland_icesheet_mass_roc', greenland_icesheet_mass_rate_of_change ) 314 ELSE 315 greenland_icesheet_mass = 0.0 316 greenland_icesheet_mass_rate_of_change = 0.0 317 greenland_icesheet_timelapsed = 0.0 318 ENDIF 319 IF( iom_varid( numror, 'antarctica_icesheet_mass', ldstop = .FALSE. ) > 0 ) THEN 320 CALL iom_get( numror, 'antarctica_icesheet_mass', antarctica_icesheet_mass ) 321 CALL iom_get( numror, 'antarctica_icesheet_timelapsed', antarctica_icesheet_timelapsed ) 322 CALL iom_get( numror, 'antarctica_icesheet_mass_roc', antarctica_icesheet_mass_rate_of_change ) 323 ELSE 324 antarctica_icesheet_mass = 0.0 325 antarctica_icesheet_mass_rate_of_change = 0.0 326 antarctica_icesheet_timelapsed = 0.0 327 ENDIF 328 ! 297 329 IF( neuler == 0 ) THEN ! Euler restart (neuler=0) 298 330 tsb (:,:,:,:) = tsn (:,:,:,:) ! all before fields set to now values -
NEMO/branches/UKMO/NEMO_4.0.3_icesheet_and_river_coupling/src/OCE/SBC/cpl_oasis3.F90
r13587 r13778 29 29 #endif 30 30 USE par_oce ! ocean parameters 31 USE cpl_rnf_1d, ONLY: nn_cpl_river ! Variables used in 1D river outflow 31 32 USE dom_oce ! ocean space and time domain 32 33 USE in_out_manager ! I/O manager 33 34 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 35 USE lib_mpp 34 36 35 37 IMPLICIT NONE 36 38 PRIVATE 39 40 #if ! defined key_oasis3 41 ! Dummy interface to oasis_get if not using oasis 42 INTERFACE oasis_get 43 MODULE PROCEDURE oasis_get_1d, oasis_get_2d 44 END INTERFACE 45 #endif 37 46 38 47 PUBLIC cpl_init … … 40 49 PUBLIC cpl_snd 41 50 PUBLIC cpl_rcv 51 PUBLIC cpl_rcv_1d 42 52 PUBLIC cpl_freq 43 53 PUBLIC cpl_finalize 44 54 55 #if defined key_mpp_mpi 56 INCLUDE 'mpif.h' 57 #endif 58 59 INTEGER, PARAMETER :: localRoot = 0 45 60 INTEGER, PUBLIC :: OASIS_Rcv = 1 !: return code if received field 46 61 INTEGER, PUBLIC :: OASIS_idle = 0 !: return code if nothing done by oasis … … 66 81 INTEGER :: nsnd ! total number of fields sent 67 82 INTEGER :: ncplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 68 INTEGER, PUBLIC, PARAMETER :: nmaxfld=6 0! Maximum number of coupling fields83 INTEGER, PUBLIC, PARAMETER :: nmaxfld=61 ! Maximum number of coupling fields 69 84 INTEGER, PUBLIC, PARAMETER :: nmaxcat=5 ! Maximum number of coupling fields 70 85 INTEGER, PUBLIC, PARAMETER :: nmaxcpl=5 ! Maximum number of coupling fields … … 81 96 INTEGER :: nct ! Number of categories in field 82 97 INTEGER :: ncplmodel ! Maximum number of models to/from which this variable may be sent/received 98 INTEGER :: dimensions ! Number of dimensions of coupling field 83 99 END TYPE FLD_CPL 84 100 … … 105 121 CHARACTER(len = *), INTENT(in ) :: cd_modname ! model name as set in namcouple file 106 122 INTEGER , INTENT( out) :: kl_comm ! local communicator of the model 123 INTEGER :: error 107 124 !!-------------------------------------------------------------------- 108 125 … … 141 158 ! 142 159 INTEGER :: id_part 160 INTEGER :: id_part_0d ! Partition for 0d fields 161 INTEGER :: id_part_rnf_1d ! Partition for 1d river outflow fields 162 INTEGER :: id_part_temp ! Temperary partition used to choose either 0d or 1d partitions 143 163 INTEGER :: paral(5) ! OASIS3 box partition 144 INTEGER :: ishape(4) ! shape of arrays passed to PSMILe 164 INTEGER :: ishape(4) ! shape of 2D arrays passed to PSMILe 165 INTEGER :: ishape0d1d(2) ! Shape of 0D or 1D arrays passed to PSMILe. 166 INTEGER :: var_nodims(2) ! Number of coupling field dimensions. 167 ! var_nodims(1) is redundant from OASIS3-MCT vn4.0 onwards 168 ! but retained for backward compatibility. 169 ! var_nodims(2) is the number of fields in a bundle 170 ! or 1 for unbundled fields (bundles are not yet catered for 171 ! in NEMO hence we default to 1). 145 172 INTEGER :: ji,jc,jm ! local loop indicees 146 173 CHARACTER(LEN=64) :: zclname … … 185 212 ishape(3) = 1 186 213 ishape(4) = nlej-nldj+1 214 215 ishape0d1d(1) = 0 216 ishape0d1d(2) = 0 187 217 ! 188 218 ! ... Allocate memory for data exchange … … 211 241 212 242 CALL oasis_def_partition ( id_part, paral, nerror, jpiglo*jpjglo ) 243 244 ! A special partition is needed for 0D fields 245 246 paral(1) = 0 ! serial partitioning 247 paral(2) = 0 248 IF ( nproc == 0) THEN 249 paral(3) = 1 ! Size of array to couple (scalar) 250 ELSE 251 paral(3) = 0 ! Dummy size for PE's not involved 252 END IF 253 paral(4) = 0 254 paral(5) = 0 255 256 CALL oasis_def_partition ( id_part_0d, paral, nerror, 1 ) 257 258 ! Another partition is needed for 1D river routing fields 259 260 paral(1) = 0 ! serial partitioning 261 paral(2) = 0 262 IF ( nproc == 0) THEN 263 paral(3) = nn_cpl_river ! Size of array to couple (vector) 264 ELSE 265 paral(3) = 0 ! Dummy size for PE's not involved 266 END IF 267 paral(4) = 0 268 paral(5) = 0 269 270 271 CALL oasis_def_partition ( id_part_rnf_1d, paral, nerror, nn_cpl_river ) 272 213 273 ! 214 274 ! ... Announce send variables. … … 289 349 #endif 290 350 IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In 291 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part , (/ 2, 1 /), & 292 & OASIS_In , ishape , OASIS_REAL, nerror ) 351 flush(numout) 352 353 ! Define 0D (Greenland or Antarctic ice mass) or 1D (river outflow) coupling fields 354 IF (srcv(ji)%dimensions <= 1) THEN 355 var_nodims(1) = 1 356 var_nodims(2) = 1 ! Modify this value to cater for bundled fields. 357 IF (nproc == 0) THEN 358 359 IF (srcv(ji)%dimensions == 0) THEN 360 361 ! If 0D then set temporary variables to 0D components 362 id_part_temp = id_part_0d 363 ishape0d1d(2) = 1 364 ELSE 365 366 ! If 1D then set temporary variables to river outflow components 367 id_part_temp = id_part_rnf_1d 368 ishape0d1d(2)= nn_cpl_river 369 370 END IF 371 372 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part_temp , var_nodims, & 373 OASIS_In , ishape0d1d(1:2) , OASIS_REAL, nerror ) 374 ELSE 375 ! Dummy call to keep OASIS3-MCT happy. 376 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part_0d , var_nodims, & 377 OASIS_In , ishape0d1d(1:2) , OASIS_REAL, nerror ) 378 END IF 379 ELSE 380 ! It's a "normal" 2D (or pseudo 3D) coupling field. 381 ! ... Set the field dimension and bundle count 382 var_nodims(1) = 2 383 var_nodims(2) = 1 ! Modify this value to cater for bundled fields. 384 385 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part , var_nodims, & 386 & OASIS_In , ishape , OASIS_REAL, nerror ) 387 ENDIF 293 388 IF ( nerror /= OASIS_Ok ) THEN 294 389 WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) … … 471 566 472 567 568 SUBROUTINE cpl_rcv_1d( kid, kstep, pdata, nitems, kinfo ) 569 !!--------------------------------------------------------------------- 570 !! *** ROUTINE cpl_rcv_1d *** 571 !! 572 !! ** Purpose : - A special version of cpl_rcv to deal exclusively with 573 !! receipt of 0D or 1D fields. 574 !! The fields are recieved into a 1D array buffer which is simply a 575 !! dynamically sized sized array (which may be of size 1) 576 !! of 0 dimensional fields. This allows us to pass miltiple 0D 577 !! fields via a single put/get operation. 578 !!---------------------------------------------------------------------- 579 INTEGER , INTENT(in ) :: nitems ! Number of 0D items to recieve 580 ! during this get operation. i.e. 581 ! The size of the 1D array in which 582 ! 0D items are passed. 583 INTEGER , INTENT(in ) :: kid ! ID index of the incoming 584 ! data. 585 INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds 586 REAL(wp), INTENT(inout) :: pdata(1:nitems) ! The original value(s), 587 ! unchanged if nothing is 588 ! received 589 INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument 590 !! 591 REAL(wp) :: recvfld(1:nitems) ! Local receive field buffer 592 INTEGER :: jc,jm ! local loop index 593 INTEGER :: ierr 594 LOGICAL :: llaction 595 INTEGER :: MPI_WORKING_PRECISION 596 INTEGER :: number_to_print 597 !!-------------------------------------------------------------------- 598 ! 599 ! receive local data from OASIS3 on every process 600 ! 601 kinfo = OASIS_idle 602 ! 603 ! 0D and 1D fields won't have categories or any other form of "pseudo level" 604 ! so we only cater for a single set of values and thus don't bother 605 ! with a loop over the jc index 606 jc = 1 607 608 DO jm = 1, srcv(kid)%ncplmodel 609 610 IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 611 612 IF ( ( srcv(kid)%dimensions <= 1) .AND. (nproc == 0) ) THEN 613 ! Since there is no concept of data decomposition for zero 614 ! dimension fields, they must only be exchanged through the master PE, 615 ! unlike "normal" 2D field cases where every PE is involved. 616 617 CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, recvfld, kinfo ) 618 619 llaction = kinfo == OASIS_Recvd .OR. kinfo == OASIS_FromRest .OR. & 620 kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 621 622 IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , & 623 llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 624 625 IF ( llaction ) THEN 626 627 kinfo = OASIS_Rcv 628 pdata(1:nitems) = recvfld(1:nitems) 629 630 IF ( ln_ctl ) THEN 631 number_to_print = 10 632 IF ( nitems < number_to_print ) number_to_print = nitems 633 WRITE(numout,*) '****************' 634 WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname 635 WRITE(numout,*) 'oasis_get: ivarid ' , srcv(kid)%nid(jc,jm) 636 WRITE(numout,*) 'oasis_get: kstep', kstep 637 WRITE(numout,*) 'oasis_get: info ', kinfo 638 WRITE(numout,*) ' - Minimum Value is ', MINVAL(pdata(:)) 639 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:)) 640 WRITE(numout,*) ' - Start of data is ', pdata(1:number_to_print) 641 WRITE(numout,*) '****************' 642 ENDIF 643 644 ENDIF 645 ENDIF 646 ENDIF 647 648 ENDDO 649 650 #if defined key_mpp_mpi 651 ! Set the precision that we want to broadcast using MPI_BCAST 652 SELECT CASE( wp ) 653 CASE( sp ) 654 MPI_WORKING_PRECISION = MPI_REAL ! Single precision 655 CASE( dp ) 656 MPI_WORKING_PRECISION = MPI_DOUBLE_PRECISION ! Double precision 657 CASE default 658 CALL oasis_abort( ncomp_id, "cpl_rcv_1d", "Could not find precision for coupling 0d or 1d field" ) 659 END SELECT 660 661 ! We have to broadcast (potentially) received values from PE 0 to all 662 ! the others. If no new data has been received we're just 663 ! broadcasting the existing values but there's no more efficient way 664 ! to deal with that w/o NEMO adopting a UM-style test mechanism 665 ! to determine active put/get timesteps. 666 CALL mpi_bcast( pdata, nitems, MPI_WORKING_PRECISION, localRoot, mpi_comm_oce, ierr ) 667 #else 668 CALL oasis_abort( ncomp_id, "cpl_rcv_1d", "Unable to use mpi_bcast without key_mpp_mpi present. Please add key_mpp_mpi to your list of NEMO keys." ) 669 #endif 670 671 ! 672 END SUBROUTINE cpl_rcv_1d 673 674 473 675 INTEGER FUNCTION cpl_freq( cdfieldname ) 474 676 !!--------------------------------------------------------------------- … … 578 780 SUBROUTINE oasis_def_var(k1,cd1,k2,k3,k4,k5,k6,k7) 579 781 CHARACTER(*), INTENT(in ) :: cd1 580 INTEGER , INTENT(in ) :: k2,k3(2),k4,k5( 2,2),k6782 INTEGER , INTENT(in ) :: k2,k3(2),k4,k5(*),k6 581 783 INTEGER , INTENT( out) :: k1,k7 582 784 k1 = -1 ; k7 = -1 … … 598 800 END SUBROUTINE oasis_put 599 801 600 SUBROUTINE oasis_get(k1,k2,p1,k3) 802 SUBROUTINE oasis_get_1d(k1,k2,p1,k3) 803 REAL(wp), DIMENSION(:) , INTENT( out) :: p1 804 INTEGER , INTENT(in ) :: k1,k2 805 INTEGER , INTENT( out) :: k3 806 p1(1) = -1. ; k3 = -1 807 WRITE(numout,*) 'oasis_get_1d: Error you sould not be there...' 808 END SUBROUTINE oasis_get_1d 809 810 SUBROUTINE oasis_get_2d(k1,k2,p1,k3) 601 811 REAL(wp), DIMENSION(:,:), INTENT( out) :: p1 602 812 INTEGER , INTENT(in ) :: k1,k2 603 813 INTEGER , INTENT( out) :: k3 604 814 p1(1,1) = -1. ; k3 = -1 605 WRITE(numout,*) 'oasis_get : Error you sould not be there...'606 END SUBROUTINE oasis_get 815 WRITE(numout,*) 'oasis_get_2d: Error you sould not be there...' 816 END SUBROUTINE oasis_get_2d 607 817 608 818 SUBROUTINE oasis_get_freqs(k1,k5,k2,k3,k4) -
NEMO/branches/UKMO/NEMO_4.0.3_icesheet_and_river_coupling/src/OCE/SBC/sbc_oce.F90
r13587 r13778 137 137 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask !: coupling mask for ln_mixcpl (warning: allocated in sbccpl) 138 138 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: cloud_fra !: cloud cover (fraction of cloud in a gridcell) [-] 139 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: greenland_icesheet_mask 140 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: antarctica_icesheet_mask 139 141 140 142 !!---------------------------------------------------------------------- … … 150 152 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_m !: mean (nn_fsbc time-step) fraction of solar net radiation absorbed in the 1st T level [-] 151 153 154 !!---------------------------------------------------------------------- 155 !! Surface scalars of total ice sheet mass for Greenland and Antarctica, 156 !! passed from atmosphere to be converted to dvol and hence a freshwater 157 !! flux by using old values. New values are saved in the dump, to become 158 !! old values next coupling timestep. Freshwater fluxes split between 159 !! sub iceshelf melting and iceberg calving, scalled to flux per second 160 !!---------------------------------------------------------------------- 161 162 REAL(wp), PUBLIC :: greenland_icesheet_mass, greenland_icesheet_mass_rate_of_change, greenland_icesheet_timelapsed 163 REAL(wp), PUBLIC :: antarctica_icesheet_mass, antarctica_icesheet_mass_rate_of_change, antarctica_icesheet_timelapsed 164 165 ! sbccpl namelist parameters associated with icesheet freshwater input code. Included here rather than in sbccpl.F90 to 166 ! avoid circular dependencies. 167 INTEGER, PUBLIC :: nn_coupled_iceshelf_fluxes ! =0 : total freshwater input from iceberg calving and ice shelf basal melting 168 ! taken from climatologies used (no action in coupling routines). 169 ! =1 : use rate of change of mass of Greenland and Antarctic icesheets to set the 170 ! combined magnitude of the iceberg calving and iceshelf melting freshwater fluxes. 171 ! =2 : specify constant freshwater inputs in this namelist to set the combined 172 ! magnitude of iceberg calving and iceshelf melting freshwater fluxes. 173 LOGICAL, PUBLIC :: ln_iceshelf_init_atmos ! If true force ocean to initialise iceshelf masses from atmospheric values rather 174 ! than values in ocean restart (applicable if nn_coupled_iceshelf_fluxes=1). 175 REAL(wp), PUBLIC :: rn_greenland_total_fw_flux ! Constant total rate of freshwater input (kg/s) for Greenland (if nn_coupled_iceshelf_fluxes=2) 176 REAL(wp), PUBLIC :: rn_greenland_calving_fraction ! Set fraction of total freshwater flux for iceberg calving - remainder goes to iceshelf melting. 177 REAL(wp), PUBLIC :: rn_antarctica_total_fw_flux ! Constant total rate of freshwater input (kg/s) for Antarctica (if nn_coupled_iceshelf_fluxes=2) 178 REAL(wp), PUBLIC :: rn_antarctica_calving_fraction ! Set fraction of total freshwater flux for iceberg calving - remainder goes to iceshelf melting. 179 REAL(wp), PUBLIC :: rn_iceshelf_fluxes_tolerance ! Absolute tolerance for detecting differences in icesheet masses. 180 152 181 !! * Substitutions 153 182 # include "vectopt_loop_substitute.h90" … … 183 212 & ssu_m (jpi,jpj) , sst_m (jpi,jpj) , frq_m(jpi,jpj) , & 184 213 & ssv_m (jpi,jpj) , sss_m (jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) ) 214 ! 215 ALLOCATE( greenland_icesheet_mask(jpi,jpj) , antarctica_icesheet_mask(jpi,jpj) ) 185 216 ! 186 217 ALLOCATE( e3t_m(jpi,jpj) , STAT=ierr(5) ) -
NEMO/branches/UKMO/NEMO_4.0.3_icesheet_and_river_coupling/src/OCE/SBC/sbccpl.F90
r13587 r13778 36 36 USE eosbn2 ! 37 37 USE sbcrnf , ONLY : l_rnfcpl 38 USE cpl_rnf_1d, ONLY: nn_cpl_river, cpl_rnf_1d_init, cpl_rnf_1d_to_2d ! Variables used in 1D river outflow 38 39 USE sbcisf , ONLY : l_isfcpl 39 40 #if defined key_cice … … 120 121 INTEGER, PARAMETER :: jpr_tauwy = 56 ! y component of the ocean stress from waves 121 122 INTEGER, PARAMETER :: jpr_ts_ice = 57 ! Sea ice surface temp 122 123 INTEGER, PARAMETER :: jprcv = 57 ! total number of fields received 123 INTEGER, PARAMETER :: jpr_grnm = 58 ! Greenland ice mass 124 INTEGER, PARAMETER :: jpr_antm = 59 ! Antarctic ice mass 125 INTEGER, PARAMETER :: jpr_rnf_1d = 60 ! 1D river runoff 126 INTEGER, PARAMETER :: jpr_qtr = 61 ! Transmitted solar 127 128 INTEGER, PARAMETER :: jprcv = 61 ! total number of fields received 124 129 125 130 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere … … 186 191 TYPE(FLD_C) :: sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_tauw, sn_rcv_dqnsdt, sn_rcv_qsr, & 187 192 & sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf, sn_rcv_ts_ice 188 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_mslp, sn_rcv_icb, sn_rcv_isf 193 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_mslp, sn_rcv_icb, sn_rcv_isf, & 194 sn_rcv_grnm, sn_rcv_antm 189 195 ! Send to waves 190 196 TYPE(FLD_C) :: sn_snd_ifrac, sn_snd_crtw, sn_snd_wlev … … 271 277 & sn_rcv_iceflx, sn_rcv_co2 , sn_rcv_mslp , & 272 278 & sn_rcv_icb , sn_rcv_isf , sn_rcv_wfreq, sn_rcv_tauw , & 273 & sn_rcv_ts_ice 279 & sn_rcv_ts_ice, sn_rcv_grnm , sn_rcv_antm , & 280 & nn_coupled_iceshelf_fluxes , ln_iceshelf_init_atmos , & 281 & rn_greenland_total_fw_flux , rn_greenland_calving_fraction , & 282 & rn_antarctica_total_fw_flux , rn_antarctica_calving_fraction , & 283 & rn_iceshelf_fluxes_tolerance 284 274 285 !!--------------------------------------------------------------------- 275 286 ! … … 310 321 WRITE(numout,*)' runoffs = ', TRIM(sn_rcv_rnf%cldes ), ' (', TRIM(sn_rcv_rnf%clcat ), ')' 311 322 WRITE(numout,*)' calving = ', TRIM(sn_rcv_cal%cldes ), ' (', TRIM(sn_rcv_cal%clcat ), ')' 323 WRITE(numout,*)' Greenland ice mass = ', TRIM(sn_rcv_grnm%cldes ), ' (', TRIM(sn_rcv_grnm%clcat ), ')' 324 WRITE(numout,*)' Antarctica ice mass = ', TRIM(sn_rcv_antm%cldes ), ' (', TRIM(sn_rcv_antm%clcat ), ')' 312 325 WRITE(numout,*)' iceberg = ', TRIM(sn_rcv_icb%cldes ), ' (', TRIM(sn_rcv_icb%clcat ), ')' 313 326 WRITE(numout,*)' ice shelf = ', TRIM(sn_rcv_isf%cldes ), ' (', TRIM(sn_rcv_isf%clcat ), ')' … … 345 358 WRITE(numout,*)' - orientation = ', sn_snd_crtw%clvor 346 359 WRITE(numout,*)' - mesh = ', sn_snd_crtw%clvgrd 360 WRITE(numout,*)' nn_coupled_iceshelf_fluxes = ', nn_coupled_iceshelf_fluxes 361 WRITE(numout,*)' ln_iceshelf_init_atmos = ', ln_iceshelf_init_atmos 362 WRITE(numout,*)' rn_greenland_total_fw_flux = ', rn_greenland_total_fw_flux 363 WRITE(numout,*)' rn_antarctica_total_fw_flux = ', rn_antarctica_total_fw_flux 364 WRITE(numout,*)' rn_greenland_calving_fraction = ', rn_greenland_calving_fraction 365 WRITE(numout,*)' rn_antarctica_calving_fraction = ', rn_antarctica_calving_fraction 366 WRITE(numout,*)' rn_iceshelf_fluxes_tolerance = ', rn_iceshelf_fluxes_tolerance 347 367 ENDIF 348 368 … … 360 380 361 381 ! default definitions of srcv 362 srcv(:)%laction = .FALSE. ; srcv(:)%clgrid = 'T' ; srcv(:)%nsgn = 1. ; srcv(:)%nct = 1 382 srcv(:)%laction = .FALSE. 383 srcv(:)%clgrid = 'T' 384 srcv(:)%nsgn = 1. 385 srcv(:)%nct = 1 386 srcv(:)%dimensions = 2 363 387 364 388 ! ! ------------------------- ! … … 479 503 ! ! ------------------------- ! 480 504 srcv(jpr_rnf )%clname = 'O_Runoff' 481 IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN 482 srcv(jpr_rnf)%laction = .TRUE. 505 srcv(jpr_rnf_1d )%clname = 'ORunff1D' 506 IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' .OR. TRIM( sn_rcv_rnf%cldes ) == 'coupled1d' ) THEN 507 IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) srcv(jpr_rnf)%laction = .TRUE. 508 IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled1d' ) THEN 509 srcv(jpr_rnf_1d)%laction = .TRUE. 510 srcv(jpr_rnf_1d)%dimensions = 1 ! 1D field passed through coupler 511 END IF 483 512 l_rnfcpl = .TRUE. ! -> no need to read runoffs in sbcrnf 484 513 ln_rnf = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas … … 487 516 ENDIF 488 517 ! 489 srcv(jpr_cal)%clname = 'OCalving' ; IF( TRIM( sn_rcv_cal%cldes) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE. 518 srcv(jpr_cal )%clname = 'OCalving' 519 IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE. 520 521 srcv(jpr_grnm )%clname = 'OGrnmass' 522 IF( TRIM( sn_rcv_grnm%cldes ) == 'coupled' ) THEN 523 srcv(jpr_grnm)%laction = .TRUE. 524 srcv(jpr_grnm)%dimensions = 0 ! Scalar field 525 ENDIF 526 527 srcv(jpr_antm )%clname = 'OAntmass' 528 IF( TRIM( sn_rcv_antm%cldes ) == 'coupled' ) THEN 529 srcv(jpr_antm)%laction = .TRUE. 530 srcv(jpr_antm)%dimensions = 0 ! Scalar field 531 ENDIF 532 490 533 srcv(jpr_isf)%clname = 'OIcshelf' ; IF( TRIM( sn_rcv_isf%cldes) == 'coupled' ) srcv(jpr_isf)%laction = .TRUE. 491 534 srcv(jpr_icb)%clname = 'OIceberg' ; IF( TRIM( sn_rcv_icb%cldes) == 'coupled' ) srcv(jpr_icb)%laction = .TRUE. … … 738 781 ENDIF 739 782 ENDIF 740 741 ! =================================================== !742 ! Allocate all parts of frcv used for received fields !743 ! =================================================== !744 DO jn = 1, jprcv745 IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) )746 END DO747 ! Allocate taum part of frcv which is used even when not received as coupling field748 IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) )749 ! Allocate w10m part of frcv which is used even when not received as coupling field750 IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) )751 ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field752 IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) )753 IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) )754 ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE.755 IF( k_ice /= 0 ) THEN756 IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) )757 IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) )758 END IF759 783 760 784 ! ================================ ! … … 766 790 767 791 ! default definitions of nsnd 768 ssnd(:)%laction = .FALSE. ; ssnd(:)%clgrid = 'T' ; ssnd(:)%nsgn = 1. ; ssnd(:)%nct = 1 792 ssnd(:)%laction = .FALSE. 793 ssnd(:)%clgrid = 'T' 794 ssnd(:)%nsgn = 1. 795 ssnd(:)%nct = 1 796 ssnd(:)%dimensions = 2 769 797 770 798 ! ! ------------------------- ! … … 1049 1077 ENDIF 1050 1078 1079 ! Initialise 1D river outflow scheme 1080 nn_cpl_river = 1 1081 IF ( TRIM( sn_rcv_rnf%cldes ) == 'coupled1d' ) CALL cpl_rnf_1d_init ! Coupled runoff using 1D array 1082 1083 ! =================================================== ! 1084 ! Allocate all parts of frcv used for received fields ! 1085 ! =================================================== ! 1086 DO jn = 1, jprcv 1087 1088 IF ( srcv(jn)%laction ) THEN 1089 SELECT CASE( srcv(jn)%dimensions ) 1090 ! 1091 CASE( 0 ) ! Scalar field 1092 ALLOCATE( frcv(jn)%z3(1,1,1) ) 1093 1094 CASE( 1 ) ! 1D field 1095 ALLOCATE( frcv(jn)%z3(nn_cpl_river,1,1) ) 1096 1097 CASE DEFAULT ! 2D (or pseudo 3D) field. 1098 ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 1099 1100 END SELECT 1101 END IF 1102 1103 END DO 1104 ! Allocate taum part of frcv which is used even when not received as coupling field 1105 IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 1106 ! Allocate w10m part of frcv which is used even when not received as coupling field 1107 IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 1108 ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 1109 IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 1110 IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 1111 ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 1112 IF( k_ice /= 0 ) THEN 1113 IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) ) 1114 IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) ) 1115 END IF 1116 1051 1117 ! 1052 1118 ! ================================ ! … … 1066 1132 ENDIF 1067 1133 xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 ) 1134 ! 1135 IF( nn_coupled_iceshelf_fluxes .gt. 0 ) THEN 1136 ! Crude masks to separate the Antarctic and Greenland icesheets. Obviously something 1137 ! more complicated could be done if required. 1138 greenland_icesheet_mask = 0.0 1139 WHERE( gphit >= 0.0 ) greenland_icesheet_mask = 1.0 1140 antarctica_icesheet_mask = 0.0 1141 WHERE( gphit < 0.0 ) antarctica_icesheet_mask = 1.0 1142 1143 IF( .not. ln_rstart ) THEN 1144 greenland_icesheet_mass = 0.0 1145 greenland_icesheet_mass_rate_of_change = 0.0 1146 greenland_icesheet_timelapsed = 0.0 1147 antarctica_icesheet_mass = 0.0 1148 antarctica_icesheet_mass_rate_of_change = 0.0 1149 antarctica_icesheet_timelapsed = 0.0 1150 ENDIF 1151 1152 ENDIF 1068 1153 ! 1069 1154 END SUBROUTINE sbc_cpl_init … … 1126 1211 REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars 1127 1212 REAL(wp) :: zcoef ! temporary scalar 1213 LOGICAL :: ll_wrtstp ! write diagnostics? 1128 1214 REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3 1129 1215 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 1216 REAL(wp) :: zgreenland_icesheet_mass_in, zantarctica_icesheet_mass_in 1217 REAL(wp) :: zgreenland_icesheet_mass_b, zantarctica_icesheet_mass_b 1218 REAL(wp) :: zmask_sum, zepsilon 1130 1219 REAL(wp) :: zzx, zzy ! temporary variables 1131 1220 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty, zmsk, zemp, zqns, zqsr, zcloud_fra 1132 1221 !!---------------------------------------------------------------------- 1222 ! 1223 ll_wrtstp = (( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend )) .AND. (nn_print>0) 1133 1224 ! 1134 1225 IF( kt == nit000 ) THEN … … 1147 1238 isec = ( kt - nit000 ) * NINT( rdt ) ! date of exchanges 1148 1239 DO jn = 1, jprcv ! received fields sent by the atmosphere 1149 IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) 1240 IF( srcv(jn)%laction ) THEN 1241 1242 IF ( srcv(jn)%dimensions <= 1 ) THEN 1243 CALL cpl_rcv_1d( jn, isec, frcv(jn)%z3, SIZE(frcv(jn)%z3), nrcvinfo(jn) ) 1244 ELSE 1245 CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) 1246 END IF 1247 1248 END IF 1150 1249 END DO 1151 1250 … … 1474 1573 IF( srcv(jpr_fice )%laction ) fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1) 1475 1574 ! 1575 ENDIF 1576 1577 ! ! land ice masses : Greenland 1578 zepsilon = rn_iceshelf_fluxes_tolerance 1579 1580 IF( srcv(jpr_grnm)%laction .AND. nn_coupled_iceshelf_fluxes == 1 ) THEN 1581 1582 ! This is a zero dimensional, single value field. 1583 zgreenland_icesheet_mass_in = frcv(jpr_grnm)%z3(1,1,1) 1584 1585 greenland_icesheet_timelapsed = greenland_icesheet_timelapsed + rdt 1586 1587 IF( ln_iceshelf_init_atmos .AND. kt == 1 ) THEN 1588 ! On the first timestep (of an NRUN) force the ocean to ignore the icesheet masses in the ocean restart 1589 ! and take them from the atmosphere to avoid problems with using inconsistent ocean and atmosphere restarts. 1590 zgreenland_icesheet_mass_b = zgreenland_icesheet_mass_in 1591 greenland_icesheet_mass = zgreenland_icesheet_mass_in 1592 ENDIF 1593 1594 IF( ABS( zgreenland_icesheet_mass_in - greenland_icesheet_mass ) > zepsilon ) THEN 1595 zgreenland_icesheet_mass_b = greenland_icesheet_mass 1596 1597 ! Only update the mass if it has increased. 1598 IF ( (zgreenland_icesheet_mass_in - greenland_icesheet_mass) > 0.0 ) THEN 1599 greenland_icesheet_mass = zgreenland_icesheet_mass_in 1600 ENDIF 1601 1602 IF( zgreenland_icesheet_mass_b /= 0.0 ) & 1603 & greenland_icesheet_mass_rate_of_change = ( greenland_icesheet_mass - zgreenland_icesheet_mass_b ) / greenland_icesheet_timelapsed 1604 greenland_icesheet_timelapsed = 0.0_wp 1605 ENDIF 1606 IF(lwp .AND. ll_wrtstp) THEN 1607 WRITE(numout,*) 'Greenland icesheet mass (kg) read in is ', zgreenland_icesheet_mass_in 1608 WRITE(numout,*) 'Greenland icesheet mass (kg) used is ', greenland_icesheet_mass 1609 WRITE(numout,*) 'Greenland icesheet mass rate of change (kg/s) is ', greenland_icesheet_mass_rate_of_change 1610 WRITE(numout,*) 'Greenland icesheet seconds lapsed since last change is ', greenland_icesheet_timelapsed 1611 ENDIF 1612 ELSE IF ( nn_coupled_iceshelf_fluxes == 2 ) THEN 1613 greenland_icesheet_mass_rate_of_change = rn_greenland_total_fw_flux 1614 ENDIF 1615 1616 ! ! land ice masses : Antarctica 1617 IF( srcv(jpr_antm)%laction .AND. nn_coupled_iceshelf_fluxes == 1 ) THEN 1618 1619 ! This is a zero dimensional, single value field. 1620 zantarctica_icesheet_mass_in = frcv(jpr_antm)%z3(1,1,1) 1621 1622 antarctica_icesheet_timelapsed = antarctica_icesheet_timelapsed + rdt 1623 1624 IF( ln_iceshelf_init_atmos .AND. kt == 1 ) THEN 1625 ! On the first timestep (of an NRUN) force the ocean to ignore the icesheet masses in the ocean restart 1626 ! and take them from the atmosphere to avoid problems with using inconsistent ocean and atmosphere restarts. 1627 zantarctica_icesheet_mass_b = zantarctica_icesheet_mass_in 1628 antarctica_icesheet_mass = zantarctica_icesheet_mass_in 1629 ENDIF 1630 1631 IF( ABS( zantarctica_icesheet_mass_in - antarctica_icesheet_mass ) > zepsilon ) THEN 1632 zantarctica_icesheet_mass_b = antarctica_icesheet_mass 1633 1634 ! Only update the mass if it has increased. 1635 IF ( (zantarctica_icesheet_mass_in - antarctica_icesheet_mass) > 0.0 ) THEN 1636 antarctica_icesheet_mass = zantarctica_icesheet_mass_in 1637 END IF 1638 1639 IF( zantarctica_icesheet_mass_b /= 0.0 ) & 1640 & antarctica_icesheet_mass_rate_of_change = ( antarctica_icesheet_mass - zantarctica_icesheet_mass_b ) / antarctica_icesheet_timelapsed 1641 antarctica_icesheet_timelapsed = 0.0_wp 1642 ENDIF 1643 IF(lwp .AND. ll_wrtstp) THEN 1644 WRITE(numout,*) 'Antarctica icesheet mass (kg) read in is ', zantarctica_icesheet_mass_in 1645 WRITE(numout,*) 'Antarctica icesheet mass (kg) used is ', antarctica_icesheet_mass 1646 WRITE(numout,*) 'Antarctica icesheet mass rate of change (kg/s) is ', antarctica_icesheet_mass_rate_of_change 1647 WRITE(numout,*) 'Antarctica icesheet seconds lapsed since last change is ', antarctica_icesheet_timelapsed 1648 ENDIF 1649 ELSE IF ( nn_coupled_iceshelf_fluxes == 2 ) THEN 1650 antarctica_icesheet_mass_rate_of_change = rn_antarctica_total_fw_flux 1476 1651 ENDIF 1477 1652 ! … … 1746 1921 1747 1922 ! --- Continental fluxes --- ! 1748 IF( srcv(jpr_rnf)%laction ) THEN ! runoffs (included in emp later on)1923 IF( srcv(jpr_rnf)%laction ) THEN ! 2D runoffs (included in emp later on) 1749 1924 rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1925 ENDIF 1926 IF( srcv(jpr_rnf_1d)%laction ) THEN ! 1D runoff 1927 CALL cpl_rnf_1d_to_2d(frcv(jpr_rnf_1d)%z3(:,:,:)) 1750 1928 ENDIF 1751 1929 IF( srcv(jpr_cal)%laction ) THEN ! calving (put in emp_tot and emp_oce) … … 1786 1964 zsnw(:,:) = picefr(:,:) 1787 1965 ! --- Continental fluxes --- ! 1788 IF( srcv(jpr_rnf)%laction ) THEN ! runoffs (included in emp later on)1966 IF( srcv(jpr_rnf)%laction ) THEN ! 2D runoffs (included in emp later on) 1789 1967 rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1968 ENDIF 1969 IF( srcv(jpr_rnf_1d)%laction ) THEN ! 1D runoff 1970 CALL cpl_rnf_1d_to_2d(frcv(jpr_rnf_1d)%z3(:,:,:)) 1790 1971 ENDIF 1791 1972 IF( srcv(jpr_cal)%laction ) THEN ! calving (put in emp_tot) -
NEMO/branches/UKMO/NEMO_4.0.3_icesheet_and_river_coupling/src/OCE/SBC/sbcisf.F90
r13587 r13778 92 92 INTEGER :: ji, jj, jk ! loop index 93 93 INTEGER :: ikt, ikb ! local integers 94 REAL(wp) :: zgreenland_fwfisf_sum, zantarctica_fwfisf_sum 94 95 REAL(wp), DIMENSION(jpi,jpj) :: zt_frz, zdep ! freezing temperature (zt_frz) at depth (zdep) 95 96 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: zqhcisf2d 96 97 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zfwfisf3d, zqhcisf3d, zqlatisf3d 98 LOGICAL :: ll_wrtstp 97 99 !!--------------------------------------------------------------------- 98 100 ! 101 ll_wrtstp = (( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend )) .AND. (nn_print>0) 99 102 IF( MOD( kt-1, nn_fsbc) == 0 ) THEN ! compute salt and heat flux 100 103 ! … … 127 130 fwfisf(:,:) = - sf_rnfisf(1)%fnow(:,:,1) ! fresh water flux from the isf (fwfisf <0 mean melting) 128 131 ENDIF 132 133 IF( lk_oasis) THEN 134 ! nn_coupled_iceshelf_fluxes uninitialised unless lk_oasis=true 135 IF( nn_coupled_iceshelf_fluxes .gt. 0 ) THEN 136 137 ! Adjust total iceshelf melt rates so that sum of iceberg calving and iceshelf melting in the northern 138 ! and southern hemispheres equals rate of increase of mass of greenland and antarctic ice sheets 139 ! to preserve total freshwater conservation in coupled models without an active ice sheet model. 140 141 ! All related global sums must be done bit reproducibly 142 zgreenland_fwfisf_sum = glob_sum( 'sbcisf', fwfisf(:,:) * e1t(:,:) * e2t(:,:) * greenland_icesheet_mask(:,:) ) 143 144 ! use ABS function because we need to preserve the sign of fwfisf 145 WHERE( greenland_icesheet_mask(:,:) == 1.0 ) & 146 & fwfisf(:,:) = fwfisf(:,:) * ABS( greenland_icesheet_mass_rate_of_change * (1.0-rn_greenland_calving_fraction) & 147 & / ( zgreenland_fwfisf_sum + 1.0e-10_wp ) ) 148 149 ! check 150 IF(lwp .AND. ll_wrtstp) WRITE(numout, *) 'Greenland iceshelf melting climatology (kg/s) : ',zgreenland_fwfisf_sum 151 152 zgreenland_fwfisf_sum = glob_sum( 'sbcisf', fwfisf(:,:) * e1t(:,:) * e2t(:,:) * greenland_icesheet_mask(:,:) ) 153 154 IF(lwp .AND. ll_wrtstp) WRITE(numout, *) 'Greenland iceshelf melting adjusted value (kg/s) : ',zgreenland_fwfisf_sum 155 156 zantarctica_fwfisf_sum = glob_sum( 'sbcisf', fwfisf(:,:) * e1t(:,:) * e2t(:,:) * antarctica_icesheet_mask(:,:) ) 157 158 ! use ABS function because we need to preserve the sign of fwfisf 159 WHERE( antarctica_icesheet_mask(:,:) == 1.0 ) & 160 & fwfisf(:,:) = fwfisf(:,:) * ABS( antarctica_icesheet_mass_rate_of_change * (1.0-rn_antarctica_calving_fraction) & 161 & / ( zantarctica_fwfisf_sum + 1.0e-10_wp ) ) 162 163 ! check 164 IF(lwp .AND. ll_wrtstp) WRITE(numout, *) 'Antarctica iceshelf melting climatology (kg/s) : ',zantarctica_fwfisf_sum 165 166 zantarctica_fwfisf_sum = glob_sum( 'sbcisf', fwfisf(:,:) * e1t(:,:) * e2t(:,:) * antarctica_icesheet_mask(:,:) ) 167 168 IF(lwp .AND. ll_wrtstp) WRITE(numout, *) 'Antarctica iceshelf melting adjusted value (kg/s) : ',zantarctica_fwfisf_sum 169 170 ENDIF 171 ENDIF 172 129 173 qisf(:,:) = fwfisf(:,:) * rLfusisf ! heat flux 130 174 stbl(:,:) = soce … … 137 181 fwfisf(:,:) = -sf_fwfisf(1)%fnow(:,:,1) ! fwf 138 182 ENDIF 183 184 IF( lk_oasis) THEN 185 ! nn_coupled_iceshelf_fluxes uninitialised unless lk_oasis=true 186 IF( nn_coupled_iceshelf_fluxes .gt. 0 ) THEN 187 188 ! Adjust total iceshelf melt rates so that sum of iceberg calving and iceshelf melting in the northern 189 ! and southern hemispheres equals rate of increase of mass of greenland and antarctic ice sheets 190 ! to preserve total freshwater conservation in coupled models without an active ice sheet model. 191 192 ! All related global sums must be done bit reproducibly 193 zgreenland_fwfisf_sum = glob_sum( 'sbcisf', fwfisf(:,:) * e1t(:,:) * e2t(:,:) * greenland_icesheet_mask(:,:) ) 194 195 ! use ABS function because we need to preserve the sign of fwfisf 196 WHERE( greenland_icesheet_mask(:,:) == 1.0 ) & 197 & fwfisf(:,:) = fwfisf(:,:) * ABS( greenland_icesheet_mass_rate_of_change * (1.0-rn_greenland_calving_fraction) & 198 & / ( zgreenland_fwfisf_sum + 1.0e-10_wp ) ) 199 200 ! check 201 IF(lwp .AND. ll_wrtstp) WRITE(numout, *) 'Greenland iceshelf melting climatology (kg/s) : ',zgreenland_fwfisf_sum 202 203 zgreenland_fwfisf_sum = glob_sum( 'sbcisf', fwfisf(:,:) * e1t(:,:) * e2t(:,:) * greenland_icesheet_mask(:,:) ) 204 205 IF(lwp .AND. ll_wrtstp) WRITE(numout, *) 'Greenland iceshelf melting adjusted value (kg/s) : ',zgreenland_fwfisf_sum 206 207 zantarctica_fwfisf_sum = glob_sum( 'sbcisf', fwfisf(:,:) * e1t(:,:) * e2t(:,:) * antarctica_icesheet_mask(:,:) ) 208 209 ! use ABS function because we need to preserve the sign of fwfisf 210 WHERE( antarctica_icesheet_mask(:,:) == 1.0 ) & 211 & fwfisf(:,:) = fwfisf(:,:) * ABS( antarctica_icesheet_mass_rate_of_change * (1.0-rn_antarctica_calving_fraction) & 212 & / ( zantarctica_fwfisf_sum + 1.0e-10_wp ) ) 213 214 ! check 215 IF(lwp .AND. ll_wrtstp) WRITE(numout, *) 'Antarctica iceshelf melting climatology (kg/s) : ',zantarctica_fwfisf_sum 216 217 zantarctica_fwfisf_sum = glob_sum( 'sbcisf', fwfisf(:,:) * e1t(:,:) * e2t(:,:) * antarctica_icesheet_mask(:,:) ) 218 219 IF(lwp .AND. ll_wrtstp) WRITE(numout, *) 'Antarctica iceshelf melting adjusted value (kg/s) : ',zantarctica_fwfisf_sum 220 221 ENDIF 222 ENDIF 223 139 224 qisf(:,:) = fwfisf(:,:) * rLfusisf ! heat flux 140 225 stbl(:,:) = soce
Note: See TracChangeset
for help on using the changeset viewer.
