Changeset 14299
- Timestamp:
- 2021-01-13T17:30:46+01:00 (3 years ago)
- Location:
- NEMO/branches/UKMO/NEMO_4.0.4_icesheet_and_river_coupling
- Files:
-
- 8 edited
- 1 copied
-
cfgs/SHARED/field_def_nemo-oce.xml (modified) (1 diff)
-
cfgs/SHARED/namelist_ref (modified) (2 diffs)
-
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.3_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.4_icesheet_and_river_coupling/cfgs/SHARED/field_def_nemo-oce.xml
r13648 r14299 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.4_icesheet_and_river_coupling/cfgs/SHARED/namelist_ref
r14075 r14299 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 ! … … 318 332 sn_rcv_emp = 'conservative' , 'no' , '' , '' , '' 319 333 sn_rcv_rnf = 'coupled' , 'no' , '' , '' , '' 334 sn_rcv_antm = 'none' , 'no' , '' , '' , '' 335 sn_rcv_grnm = 'none' , 'no' , '' , '' , '' 320 336 sn_rcv_cal = 'coupled' , 'no' , '' , '' , '' 321 337 sn_rcv_co2 = 'coupled' , 'no' , '' , '' , '' -
NEMO/branches/UKMO/NEMO_4.0.4_icesheet_and_river_coupling/src/OCE/ICB/icbclv.F90
r14075 r14299 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.4_icesheet_and_river_coupling/src/OCE/IOM/restart.F90
r14075 r14299 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.4_icesheet_and_river_coupling/src/OCE/SBC/cpl_oasis3.F90
r14075 r14299 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.4_icesheet_and_river_coupling/src/OCE/SBC/sbc_oce.F90
r14075 r14299 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.4_icesheet_and_river_coupling/src/OCE/SBC/sbccpl.F90
r14075 r14299 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 … … 277 283 & sn_rcv_iceflx, sn_rcv_co2 , sn_rcv_mslp , & 278 284 & sn_rcv_icb , sn_rcv_isf , sn_rcv_wfreq, sn_rcv_tauw , & 279 & sn_rcv_ts_ice 285 & sn_rcv_ts_ice, sn_rcv_grnm , sn_rcv_antm , & 286 & nn_coupled_iceshelf_fluxes , ln_iceshelf_init_atmos , & 287 & rn_greenland_total_fw_flux , rn_greenland_calving_fraction , & 288 & rn_antarctica_total_fw_flux , rn_antarctica_calving_fraction , & 289 & rn_iceshelf_fluxes_tolerance 290 280 291 !!--------------------------------------------------------------------- 281 292 ! … … 316 327 WRITE(numout,*)' runoffs = ', TRIM(sn_rcv_rnf%cldes ), ' (', TRIM(sn_rcv_rnf%clcat ), ')' 317 328 WRITE(numout,*)' calving = ', TRIM(sn_rcv_cal%cldes ), ' (', TRIM(sn_rcv_cal%clcat ), ')' 329 WRITE(numout,*)' Greenland ice mass = ', TRIM(sn_rcv_grnm%cldes ), ' (', TRIM(sn_rcv_grnm%clcat ), ')' 330 WRITE(numout,*)' Antarctica ice mass = ', TRIM(sn_rcv_antm%cldes ), ' (', TRIM(sn_rcv_antm%clcat ), ')' 318 331 WRITE(numout,*)' iceberg = ', TRIM(sn_rcv_icb%cldes ), ' (', TRIM(sn_rcv_icb%clcat ), ')' 319 332 WRITE(numout,*)' ice shelf = ', TRIM(sn_rcv_isf%cldes ), ' (', TRIM(sn_rcv_isf%clcat ), ')' … … 351 364 WRITE(numout,*)' - orientation = ', sn_snd_crtw%clvor 352 365 WRITE(numout,*)' - mesh = ', sn_snd_crtw%clvgrd 366 WRITE(numout,*)' nn_coupled_iceshelf_fluxes = ', nn_coupled_iceshelf_fluxes 367 WRITE(numout,*)' ln_iceshelf_init_atmos = ', ln_iceshelf_init_atmos 368 WRITE(numout,*)' rn_greenland_total_fw_flux = ', rn_greenland_total_fw_flux 369 WRITE(numout,*)' rn_antarctica_total_fw_flux = ', rn_antarctica_total_fw_flux 370 WRITE(numout,*)' rn_greenland_calving_fraction = ', rn_greenland_calving_fraction 371 WRITE(numout,*)' rn_antarctica_calving_fraction = ', rn_antarctica_calving_fraction 372 WRITE(numout,*)' rn_iceshelf_fluxes_tolerance = ', rn_iceshelf_fluxes_tolerance 353 373 ENDIF 354 374 … … 366 386 367 387 ! default definitions of srcv 368 srcv(:)%laction = .FALSE. ; srcv(:)%clgrid = 'T' ; srcv(:)%nsgn = 1. ; srcv(:)%nct = 1 388 srcv(:)%laction = .FALSE. 389 srcv(:)%clgrid = 'T' 390 srcv(:)%nsgn = 1. 391 srcv(:)%nct = 1 392 srcv(:)%dimensions = 2 369 393 370 394 ! ! ------------------------- ! … … 485 509 ! ! ------------------------- ! 486 510 srcv(jpr_rnf )%clname = 'O_Runoff' 487 IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN 488 srcv(jpr_rnf)%laction = .TRUE. 511 srcv(jpr_rnf_1d )%clname = 'ORunff1D' 512 IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' .OR. TRIM( sn_rcv_rnf%cldes ) == 'coupled1d' ) THEN 513 IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) srcv(jpr_rnf)%laction = .TRUE. 514 IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled1d' ) THEN 515 srcv(jpr_rnf_1d)%laction = .TRUE. 516 srcv(jpr_rnf_1d)%dimensions = 1 ! 1D field passed through coupler 517 END IF 489 518 l_rnfcpl = .TRUE. ! -> no need to read runoffs in sbcrnf 490 519 ln_rnf = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas … … 493 522 ENDIF 494 523 ! 495 srcv(jpr_cal)%clname = 'OCalving' ; IF( TRIM( sn_rcv_cal%cldes) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE. 524 srcv(jpr_cal )%clname = 'OCalving' 525 IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE. 526 527 srcv(jpr_grnm )%clname = 'OGrnmass' 528 IF( TRIM( sn_rcv_grnm%cldes ) == 'coupled' ) THEN 529 srcv(jpr_grnm)%laction = .TRUE. 530 srcv(jpr_grnm)%dimensions = 0 ! Scalar field 531 ENDIF 532 533 srcv(jpr_antm )%clname = 'OAntmass' 534 IF( TRIM( sn_rcv_antm%cldes ) == 'coupled' ) THEN 535 srcv(jpr_antm)%laction = .TRUE. 536 srcv(jpr_antm)%dimensions = 0 ! Scalar field 537 ENDIF 538 496 539 srcv(jpr_isf)%clname = 'OIcshelf' ; IF( TRIM( sn_rcv_isf%cldes) == 'coupled' ) srcv(jpr_isf)%laction = .TRUE. 497 540 srcv(jpr_icb)%clname = 'OIceberg' ; IF( TRIM( sn_rcv_icb%cldes) == 'coupled' ) srcv(jpr_icb)%laction = .TRUE. … … 744 787 ENDIF 745 788 ENDIF 746 747 ! =================================================== !748 ! Allocate all parts of frcv used for received fields !749 ! =================================================== !750 DO jn = 1, jprcv751 IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) )752 END DO753 ! Allocate taum part of frcv which is used even when not received as coupling field754 IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) )755 ! Allocate w10m part of frcv which is used even when not received as coupling field756 IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) )757 ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field758 IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) )759 IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) )760 ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE.761 IF( k_ice /= 0 ) THEN762 IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) )763 IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) )764 END IF765 789 766 790 ! ================================ ! … … 772 796 773 797 ! default definitions of nsnd 774 ssnd(:)%laction = .FALSE. ; ssnd(:)%clgrid = 'T' ; ssnd(:)%nsgn = 1. ; ssnd(:)%nct = 1 798 ssnd(:)%laction = .FALSE. 799 ssnd(:)%clgrid = 'T' 800 ssnd(:)%nsgn = 1. 801 ssnd(:)%nct = 1 802 ssnd(:)%dimensions = 2 775 803 776 804 ! ! ------------------------- ! … … 1055 1083 ENDIF 1056 1084 1085 ! Initialise 1D river outflow scheme 1086 nn_cpl_river = 1 1087 IF ( TRIM( sn_rcv_rnf%cldes ) == 'coupled1d' ) CALL cpl_rnf_1d_init ! Coupled runoff using 1D array 1088 1089 ! =================================================== ! 1090 ! Allocate all parts of frcv used for received fields ! 1091 ! =================================================== ! 1092 DO jn = 1, jprcv 1093 1094 IF ( srcv(jn)%laction ) THEN 1095 SELECT CASE( srcv(jn)%dimensions ) 1096 ! 1097 CASE( 0 ) ! Scalar field 1098 ALLOCATE( frcv(jn)%z3(1,1,1) ) 1099 1100 CASE( 1 ) ! 1D field 1101 ALLOCATE( frcv(jn)%z3(nn_cpl_river,1,1) ) 1102 1103 CASE DEFAULT ! 2D (or pseudo 3D) field. 1104 ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 1105 1106 END SELECT 1107 END IF 1108 1109 END DO 1110 ! Allocate taum part of frcv which is used even when not received as coupling field 1111 IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 1112 ! Allocate w10m part of frcv which is used even when not received as coupling field 1113 IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 1114 ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 1115 IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 1116 IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 1117 ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 1118 IF( k_ice /= 0 ) THEN 1119 IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) ) 1120 IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) ) 1121 END IF 1122 1057 1123 ! 1058 1124 ! ================================ ! … … 1072 1138 ENDIF 1073 1139 xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 ) 1140 ! 1141 IF( nn_coupled_iceshelf_fluxes .gt. 0 ) THEN 1142 ! Crude masks to separate the Antarctic and Greenland icesheets. Obviously something 1143 ! more complicated could be done if required. 1144 greenland_icesheet_mask = 0.0 1145 WHERE( gphit >= 0.0 ) greenland_icesheet_mask = 1.0 1146 antarctica_icesheet_mask = 0.0 1147 WHERE( gphit < 0.0 ) antarctica_icesheet_mask = 1.0 1148 1149 IF( .not. ln_rstart ) THEN 1150 greenland_icesheet_mass = 0.0 1151 greenland_icesheet_mass_rate_of_change = 0.0 1152 greenland_icesheet_timelapsed = 0.0 1153 antarctica_icesheet_mass = 0.0 1154 antarctica_icesheet_mass_rate_of_change = 0.0 1155 antarctica_icesheet_timelapsed = 0.0 1156 ENDIF 1157 1158 ENDIF 1074 1159 ! 1075 1160 END SUBROUTINE sbc_cpl_init … … 1132 1217 REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars 1133 1218 REAL(wp) :: zcoef ! temporary scalar 1219 LOGICAL :: ll_wrtstp ! write diagnostics? 1134 1220 REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3 1135 1221 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 1222 REAL(wp) :: zgreenland_icesheet_mass_in, zantarctica_icesheet_mass_in 1223 REAL(wp) :: zgreenland_icesheet_mass_b, zantarctica_icesheet_mass_b 1224 REAL(wp) :: zmask_sum, zepsilon 1136 1225 REAL(wp) :: zzx, zzy ! temporary variables 1137 1226 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty, zmsk, zemp, zqns, zqsr, zcloud_fra 1138 1227 !!---------------------------------------------------------------------- 1228 ! 1229 ll_wrtstp = (( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend )) .AND. (nn_print>0) 1139 1230 ! 1140 1231 IF( kt == nit000 ) THEN … … 1153 1244 isec = ( kt - nit000 ) * NINT( rdt ) ! date of exchanges 1154 1245 DO jn = 1, jprcv ! received fields sent by the atmosphere 1155 IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) 1246 IF( srcv(jn)%laction ) THEN 1247 1248 IF ( srcv(jn)%dimensions <= 1 ) THEN 1249 CALL cpl_rcv_1d( jn, isec, frcv(jn)%z3, SIZE(frcv(jn)%z3), nrcvinfo(jn) ) 1250 ELSE 1251 CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) 1252 END IF 1253 1254 END IF 1156 1255 END DO 1157 1256 … … 1480 1579 IF( srcv(jpr_fice )%laction ) fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1) 1481 1580 ! 1581 ENDIF 1582 1583 ! ! land ice masses : Greenland 1584 zepsilon = rn_iceshelf_fluxes_tolerance 1585 1586 IF( srcv(jpr_grnm)%laction .AND. nn_coupled_iceshelf_fluxes == 1 ) THEN 1587 1588 ! This is a zero dimensional, single value field. 1589 zgreenland_icesheet_mass_in = frcv(jpr_grnm)%z3(1,1,1) 1590 1591 greenland_icesheet_timelapsed = greenland_icesheet_timelapsed + rdt 1592 1593 IF( ln_iceshelf_init_atmos .AND. kt == 1 ) THEN 1594 ! On the first timestep (of an NRUN) force the ocean to ignore the icesheet masses in the ocean restart 1595 ! and take them from the atmosphere to avoid problems with using inconsistent ocean and atmosphere restarts. 1596 zgreenland_icesheet_mass_b = zgreenland_icesheet_mass_in 1597 greenland_icesheet_mass = zgreenland_icesheet_mass_in 1598 ENDIF 1599 1600 IF( ABS( zgreenland_icesheet_mass_in - greenland_icesheet_mass ) > zepsilon ) THEN 1601 zgreenland_icesheet_mass_b = greenland_icesheet_mass 1602 1603 ! Only update the mass if it has increased. 1604 IF ( (zgreenland_icesheet_mass_in - greenland_icesheet_mass) > 0.0 ) THEN 1605 greenland_icesheet_mass = zgreenland_icesheet_mass_in 1606 ENDIF 1607 1608 IF( zgreenland_icesheet_mass_b /= 0.0 ) & 1609 & greenland_icesheet_mass_rate_of_change = ( greenland_icesheet_mass - zgreenland_icesheet_mass_b ) / greenland_icesheet_timelapsed 1610 greenland_icesheet_timelapsed = 0.0_wp 1611 ENDIF 1612 IF(lwp .AND. ll_wrtstp) THEN 1613 WRITE(numout,*) 'Greenland icesheet mass (kg) read in is ', zgreenland_icesheet_mass_in 1614 WRITE(numout,*) 'Greenland icesheet mass (kg) used is ', greenland_icesheet_mass 1615 WRITE(numout,*) 'Greenland icesheet mass rate of change (kg/s) is ', greenland_icesheet_mass_rate_of_change 1616 WRITE(numout,*) 'Greenland icesheet seconds lapsed since last change is ', greenland_icesheet_timelapsed 1617 ENDIF 1618 ELSE IF ( nn_coupled_iceshelf_fluxes == 2 ) THEN 1619 greenland_icesheet_mass_rate_of_change = rn_greenland_total_fw_flux 1620 ENDIF 1621 1622 ! ! land ice masses : Antarctica 1623 IF( srcv(jpr_antm)%laction .AND. nn_coupled_iceshelf_fluxes == 1 ) THEN 1624 1625 ! This is a zero dimensional, single value field. 1626 zantarctica_icesheet_mass_in = frcv(jpr_antm)%z3(1,1,1) 1627 1628 antarctica_icesheet_timelapsed = antarctica_icesheet_timelapsed + rdt 1629 1630 IF( ln_iceshelf_init_atmos .AND. kt == 1 ) THEN 1631 ! On the first timestep (of an NRUN) force the ocean to ignore the icesheet masses in the ocean restart 1632 ! and take them from the atmosphere to avoid problems with using inconsistent ocean and atmosphere restarts. 1633 zantarctica_icesheet_mass_b = zantarctica_icesheet_mass_in 1634 antarctica_icesheet_mass = zantarctica_icesheet_mass_in 1635 ENDIF 1636 1637 IF( ABS( zantarctica_icesheet_mass_in - antarctica_icesheet_mass ) > zepsilon ) THEN 1638 zantarctica_icesheet_mass_b = antarctica_icesheet_mass 1639 1640 ! Only update the mass if it has increased. 1641 IF ( (zantarctica_icesheet_mass_in - antarctica_icesheet_mass) > 0.0 ) THEN 1642 antarctica_icesheet_mass = zantarctica_icesheet_mass_in 1643 END IF 1644 1645 IF( zantarctica_icesheet_mass_b /= 0.0 ) & 1646 & antarctica_icesheet_mass_rate_of_change = ( antarctica_icesheet_mass - zantarctica_icesheet_mass_b ) / antarctica_icesheet_timelapsed 1647 antarctica_icesheet_timelapsed = 0.0_wp 1648 ENDIF 1649 IF(lwp .AND. ll_wrtstp) THEN 1650 WRITE(numout,*) 'Antarctica icesheet mass (kg) read in is ', zantarctica_icesheet_mass_in 1651 WRITE(numout,*) 'Antarctica icesheet mass (kg) used is ', antarctica_icesheet_mass 1652 WRITE(numout,*) 'Antarctica icesheet mass rate of change (kg/s) is ', antarctica_icesheet_mass_rate_of_change 1653 WRITE(numout,*) 'Antarctica icesheet seconds lapsed since last change is ', antarctica_icesheet_timelapsed 1654 ENDIF 1655 ELSE IF ( nn_coupled_iceshelf_fluxes == 2 ) THEN 1656 antarctica_icesheet_mass_rate_of_change = rn_antarctica_total_fw_flux 1482 1657 ENDIF 1483 1658 ! … … 1752 1927 1753 1928 ! --- Continental fluxes --- ! 1754 IF( srcv(jpr_rnf)%laction ) THEN ! runoffs (included in emp later on)1929 IF( srcv(jpr_rnf)%laction ) THEN ! 2D runoffs (included in emp later on) 1755 1930 rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1931 ENDIF 1932 IF( srcv(jpr_rnf_1d)%laction ) THEN ! 1D runoff 1933 CALL cpl_rnf_1d_to_2d(frcv(jpr_rnf_1d)%z3(:,:,:)) 1756 1934 ENDIF 1757 1935 IF( srcv(jpr_cal)%laction ) THEN ! calving (put in emp_tot and emp_oce) … … 1792 1970 zsnw(:,:) = picefr(:,:) 1793 1971 ! --- Continental fluxes --- ! 1794 IF( srcv(jpr_rnf)%laction ) THEN ! runoffs (included in emp later on)1972 IF( srcv(jpr_rnf)%laction ) THEN ! 2D runoffs (included in emp later on) 1795 1973 rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1974 ENDIF 1975 IF( srcv(jpr_rnf_1d)%laction ) THEN ! 1D runoff 1976 CALL cpl_rnf_1d_to_2d(frcv(jpr_rnf_1d)%z3(:,:,:)) 1796 1977 ENDIF 1797 1978 IF( srcv(jpr_cal)%laction ) THEN ! calving (put in emp_tot) -
NEMO/branches/UKMO/NEMO_4.0.4_icesheet_and_river_coupling/src/OCE/SBC/sbcisf.F90
r14075 r14299 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.
