Changeset 15662
- Timestamp:
- 2022-01-19T19:47:22+01:00 (3 years ago)
- Location:
- NEMO/branches/UKMO/NEMO_4.0.4_GO8_paquage_branch
- Files:
-
- 10 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO_4.0.4_GO8_paquage_branch/cfgs/SHARED/field_def_nemo-oce.xml
r15660 r15662 332 332 333 333 <!-- * variable related to ice shelf forcing * --> 334 <field id="berg_calve" long_name="Iceberg calving" unit="kg/m2/s" /> 334 335 <field id="fwfisf" long_name="Ice shelf melting" unit="kg/m2/s" /> 335 336 <field id="fwfisf3d" long_name="Ice shelf melting" unit="kg/m2/s" grid_ref="grid_T_3D" /> -
NEMO/branches/UKMO/NEMO_4.0.4_GO8_paquage_branch/cfgs/SHARED/namelist_ref
r15661 r15662 293 293 ln_scale_ice_flux = .false. ! use ice fluxes that are already "ice weighted" ( i.e. multiplied ice concentration) 294 294 nn_cats_cpl = 5 ! Number of sea ice categories over which coupling is to be carried out (if not 1) 295 nn_coupled_iceshelf_fluxes = 0 ! =0 : total freshwater input from iceberg calving and ice shelf basal melting 296 ! taken from climatologies used (no action in coupling routines). 297 ! =1 : use rate of change of mass of Greenland and Antarctic icesheets to set the 298 ! combined magnitude of the iceberg calving and iceshelf melting freshwater fluxes. 299 ! =2 : specify constant freshwater inputs in this namelist to set the combined 300 ! magnitude of iceberg calving and iceshelf melting freshwater fluxes. 301 ln_iceshelf_init_atmos = .true. ! If true force ocean to initialise icesheet masses from atmospheric values rather than 302 ! from values in ocean restart file. 303 rn_greenland_total_fw_flux = 0.0 ! Constant total rate of freshwater input (kg/s) for Greenland (if nn_coupled_iceshelf_fluxes=2) 304 rn_greenland_calving_fraction = 0.5 ! Set fraction of total freshwater flux for iceberg calving - remainder goes to iceshelf melting. 305 rn_antarctica_total_fw_flux = 0.0 ! Constant total rate of freshwater input (kg/s) for Antarctica (if nn_coupled_iceshelf_fluxes=2) 306 rn_antarctica_calving_fraction = 0.5 ! Set fraction of total freshwater flux for iceberg calving - remainder goes to iceshelf melting. 307 rn_iceshelf_fluxes_tolerance = 1e-6 ! Fractional threshold for detecting differences in icesheet masses (must be positive definite). 308 295 309 !_____________!__________________________!____________!_____________!______________________!________! 296 310 ! ! description ! multiple ! vector ! vector ! vector ! … … 319 333 sn_rcv_emp = 'conservative' , 'no' , '' , '' , '' 320 334 sn_rcv_rnf = 'coupled' , 'no' , '' , '' , '' 335 sn_rcv_antm = 'none' , 'no' , '' , '' , '' 336 sn_rcv_grnm = 'none' , 'no' , '' , '' , '' 321 337 sn_rcv_cal = 'coupled' , 'no' , '' , '' , '' 322 338 sn_rcv_co2 = 'coupled' , 'no' , '' , '' , '' … … 419 435 rn_dep_max = 150. ! depth over which runoffs is spread ( ln_rnf_depth_ini = .true ) 420 436 nn_rnf_depth_file = 0 ! create (=1) a runoff depth file or not (=0) 421 ln_rnf_icb = .false. ! read in iceberg flux from a file (fill sn_i_rnf if .true.) 437 ln_rnf_icb = .false. ! read in iceberg flux from a file (fill sn_i_rnf if .true.) 438 ln_icb_mass = .false. ! Scale iceberg flux to match mass flux from atmosphere model 422 439 423 440 cn_dir = './' ! root directory for the runoff data location -
NEMO/branches/UKMO/NEMO_4.0.4_GO8_paquage_branch/src/OCE/ICB/icbclv.F90
r14075 r15662 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_GO8_paquage_branch/src/OCE/IOM/iom.F90
r15658 r15662 47 47 USE lib_fortran 48 48 USE diurnal_bulk, ONLY : ln_diurnal_only, ln_diurnal 49 USE timing 49 50 50 51 IMPLICIT NONE … … 1532 1533 LOGICAL :: llx ! local xios write flag 1533 1534 INTEGER :: ivid ! variable id 1535 1536 IF (ln_timing) CALL timing_start('iom_rst_put') 1534 1537 1535 1538 llx = .FALSE. … … 1550 1553 ENDIF 1551 1554 ENDIF 1555 IF (ln_timing) CALL timing_stop('iom_rst_put') 1552 1556 END SUBROUTINE iom_rp0d 1553 1557 … … 1563 1567 INTEGER :: ivid ! variable id 1564 1568 1569 IF (ln_timing) CALL timing_start('iom_rst_put') 1565 1570 llx = .FALSE. 1566 1571 IF(PRESENT(ldxios)) llx = ldxios … … 1580 1585 ENDIF 1581 1586 ENDIF 1587 IF (ln_timing) CALL timing_stop('iom_rst_put') 1582 1588 END SUBROUTINE iom_rp1d 1583 1589 … … 1593 1599 INTEGER :: ivid ! variable id 1594 1600 1601 IF (ln_timing) CALL timing_start('iom_rst_put') 1595 1602 llx = .FALSE. 1596 1603 IF(PRESENT(ldxios)) llx = ldxios … … 1610 1617 ENDIF 1611 1618 ENDIF 1619 IF (ln_timing) CALL timing_stop('iom_rst_put') 1612 1620 END SUBROUTINE iom_rp2d 1613 1621 … … 1623 1631 INTEGER :: ivid ! variable id 1624 1632 1633 IF (ln_timing) CALL timing_start('iom_rst_put') 1625 1634 llx = .FALSE. 1626 1635 IF(PRESENT(ldxios)) llx = ldxios … … 1640 1649 ENDIF 1641 1650 ENDIF 1651 IF (ln_timing) CALL timing_stop('iom_rst_put') 1642 1652 END SUBROUTINE iom_rp3d 1643 1653 -
NEMO/branches/UKMO/NEMO_4.0.4_GO8_paquage_branch/src/OCE/IOM/restart.F90
r15658 r15662 30 30 USE diurnal_bulk 31 31 USE lib_mpp ! distribued memory computing library 32 USE sbc_oce ! for icesheet freshwater input variables 32 33 33 34 IMPLICIT NONE … … 172 173 CALL iom_rstput( kt, nitrst, numrow, 'sshn' , sshn, ldxios = lwxios ) 173 174 CALL iom_rstput( kt, nitrst, numrow, 'rhop' , rhop, ldxios = lwxios ) 175 176 IF( lk_oasis) THEN 177 ! nn_coupled_iceshelf_fluxes uninitialised unless lk_oasis=true 178 IF( nn_coupled_iceshelf_fluxes .eq. 1 ) THEN 179 CALL iom_rstput( kt, nitrst, numrow, 'greenland_icesheet_mass', greenland_icesheet_mass ) 180 CALL iom_rstput( kt, nitrst, numrow, 'greenland_icesheet_timelapsed', greenland_icesheet_timelapsed ) 181 CALL iom_rstput( kt, nitrst, numrow, 'greenland_icesheet_mass_roc', greenland_icesheet_mass_rate_of_change ) 182 CALL iom_rstput( kt, nitrst, numrow, 'antarctica_icesheet_mass', antarctica_icesheet_mass ) 183 CALL iom_rstput( kt, nitrst, numrow, 'antarctica_icesheet_timelapsed', antarctica_icesheet_timelapsed ) 184 CALL iom_rstput( kt, nitrst, numrow, 'antarctica_icesheet_mass_roc', antarctica_icesheet_mass_rate_of_change ) 185 ENDIF 186 ENDIF 174 187 ! extra variable needed for the ice sheet coupling 175 188 IF ( ln_iscpl ) THEN … … 320 333 ENDIF 321 334 ! 335 IF( iom_varid( numror, 'greenland_icesheet_mass', ldstop = .FALSE. ) > 0 ) THEN 336 CALL iom_get( numror, 'greenland_icesheet_mass', greenland_icesheet_mass ) 337 CALL iom_get( numror, 'greenland_icesheet_timelapsed', greenland_icesheet_timelapsed ) 338 CALL iom_get( numror, 'greenland_icesheet_mass_roc', greenland_icesheet_mass_rate_of_change ) 339 ELSE 340 greenland_icesheet_mass = 0.0 341 greenland_icesheet_mass_rate_of_change = 0.0 342 greenland_icesheet_timelapsed = 0.0 343 ENDIF 344 IF( iom_varid( numror, 'antarctica_icesheet_mass', ldstop = .FALSE. ) > 0 ) THEN 345 CALL iom_get( numror, 'antarctica_icesheet_mass', antarctica_icesheet_mass ) 346 CALL iom_get( numror, 'antarctica_icesheet_timelapsed', antarctica_icesheet_timelapsed ) 347 CALL iom_get( numror, 'antarctica_icesheet_mass_roc', antarctica_icesheet_mass_rate_of_change ) 348 ELSE 349 antarctica_icesheet_mass = 0.0 350 antarctica_icesheet_mass_rate_of_change = 0.0 351 antarctica_icesheet_timelapsed = 0.0 352 ENDIF 353 ! 322 354 IF( neuler == 0 ) THEN ! Euler restart (neuler=0) 323 355 tsb (:,:,:,:) = tsn (:,:,:,:) ! all before fields set to now values -
NEMO/branches/UKMO/NEMO_4.0.4_GO8_paquage_branch/src/OCE/SBC/cpl_oasis3.F90
r15661 r15662 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 … … 82 97 INTEGER :: nct ! Number of categories in field 83 98 INTEGER :: ncplmodel ! Maximum number of models to/from which this variable may be sent/received 99 INTEGER :: dimensions ! Number of dimensions of coupling field 84 100 END TYPE FLD_CPL 85 101 … … 106 122 CHARACTER(len = *), INTENT(in ) :: cd_modname ! model name as set in namcouple file 107 123 INTEGER , INTENT( out) :: kl_comm ! local communicator of the model 124 INTEGER :: error 108 125 !!-------------------------------------------------------------------- 109 126 … … 142 159 ! 143 160 INTEGER :: id_part 161 INTEGER :: id_part_0d ! Partition for 0d fields 162 INTEGER :: id_part_rnf_1d ! Partition for 1d river outflow fields 163 INTEGER :: id_part_temp ! Temperary partition used to choose either 0d or 1d partitions 144 164 INTEGER :: paral(5) ! OASIS3 box partition 145 INTEGER :: ishape(4) ! shape of arrays passed to PSMILe 165 INTEGER :: ishape(4) ! shape of 2D arrays passed to PSMILe 166 INTEGER :: ishape0d1d(2) ! Shape of 0D or 1D arrays passed to PSMILe. 167 INTEGER :: var_nodims(2) ! Number of coupling field dimensions. 168 ! var_nodims(1) is redundant from OASIS3-MCT vn4.0 onwards 169 ! but retained for backward compatibility. 170 ! var_nodims(2) is the number of fields in a bundle 171 ! or 1 for unbundled fields (bundles are not yet catered for 172 ! in NEMO hence we default to 1). 146 173 INTEGER :: ji,jc,jm ! local loop indicees 147 174 CHARACTER(LEN=64) :: zclname … … 199 226 ishape(3) = 1 200 227 ishape(4) = nlej-nldj+1 228 229 ishape0d1d(1) = 0 230 ishape0d1d(2) = 0 201 231 ! 202 232 ! ... Allocate memory for data exchange … … 225 255 226 256 CALL oasis_def_partition ( id_part, paral, nerror, jpiglo*jpjglo ) 257 258 ! A special partition is needed for 0D fields 259 260 paral(1) = 0 ! serial partitioning 261 paral(2) = 0 262 IF ( nproc == 0) THEN 263 paral(3) = 1 ! Size of array to couple (scalar) 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 CALL oasis_def_partition ( id_part_0d, paral, nerror, 1 ) 271 272 ! Another partition is needed for 1D river routing fields 273 274 paral(1) = 0 ! serial partitioning 275 paral(2) = 0 276 IF ( nproc == 0) THEN 277 paral(3) = nn_cpl_river ! Size of array to couple (vector) 278 ELSE 279 paral(3) = 0 ! Dummy size for PE's not involved 280 END IF 281 paral(4) = 0 282 paral(5) = 0 283 284 285 CALL oasis_def_partition ( id_part_rnf_1d, paral, nerror, nn_cpl_river ) 286 227 287 ! 228 288 ! ... Announce send variables. … … 303 363 #endif 304 364 IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In 305 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part , (/ 2, 1 /), & 306 & OASIS_In , ishape , OASIS_REAL, nerror ) 365 flush(numout) 366 367 ! Define 0D (Greenland or Antarctic ice mass) or 1D (river outflow) coupling fields 368 IF (srcv(ji)%dimensions <= 1) THEN 369 var_nodims(1) = 1 370 var_nodims(2) = 1 ! Modify this value to cater for bundled fields. 371 IF (nproc == 0) THEN 372 373 IF (srcv(ji)%dimensions == 0) THEN 374 375 ! If 0D then set temporary variables to 0D components 376 id_part_temp = id_part_0d 377 ishape0d1d(2) = 1 378 ELSE 379 380 ! If 1D then set temporary variables to river outflow components 381 id_part_temp = id_part_rnf_1d 382 ishape0d1d(2)= nn_cpl_river 383 384 END IF 385 386 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part_temp , var_nodims, & 387 OASIS_In , ishape0d1d(1:2) , OASIS_REAL, nerror ) 388 ELSE 389 ! Dummy call to keep OASIS3-MCT happy. 390 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part_0d , var_nodims, & 391 OASIS_In , ishape0d1d(1:2) , OASIS_REAL, nerror ) 392 END IF 393 ELSE 394 ! It's a "normal" 2D (or pseudo 3D) coupling field. 395 ! ... Set the field dimension and bundle count 396 var_nodims(1) = 2 397 var_nodims(2) = 1 ! Modify this value to cater for bundled fields. 398 399 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part , var_nodims, & 400 & OASIS_In , ishape , OASIS_REAL, nerror ) 401 ENDIF 307 402 IF ( nerror /= OASIS_Ok ) THEN 308 403 WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) … … 505 600 506 601 602 SUBROUTINE cpl_rcv_1d( kid, kstep, pdata, nitems, kinfo ) 603 !!--------------------------------------------------------------------- 604 !! *** ROUTINE cpl_rcv_1d *** 605 !! 606 !! ** Purpose : - A special version of cpl_rcv to deal exclusively with 607 !! receipt of 0D or 1D fields. 608 !! The fields are recieved into a 1D array buffer which is simply a 609 !! dynamically sized sized array (which may be of size 1) 610 !! of 0 dimensional fields. This allows us to pass miltiple 0D 611 !! fields via a single put/get operation. 612 !!---------------------------------------------------------------------- 613 INTEGER , INTENT(in ) :: nitems ! Number of 0D items to recieve 614 ! during this get operation. i.e. 615 ! The size of the 1D array in which 616 ! 0D items are passed. 617 INTEGER , INTENT(in ) :: kid ! ID index of the incoming 618 ! data. 619 INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds 620 REAL(wp), INTENT(inout) :: pdata(1:nitems) ! The original value(s), 621 ! unchanged if nothing is 622 ! received 623 INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument 624 !! 625 REAL(wp) :: recvfld(1:nitems) ! Local receive field buffer 626 INTEGER :: jc,jm ! local loop index 627 INTEGER :: ierr 628 LOGICAL :: llaction 629 INTEGER :: MPI_WORKING_PRECISION 630 INTEGER :: number_to_print 631 !!-------------------------------------------------------------------- 632 ! 633 ! receive local data from OASIS3 on every process 634 ! 635 kinfo = OASIS_idle 636 ! 637 ! 0D and 1D fields won't have categories or any other form of "pseudo level" 638 ! so we only cater for a single set of values and thus don't bother 639 ! with a loop over the jc index 640 jc = 1 641 642 DO jm = 1, srcv(kid)%ncplmodel 643 644 IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 645 646 IF ( ( srcv(kid)%dimensions <= 1) .AND. (nproc == 0) ) THEN 647 ! Since there is no concept of data decomposition for zero 648 ! dimension fields, they must only be exchanged through the master PE, 649 ! unlike "normal" 2D field cases where every PE is involved. 650 651 CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, recvfld, kinfo ) 652 653 llaction = kinfo == OASIS_Recvd .OR. kinfo == OASIS_FromRest .OR. & 654 kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 655 656 IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , & 657 llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 658 659 IF ( llaction ) THEN 660 661 kinfo = OASIS_Rcv 662 pdata(1:nitems) = recvfld(1:nitems) 663 664 IF ( ln_ctl ) THEN 665 number_to_print = 10 666 IF ( nitems < number_to_print ) number_to_print = nitems 667 WRITE(numout,*) '****************' 668 WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname 669 WRITE(numout,*) 'oasis_get: ivarid ' , srcv(kid)%nid(jc,jm) 670 WRITE(numout,*) 'oasis_get: kstep', kstep 671 WRITE(numout,*) 'oasis_get: info ', kinfo 672 WRITE(numout,*) ' - Minimum Value is ', MINVAL(pdata(:)) 673 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:)) 674 WRITE(numout,*) ' - Start of data is ', pdata(1:number_to_print) 675 WRITE(numout,*) '****************' 676 ENDIF 677 678 ENDIF 679 ENDIF 680 ENDIF 681 682 ENDDO 683 684 #if defined key_mpp_mpi 685 ! Set the precision that we want to broadcast using MPI_BCAST 686 SELECT CASE( wp ) 687 CASE( sp ) 688 MPI_WORKING_PRECISION = MPI_REAL ! Single precision 689 CASE( dp ) 690 MPI_WORKING_PRECISION = MPI_DOUBLE_PRECISION ! Double precision 691 CASE default 692 CALL oasis_abort( ncomp_id, "cpl_rcv_1d", "Could not find precision for coupling 0d or 1d field" ) 693 END SELECT 694 695 ! We have to broadcast (potentially) received values from PE 0 to all 696 ! the others. If no new data has been received we're just 697 ! broadcasting the existing values but there's no more efficient way 698 ! to deal with that w/o NEMO adopting a UM-style test mechanism 699 ! to determine active put/get timesteps. 700 CALL mpi_bcast( pdata, nitems, MPI_WORKING_PRECISION, localRoot, mpi_comm_oce, ierr ) 701 #else 702 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." ) 703 #endif 704 705 ! 706 END SUBROUTINE cpl_rcv_1d 707 708 507 709 INTEGER FUNCTION cpl_freq( cdfieldname ) 508 710 !!--------------------------------------------------------------------- … … 612 814 SUBROUTINE oasis_def_var(k1,cd1,k2,k3,k4,k5,k6,k7) 613 815 CHARACTER(*), INTENT(in ) :: cd1 614 INTEGER , INTENT(in ) :: k2,k3(2),k4,k5( 2,2),k6816 INTEGER , INTENT(in ) :: k2,k3(2),k4,k5(*),k6 615 817 INTEGER , INTENT( out) :: k1,k7 616 818 k1 = -1 ; k7 = -1 … … 632 834 END SUBROUTINE oasis_put 633 835 634 SUBROUTINE oasis_get(k1,k2,p1,k3) 836 SUBROUTINE oasis_get_1d(k1,k2,p1,k3) 837 REAL(wp), DIMENSION(:) , INTENT( out) :: p1 838 INTEGER , INTENT(in ) :: k1,k2 839 INTEGER , INTENT( out) :: k3 840 p1(1) = -1. ; k3 = -1 841 WRITE(numout,*) 'oasis_get_1d: Error you sould not be there...' 842 END SUBROUTINE oasis_get_1d 843 844 SUBROUTINE oasis_get_2d(k1,k2,p1,k3) 635 845 REAL(wp), DIMENSION(:,:), INTENT( out) :: p1 636 846 INTEGER , INTENT(in ) :: k1,k2 637 847 INTEGER , INTENT( out) :: k3 638 848 p1(1,1) = -1. ; k3 = -1 639 WRITE(numout,*) 'oasis_get : Error you sould not be there...'640 END SUBROUTINE oasis_get 849 WRITE(numout,*) 'oasis_get_2d: Error you sould not be there...' 850 END SUBROUTINE oasis_get_2d 641 851 642 852 SUBROUTINE oasis_get_freqs(k1,k5,k2,k3,k4) -
NEMO/branches/UKMO/NEMO_4.0.4_GO8_paquage_branch/src/OCE/SBC/sbc_oce.F90
r14075 r15662 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_GO8_paquage_branch/src/OCE/SBC/sbccpl.F90
r15661 r15662 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 … … 48 49 USE lib_mpp ! distribued memory computing library 49 50 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 51 USE timing ! timing 50 52 51 53 #if defined key_oasis3 … … 120 122 INTEGER, PARAMETER :: jpr_tauwy = 56 ! y component of the ocean stress from waves 121 123 INTEGER, PARAMETER :: jpr_ts_ice = 57 ! Sea ice surface temp 122 123 INTEGER, PARAMETER :: jprcv = 57 ! total number of fields received 124 INTEGER, PARAMETER :: jpr_grnm = 58 ! Greenland ice mass 125 INTEGER, PARAMETER :: jpr_antm = 59 ! Antarctic ice mass 126 INTEGER, PARAMETER :: jpr_rnf_1d = 60 ! 1D river runoff 127 INTEGER, PARAMETER :: jpr_qtr = 61 ! Transmitted solar 128 129 INTEGER, PARAMETER :: jprcv = 61 ! total number of fields received 124 130 125 131 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere … … 186 192 TYPE(FLD_C) :: sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_tauw, sn_rcv_dqnsdt, sn_rcv_qsr, & 187 193 & 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 194 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_mslp, sn_rcv_icb, sn_rcv_isf, & 195 sn_rcv_grnm, sn_rcv_antm 189 196 ! Send to waves 190 197 TYPE(FLD_C) :: sn_snd_ifrac, sn_snd_crtw, sn_snd_wlev … … 277 284 & sn_rcv_iceflx, sn_rcv_co2 , sn_rcv_mslp , & 278 285 & sn_rcv_icb , sn_rcv_isf , sn_rcv_wfreq, sn_rcv_tauw , & 279 & sn_rcv_ts_ice 286 & sn_rcv_ts_ice, sn_rcv_grnm , sn_rcv_antm , & 287 & nn_coupled_iceshelf_fluxes , ln_iceshelf_init_atmos , & 288 & rn_greenland_total_fw_flux , rn_greenland_calving_fraction , & 289 & rn_antarctica_total_fw_flux , rn_antarctica_calving_fraction , & 290 & rn_iceshelf_fluxes_tolerance 291 280 292 !!--------------------------------------------------------------------- 281 293 ! … … 284 296 ! ================================ ! 285 297 ! 298 IF (ln_timing) CALL timing_start('sbc_cpl_init') 286 299 REWIND( numnam_ref ) ! Namelist namsbc_cpl in reference namelist : Variables for OASIS coupling 287 300 READ ( numnam_ref, namsbc_cpl, IOSTAT = ios, ERR = 901) … … 316 329 WRITE(numout,*)' runoffs = ', TRIM(sn_rcv_rnf%cldes ), ' (', TRIM(sn_rcv_rnf%clcat ), ')' 317 330 WRITE(numout,*)' calving = ', TRIM(sn_rcv_cal%cldes ), ' (', TRIM(sn_rcv_cal%clcat ), ')' 331 WRITE(numout,*)' Greenland ice mass = ', TRIM(sn_rcv_grnm%cldes ), ' (', TRIM(sn_rcv_grnm%clcat ), ')' 332 WRITE(numout,*)' Antarctica ice mass = ', TRIM(sn_rcv_antm%cldes ), ' (', TRIM(sn_rcv_antm%clcat ), ')' 318 333 WRITE(numout,*)' iceberg = ', TRIM(sn_rcv_icb%cldes ), ' (', TRIM(sn_rcv_icb%clcat ), ')' 319 334 WRITE(numout,*)' ice shelf = ', TRIM(sn_rcv_isf%cldes ), ' (', TRIM(sn_rcv_isf%clcat ), ')' … … 351 366 WRITE(numout,*)' - orientation = ', sn_snd_crtw%clvor 352 367 WRITE(numout,*)' - mesh = ', sn_snd_crtw%clvgrd 368 WRITE(numout,*)' nn_coupled_iceshelf_fluxes = ', nn_coupled_iceshelf_fluxes 369 WRITE(numout,*)' ln_iceshelf_init_atmos = ', ln_iceshelf_init_atmos 370 WRITE(numout,*)' rn_greenland_total_fw_flux = ', rn_greenland_total_fw_flux 371 WRITE(numout,*)' rn_antarctica_total_fw_flux = ', rn_antarctica_total_fw_flux 372 WRITE(numout,*)' rn_greenland_calving_fraction = ', rn_greenland_calving_fraction 373 WRITE(numout,*)' rn_antarctica_calving_fraction = ', rn_antarctica_calving_fraction 374 WRITE(numout,*)' rn_iceshelf_fluxes_tolerance = ', rn_iceshelf_fluxes_tolerance 353 375 ENDIF 354 376 … … 366 388 367 389 ! default definitions of srcv 368 srcv(:)%laction = .FALSE. ; srcv(:)%clgrid = 'T' ; srcv(:)%nsgn = 1. ; srcv(:)%nct = 1 390 srcv(:)%laction = .FALSE. 391 srcv(:)%clgrid = 'T' 392 srcv(:)%nsgn = 1. 393 srcv(:)%nct = 1 394 srcv(:)%dimensions = 2 369 395 370 396 ! ! ------------------------- ! … … 489 515 ! ! ------------------------- ! 490 516 srcv(jpr_rnf )%clname = 'O_Runoff' 491 IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN 492 srcv(jpr_rnf)%laction = .TRUE. 517 srcv(jpr_rnf_1d )%clname = 'ORunff1D' 518 IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' .OR. TRIM( sn_rcv_rnf%cldes ) == 'coupled1d' ) THEN 519 IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) srcv(jpr_rnf)%laction = .TRUE. 520 IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled1d' ) THEN 521 srcv(jpr_rnf_1d)%laction = .TRUE. 522 srcv(jpr_rnf_1d)%dimensions = 1 ! 1D field passed through coupler 523 END IF 493 524 l_rnfcpl = .TRUE. ! -> no need to read runoffs in sbcrnf 494 525 ln_rnf = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas … … 497 528 ENDIF 498 529 ! 499 srcv(jpr_cal)%clname = 'OCalving' ; IF( TRIM( sn_rcv_cal%cldes) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE. 530 srcv(jpr_cal )%clname = 'OCalving' 531 IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE. 532 533 srcv(jpr_grnm )%clname = 'OGrnmass' 534 IF( TRIM( sn_rcv_grnm%cldes ) == 'coupled' ) THEN 535 srcv(jpr_grnm)%laction = .TRUE. 536 srcv(jpr_grnm)%dimensions = 0 ! Scalar field 537 ENDIF 538 539 srcv(jpr_antm )%clname = 'OAntmass' 540 IF( TRIM( sn_rcv_antm%cldes ) == 'coupled' ) THEN 541 srcv(jpr_antm)%laction = .TRUE. 542 srcv(jpr_antm)%dimensions = 0 ! Scalar field 543 ENDIF 544 500 545 srcv(jpr_isf)%clname = 'OIcshelf' ; IF( TRIM( sn_rcv_isf%cldes) == 'coupled' ) srcv(jpr_isf)%laction = .TRUE. 501 546 srcv(jpr_icb)%clname = 'OIceberg' ; IF( TRIM( sn_rcv_icb%cldes) == 'coupled' ) srcv(jpr_icb)%laction = .TRUE. … … 748 793 ENDIF 749 794 ENDIF 750 751 ! =================================================== !752 ! Allocate all parts of frcv used for received fields !753 ! =================================================== !754 DO jn = 1, jprcv755 IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) )756 END DO757 ! Allocate taum part of frcv which is used even when not received as coupling field758 IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) )759 ! Allocate w10m part of frcv which is used even when not received as coupling field760 IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) )761 ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field762 IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) )763 IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) )764 ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE.765 IF( k_ice /= 0 ) THEN766 IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) )767 IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) )768 END IF769 795 770 796 ! ================================ ! … … 776 802 777 803 ! default definitions of nsnd 778 ssnd(:)%laction = .FALSE. ; ssnd(:)%clgrid = 'T' ; ssnd(:)%nsgn = 1. ; ssnd(:)%nct = 1 804 ssnd(:)%laction = .FALSE. 805 ssnd(:)%clgrid = 'T' 806 ssnd(:)%nsgn = 1. 807 ssnd(:)%nct = 1 808 ssnd(:)%dimensions = 2 779 809 780 810 ! ! ------------------------- ! … … 1059 1089 ENDIF 1060 1090 1091 ! Initialise 1D river outflow scheme 1092 nn_cpl_river = 1 1093 IF ( TRIM( sn_rcv_rnf%cldes ) == 'coupled1d' ) CALL cpl_rnf_1d_init ! Coupled runoff using 1D array 1094 1095 ! =================================================== ! 1096 ! Allocate all parts of frcv used for received fields ! 1097 ! =================================================== ! 1098 DO jn = 1, jprcv 1099 1100 IF ( srcv(jn)%laction ) THEN 1101 SELECT CASE( srcv(jn)%dimensions ) 1102 ! 1103 CASE( 0 ) ! Scalar field 1104 ALLOCATE( frcv(jn)%z3(1,1,1) ) 1105 1106 CASE( 1 ) ! 1D field 1107 ALLOCATE( frcv(jn)%z3(nn_cpl_river,1,1) ) 1108 1109 CASE DEFAULT ! 2D (or pseudo 3D) field. 1110 ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 1111 1112 END SELECT 1113 END IF 1114 1115 END DO 1116 ! Allocate taum part of frcv which is used even when not received as coupling field 1117 IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 1118 ! Allocate w10m part of frcv which is used even when not received as coupling field 1119 IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 1120 ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 1121 IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 1122 IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 1123 ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 1124 IF( k_ice /= 0 ) THEN 1125 IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) ) 1126 IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) ) 1127 END IF 1128 1061 1129 ! 1062 1130 ! ================================ ! … … 1076 1144 ENDIF 1077 1145 xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 ) 1146 ! 1147 IF( nn_coupled_iceshelf_fluxes .gt. 0 ) THEN 1148 ! Crude masks to separate the Antarctic and Greenland icesheets. Obviously something 1149 ! more complicated could be done if required. 1150 greenland_icesheet_mask = 0.0 1151 WHERE( gphit >= 0.0 ) greenland_icesheet_mask = 1.0 1152 antarctica_icesheet_mask = 0.0 1153 WHERE( gphit < 0.0 ) antarctica_icesheet_mask = 1.0 1154 1155 IF( .not. ln_rstart ) THEN 1156 greenland_icesheet_mass = 0.0 1157 greenland_icesheet_mass_rate_of_change = 0.0 1158 greenland_icesheet_timelapsed = 0.0 1159 antarctica_icesheet_mass = 0.0 1160 antarctica_icesheet_mass_rate_of_change = 0.0 1161 antarctica_icesheet_timelapsed = 0.0 1162 ENDIF 1163 1164 ENDIF 1165 ! 1166 IF (ln_timing) CALL timing_stop('sbc_cpl_init') 1078 1167 ! 1079 1168 END SUBROUTINE sbc_cpl_init … … 1138 1227 REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars 1139 1228 REAL(wp) :: zcoef ! temporary scalar 1229 LOGICAL :: ll_wrtstp ! write diagnostics? 1140 1230 REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3 1141 1231 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 1232 REAL(wp) :: zgreenland_icesheet_mass_in, zantarctica_icesheet_mass_in 1233 REAL(wp) :: zgreenland_icesheet_mass_b, zantarctica_icesheet_mass_b 1234 REAL(wp) :: zmask_sum, zepsilon 1142 1235 REAL(wp) :: zzx, zzy ! temporary variables 1143 1236 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty, zmsk, zemp, zqns, zqsr, zcloud_fra 1144 1237 !!---------------------------------------------------------------------- 1238 ! 1239 ! 1240 IF (ln_timing) CALL timing_start('sbc_cpl_rcv') 1241 ! 1242 ll_wrtstp = (( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend )) .AND. (nn_print>0) 1145 1243 ! 1146 1244 IF( kt == nit000 ) THEN … … 1159 1257 isec = ( kt - nit000 ) * NINT( rdt ) ! date of exchanges 1160 1258 DO jn = 1, jprcv ! received fields sent by the atmosphere 1161 IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) 1259 IF( srcv(jn)%laction ) THEN 1260 1261 IF ( srcv(jn)%dimensions <= 1 ) THEN 1262 CALL cpl_rcv_1d( jn, isec, frcv(jn)%z3, SIZE(frcv(jn)%z3), nrcvinfo(jn) ) 1263 ELSE 1264 CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) 1265 END IF 1266 1267 END IF 1162 1268 END DO 1163 1269 … … 1509 1615 ! 1510 1616 ENDIF 1511 ! 1617 1618 ! ! land ice masses : Greenland 1619 zepsilon = rn_iceshelf_fluxes_tolerance 1620 1621 IF( srcv(jpr_grnm)%laction .AND. nn_coupled_iceshelf_fluxes == 1 ) THEN 1622 1623 ! This is a zero dimensional, single value field. 1624 zgreenland_icesheet_mass_in = frcv(jpr_grnm)%z3(1,1,1) 1625 1626 greenland_icesheet_timelapsed = greenland_icesheet_timelapsed + rdt 1627 1628 IF( ln_iceshelf_init_atmos .AND. kt == 1 ) THEN 1629 ! On the first timestep (of an NRUN) force the ocean to ignore the icesheet masses in the ocean restart 1630 ! and take them from the atmosphere to avoid problems with using inconsistent ocean and atmosphere restarts. 1631 zgreenland_icesheet_mass_b = zgreenland_icesheet_mass_in 1632 greenland_icesheet_mass = zgreenland_icesheet_mass_in 1633 ENDIF 1634 1635 IF( ABS( zgreenland_icesheet_mass_in - greenland_icesheet_mass ) > zepsilon ) THEN 1636 zgreenland_icesheet_mass_b = greenland_icesheet_mass 1637 1638 ! Only update the mass if it has increased. 1639 IF ( (zgreenland_icesheet_mass_in - greenland_icesheet_mass) > 0.0 ) THEN 1640 greenland_icesheet_mass = zgreenland_icesheet_mass_in 1641 ENDIF 1642 1643 IF( zgreenland_icesheet_mass_b /= 0.0 ) & 1644 & greenland_icesheet_mass_rate_of_change = ( greenland_icesheet_mass - zgreenland_icesheet_mass_b ) / greenland_icesheet_timelapsed 1645 greenland_icesheet_timelapsed = 0.0_wp 1646 ENDIF 1647 IF(lwp .AND. ll_wrtstp) THEN 1648 WRITE(numout,*) 'Greenland icesheet mass (kg) read in is ', zgreenland_icesheet_mass_in 1649 WRITE(numout,*) 'Greenland icesheet mass (kg) used is ', greenland_icesheet_mass 1650 WRITE(numout,*) 'Greenland icesheet mass rate of change (kg/s) is ', greenland_icesheet_mass_rate_of_change 1651 WRITE(numout,*) 'Greenland icesheet seconds lapsed since last change is ', greenland_icesheet_timelapsed 1652 ENDIF 1653 ELSE IF ( nn_coupled_iceshelf_fluxes == 2 ) THEN 1654 greenland_icesheet_mass_rate_of_change = rn_greenland_total_fw_flux 1655 ENDIF 1656 1657 ! ! land ice masses : Antarctica 1658 IF( srcv(jpr_antm)%laction .AND. nn_coupled_iceshelf_fluxes == 1 ) THEN 1659 1660 ! This is a zero dimensional, single value field. 1661 zantarctica_icesheet_mass_in = frcv(jpr_antm)%z3(1,1,1) 1662 1663 antarctica_icesheet_timelapsed = antarctica_icesheet_timelapsed + rdt 1664 1665 IF( ln_iceshelf_init_atmos .AND. kt == 1 ) THEN 1666 ! On the first timestep (of an NRUN) force the ocean to ignore the icesheet masses in the ocean restart 1667 ! and take them from the atmosphere to avoid problems with using inconsistent ocean and atmosphere restarts. 1668 zantarctica_icesheet_mass_b = zantarctica_icesheet_mass_in 1669 antarctica_icesheet_mass = zantarctica_icesheet_mass_in 1670 ENDIF 1671 1672 IF( ABS( zantarctica_icesheet_mass_in - antarctica_icesheet_mass ) > zepsilon ) THEN 1673 zantarctica_icesheet_mass_b = antarctica_icesheet_mass 1674 1675 ! Only update the mass if it has increased. 1676 IF ( (zantarctica_icesheet_mass_in - antarctica_icesheet_mass) > 0.0 ) THEN 1677 antarctica_icesheet_mass = zantarctica_icesheet_mass_in 1678 END IF 1679 1680 IF( zantarctica_icesheet_mass_b /= 0.0 ) & 1681 & antarctica_icesheet_mass_rate_of_change = ( antarctica_icesheet_mass - zantarctica_icesheet_mass_b ) / antarctica_icesheet_timelapsed 1682 antarctica_icesheet_timelapsed = 0.0_wp 1683 ENDIF 1684 IF(lwp .AND. ll_wrtstp) THEN 1685 WRITE(numout,*) 'Antarctica icesheet mass (kg) read in is ', zantarctica_icesheet_mass_in 1686 WRITE(numout,*) 'Antarctica icesheet mass (kg) used is ', antarctica_icesheet_mass 1687 WRITE(numout,*) 'Antarctica icesheet mass rate of change (kg/s) is ', antarctica_icesheet_mass_rate_of_change 1688 WRITE(numout,*) 'Antarctica icesheet seconds lapsed since last change is ', antarctica_icesheet_timelapsed 1689 ENDIF 1690 ELSE IF ( nn_coupled_iceshelf_fluxes == 2 ) THEN 1691 antarctica_icesheet_mass_rate_of_change = rn_antarctica_total_fw_flux 1692 ENDIF 1693 ! 1694 IF (ln_timing) CALL timing_stop('sbc_cpl_rcv') 1512 1695 END SUBROUTINE sbc_cpl_rcv 1513 1696 … … 1553 1736 !!---------------------------------------------------------------------- 1554 1737 ! 1738 IF (ln_timing) CALL timing_start('sbc_cpl_snd') 1555 1739 IF( srcv(jpr_itx1)%laction ) THEN ; itx = jpr_itx1 1556 1740 ELSE ; itx = jpr_otx1 … … 1780 1964 1781 1965 ! --- Continental fluxes --- ! 1782 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) 1783 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(:,:,:)) 1784 1971 ENDIF 1785 1972 IF( srcv(jpr_cal)%laction ) THEN ! calving (put in emp_tot and emp_oce) … … 1820 2007 zsnw(:,:) = picefr(:,:) 1821 2008 ! --- Continental fluxes --- ! 1822 IF( srcv(jpr_rnf)%laction ) THEN ! runoffs (included in emp later on)2009 IF( srcv(jpr_rnf)%laction ) THEN ! 2D runoffs (included in emp later on) 1823 2010 rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 2011 ENDIF 2012 IF( srcv(jpr_rnf_1d)%laction ) THEN ! 1D runoff 2013 CALL cpl_rnf_1d_to_2d(frcv(jpr_rnf_1d)%z3(:,:,:)) 1824 2014 ENDIF 1825 2015 IF( srcv(jpr_cal)%laction ) THEN ! calving (put in emp_tot) … … 2742 2932 #endif 2743 2933 ! 2934 IF (ln_timing) CALL timing_stop('sbc_cpl_snd') 2744 2935 END SUBROUTINE sbc_cpl_snd 2745 2936 -
NEMO/branches/UKMO/NEMO_4.0.4_GO8_paquage_branch/src/OCE/SBC/sbcisf.F90
r15658 r15662 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 -
NEMO/branches/UKMO/NEMO_4.0.4_GO8_paquage_branch/src/OCE/SBC/sbcrnf.F90
r15658 r15662 42 42 REAL(wp) :: rn_rnf_max !: maximum value of the runoff climatologie (ln_rnf_depth_ini =T) 43 43 REAL(wp) :: rn_dep_max !: depth over which runoffs is spread (ln_rnf_depth_ini =T) 44 REAL(wp) :: tot_flux !: total iceberg flux (temporary variable) 44 45 INTEGER :: nn_rnf_depth_file !: create (=1) a runoff depth file or not (=0) 45 46 LOGICAL :: ln_rnf_icb !: iceberg flux is specified in a file 47 LOGICAL :: ln_icb_mass !: Scale iceberg flux to match FW flux from coupled model 46 48 LOGICAL :: ln_rnf_tem !: temperature river runoffs attribute specified in a file 47 49 LOGICAL , PUBLIC :: ln_rnf_sal !: salinity river runoffs attribute specified in a file … … 109 111 !!---------------------------------------------------------------------- 110 112 REAL(wp), DIMENSION(jpi,jpj) :: ztfrz ! freezing point used for temperature correction 113 REAL(wp), PARAMETER :: rsmall = 1.e-10_wp ! ICB flux epsilon 114 111 115 ! 112 116 ! … … 118 122 IF( .NOT. l_rnfcpl ) THEN 119 123 CALL fld_read ( kt, nn_fsbc, sf_rnf ) ! Read Runoffs data and provide it at kt ( runoffs + iceberg ) 120 IF( ln_rnf_icb ) CALL fld_read ( kt, nn_fsbc, sf_i_rnf ) ! idem for iceberg flux if required121 ENDIF124 ENDIF 125 IF( ln_rnf_icb ) CALL fld_read ( kt, nn_fsbc, sf_i_rnf ) ! idem for iceberg flux if required 122 126 IF( ln_rnf_tem ) CALL fld_read ( kt, nn_fsbc, sf_t_rnf ) ! idem for runoffs temperature if required 123 127 IF( ln_rnf_sal ) CALL fld_read ( kt, nn_fsbc, sf_s_rnf ) ! idem for runoffs salinity if required … … 127 131 IF( .NOT. l_rnfcpl ) THEN 128 132 rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) ) * tmask(:,:,1) ! updated runoff value at time step kt 129 IF( ln_rnf_icb ) THEN 130 fwficb(:,:) = rn_rfact * ( sf_i_rnf(1)%fnow(:,:,1) ) * tmask(:,:,1) ! updated runoff value at time step kt 131 CALL iom_put( 'iceberg_cea' , fwficb(:,:) ) ! output iceberg flux 132 CALL iom_put( 'hflx_icb_cea' , fwficb(:,:) * rLfus ) ! output Heat Flux into Sea Water due to Iceberg Thermodynamics --> 133 ENDIF 133 ENDIF 134 IF( ln_rnf_icb ) THEN 135 fwficb(:,:) = rn_rfact * ( sf_i_rnf(1)%fnow(:,:,1) ) * tmask(:,:,1) ! updated runoff value at time step kt 136 IF( ln_icb_mass ) THEN 137 ! Modify the Iceberg FW flux to be consistent with the change in 138 ! mass of the Antarctic/Greenland ice sheet for FW conservation in 139 ! coupled model. This isn't perfect as FW flux will go into ocean at 140 ! wrong time of year but more important to maintain FW balance 141 tot_flux = SUM(fwficb(:,:)*e1e2t(:,:)*tmask_i(:,:)*greenland_icesheet_mask(:,:)) !Need to multiply by area to convert to kg/s 142 IF( lk_mpp ) CALL mpp_sum( 'icbclv', tot_flux ) 143 IF( tot_flux > rsmall ) THEN 144 WHERE( greenland_icesheet_mask(:,:) == 1.0 ) & 145 & fwficb(:,:) = fwficb(:,:) * greenland_icesheet_mass_rate_of_change * rn_greenland_calving_fraction & 146 & / tot_flux 147 ELSE IF( rn_greenland_calving_fraction < rsmall ) THEN 148 WHERE( greenland_icesheet_mask(:,:) == 1.0 ) fwficb(:,:) = 0.0 149 ELSE 150 CALL CTL_STOP('STOP', 'No iceberg runoff data read in for Greenland. Check input file or set rn_greenland_calving_fraction=0.0') 151 ENDIF 152 153 tot_flux = SUM(fwficb(:,:)*e1e2t(:,:)*tmask_i(:,:)*antarctica_icesheet_mask(:,:)) 154 IF( lk_mpp ) CALL mpp_sum( 'icbclv', tot_flux ) 155 IF( tot_flux > rsmall ) THEN 156 WHERE( antarctica_icesheet_mask(:,:) == 1.0 ) & 157 & fwficb(:,:) = fwficb(:,:) * antarctica_icesheet_mass_rate_of_change * rn_antarctica_calving_fraction & 158 & / (tot_flux + 1.0e-10_wp ) 159 ELSE IF( rn_antarctica_calving_fraction < rsmall ) THEN 160 WHERE( antarctica_icesheet_mask(:,:) == 1.0 ) fwficb(:,:) = 0.0 161 ELSE 162 CALL CTL_STOP('STOP', 'No iceberg runoff data read in for Greenland. Check input file or set rn_antarctica_calving_fraction=0.0') 163 ENDIF 164 ENDIF 165 CALL iom_put( 'iceberg_cea' , fwficb(:,:) ) ! output iceberg flux 166 CALL iom_put( 'hflx_icb_cea' , fwficb(:,:) * rLfus ) ! output Heat Flux into Sea Water due to Iceberg Thermodynamics --> 167 rnf(:,:) = rnf(:,:) + fwficb(:,:) ! fwficb isn't used anywhere else so add it to runoff here 168 qns_tot(:,:) = qns_tot(:,:) - fwficb(:,:) * rLfus ! TG: I think this is correct 134 169 ENDIF 135 170 ! … … 257 292 REAL(wp), DIMENSION(jpi,jpj,2) :: zrnfcl 258 293 !! 259 NAMELIST/namsbc_rnf/ cn_dir , ln_rnf_depth, ln_rnf_tem, ln_rnf_sal, ln_rnf_icb, &294 NAMELIST/namsbc_rnf/ cn_dir , ln_rnf_depth, ln_rnf_tem, ln_rnf_sal, ln_rnf_icb, ln_icb_mass, & 260 295 & sn_rnf, sn_cnf , sn_i_rnf, sn_s_rnf , sn_t_rnf , sn_dep_rnf, & 261 296 & ln_rnf_mouth , rn_hrnf , rn_avt_rnf, rn_rfact, & … … 315 350 CALL fld_fill( sf_rnf, (/ sn_rnf /), cn_dir, 'sbc_rnf_init', 'read runoffs data', 'namsbc_rnf', no_print ) 316 351 ! 317 IF( ln_rnf_icb ) THEN ! Create (if required) sf_i_rnf structure318 IF(lwp) WRITE(numout,*)319 IF(lwp) WRITE(numout,*) ' iceberg flux read in a file'320 ALLOCATE( sf_i_rnf(1), STAT=ierror )321 IF( ierror > 0 ) THEN322 CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_i_rnf structure' ) ; RETURN323 ENDIF324 ALLOCATE( sf_i_rnf(1)%fnow(jpi,jpj,1) )325 IF( sn_i_rnf%ln_tint ) ALLOCATE( sf_i_rnf(1)%fdta(jpi,jpj,1,2))326 CALL fld_fill (sf_i_rnf, (/ sn_i_rnf /), cn_dir, 'sbc_rnf_init', 'read iceberg flux data', 'namsbc_rnf')327 ELSE328 fwficb(:,:) = 0._wp329 ENDIF330 331 ENDIF 352 ENDIF 353 IF( ln_rnf_icb ) THEN ! Create (if required) sf_i_rnf structure 354 IF(lwp) WRITE(numout,*) 355 IF(lwp) WRITE(numout,*) ' iceberg flux read in a file' 356 ALLOCATE( sf_i_rnf(1), STAT=ierror ) 357 IF( ierror > 0 ) THEN 358 CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_i_rnf structure' ) ; RETURN 359 ENDIF 360 ALLOCATE( sf_i_rnf(1)%fnow(jpi,jpj,1) ) 361 IF( sn_i_rnf%ln_tint ) ALLOCATE( sf_i_rnf(1)%fdta(jpi,jpj,1,2) ) 362 CALL fld_fill (sf_i_rnf, (/ sn_i_rnf /), cn_dir, 'sbc_rnf_init', 'read iceberg flux data', 'namsbc_rnf' ) 363 ELSE 364 fwficb(:,:) = 0._wp 365 ENDIF 366 332 367 ! 333 368 IF( ln_rnf_tem ) THEN ! Create (if required) sf_t_rnf structure
Note: See TracChangeset
for help on using the changeset viewer.