New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 13778 – NEMO

Changeset 13778


Ignore:
Timestamp:
2020-11-11T14:27:17+01:00 (4 years ago)
Author:
dancopsey
Message:

Merge in existing changes from NEMO_4.0.1 version of this branch.

Location:
NEMO/branches/UKMO/NEMO_4.0.3_icesheet_and_river_coupling
Files:
8 edited
1 copied

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/NEMO_4.0.3_icesheet_and_river_coupling/cfgs/SHARED/field_def_nemo-oce.xml

    r13340 r13778  
    289289 
    290290          <!-- * variable related to ice shelf forcing * --> 
     291          <field id="berg_calve"   long_name="Iceberg calving"                               unit="kg/m2/s"  />  
    291292          <field id="fwfisf"       long_name="Ice shelf melting"                             unit="kg/m2/s"  /> 
    292293          <field id="fwfisf3d"     long_name="Ice shelf melting"                             unit="kg/m2/s"  grid_ref="grid_T_3D" /> 
  • NEMO/branches/UKMO/NEMO_4.0.3_icesheet_and_river_coupling/cfgs/SHARED/namelist_ref

    r13587 r13778  
    292292   ln_scale_ice_flux = .false. !  use ice fluxes that are already "ice weighted" ( i.e. multiplied ice concentration) 
    293293   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 
    294308   !_____________!__________________________!____________!_____________!______________________!________! 
    295309   !             !        description       !  multiple  !    vector   !       vector         ! vector ! 
  • NEMO/branches/UKMO/NEMO_4.0.3_icesheet_and_river_coupling/src/OCE/ICB/icbclv.F90

    r13587 r13778  
    2626   USE icb_oce        ! iceberg parameters  
    2727 
     28   USE sbc_oce        ! for icesheet freshwater input variables  
     29   USE in_out_manager  
     30   USE iom  
     31 
    2832   IMPLICIT NONE 
    2933   PRIVATE 
     
    4953      ! 
    5054      REAL(wp)      ::   zcalving_used, zdist, zfact 
     55      REAL(wp), DIMENSION(1)      ::   zgreenland_calving_sum, zantarctica_calving_sum  
     56      LOGICAL       ::   ll_write 
    5157      INTEGER       ::   jn, ji, jj                    ! loop counters 
    5258      INTEGER       ::   imx                           ! temporary integer for max berg class 
     
    6369      ! Heat in units of W/m2, and mask (just in case) 
    6470      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 
    65109 
    66110      IF( ll_first_call .AND. .NOT. l_restarted_bergs ) THEN      ! This is a hack to simplify initialization 
  • NEMO/branches/UKMO/NEMO_4.0.3_icesheet_and_river_coupling/src/OCE/IOM/restart.F90

    r13587 r13778  
    2929   USE diurnal_bulk 
    3030   USE lib_mpp         ! distribued memory computing library 
     31   USE sbc_oce         ! for icesheet freshwater input variables  
    3132 
    3233   IMPLICIT NONE 
     
    161162                     CALL iom_rstput( kt, nitrst, numrow, 'sshn'   , sshn, ldxios = lwxios      ) 
    162163                     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 
    163176                  ! extra variable needed for the ice sheet coupling 
    164177                  IF ( ln_iscpl ) THEN  
     
    295308      ENDIF 
    296309      ! 
     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      ! 
    297329      IF( neuler == 0 ) THEN                                  ! Euler restart (neuler=0) 
    298330         tsb  (:,:,:,:) = tsn  (:,:,:,:)                             ! all before fields set to now values 
  • NEMO/branches/UKMO/NEMO_4.0.3_icesheet_and_river_coupling/src/OCE/SBC/cpl_oasis3.F90

    r13587 r13778  
    2929#endif 
    3030   USE par_oce                      ! ocean parameters 
     31   USE cpl_rnf_1d, ONLY: nn_cpl_river   ! Variables used in 1D river outflow  
    3132   USE dom_oce                      ! ocean space and time domain 
    3233   USE in_out_manager               ! I/O manager 
    3334   USE lbclnk                       ! ocean lateral boundary conditions (or mpp link) 
     35   USE lib_mpp 
    3436 
    3537   IMPLICIT NONE 
    3638   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  
    3746 
    3847   PUBLIC   cpl_init 
     
    4049   PUBLIC   cpl_snd 
    4150   PUBLIC   cpl_rcv 
     51   PUBLIC   cpl_rcv_1d 
    4252   PUBLIC   cpl_freq 
    4353   PUBLIC   cpl_finalize 
    4454 
     55#if defined key_mpp_mpi 
     56   INCLUDE 'mpif.h' 
     57#endif 
     58 
     59   INTEGER, PARAMETER         ::   localRoot  = 0 
    4560   INTEGER, PUBLIC            ::   OASIS_Rcv  = 1    !: return code if received field 
    4661   INTEGER, PUBLIC            ::   OASIS_idle = 0    !: return code if nothing done by oasis 
     
    6681   INTEGER                    ::   nsnd         ! total number of fields sent  
    6782   INTEGER                    ::   ncplmodel    ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 
    68    INTEGER, PUBLIC, PARAMETER ::   nmaxfld=60   ! Maximum number of coupling fields 
     83   INTEGER, PUBLIC, PARAMETER ::   nmaxfld=61   ! Maximum number of coupling fields 
    6984   INTEGER, PUBLIC, PARAMETER ::   nmaxcat=5    ! Maximum number of coupling fields 
    7085   INTEGER, PUBLIC, PARAMETER ::   nmaxcpl=5    ! Maximum number of coupling fields 
     
    8196      INTEGER               ::   nct       ! Number of categories in field 
    8297      INTEGER               ::   ncplmodel ! Maximum number of models to/from which this variable may be sent/received 
     98      INTEGER               ::   dimensions ! Number of dimensions of coupling field  
    8399   END TYPE FLD_CPL 
    84100 
     
    105121      CHARACTER(len = *), INTENT(in   ) ::   cd_modname   ! model name as set in namcouple file 
    106122      INTEGER           , INTENT(  out) ::   kl_comm      ! local communicator of the model 
     123      INTEGER                           ::   error 
    107124      !!-------------------------------------------------------------------- 
    108125 
     
    141158      ! 
    142159      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  
    143163      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).   
    145172      INTEGER :: ji,jc,jm       ! local loop indicees 
    146173      CHARACTER(LEN=64) :: zclname 
     
    185212      ishape(3) = 1 
    186213      ishape(4) = nlej-nldj+1 
     214 
     215      ishape0d1d(1) = 0  
     216      ishape0d1d(2) = 0  
    187217      ! 
    188218      ! ... Allocate memory for data exchange 
     
    211241    
    212242      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 
    213273      ! 
    214274      ! ... Announce send variables.  
     
    289349#endif 
    290350                  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 
    293388                  IF ( nerror /= OASIS_Ok ) THEN 
    294389                     WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 
     
    471566 
    472567 
     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 
    473675   INTEGER FUNCTION cpl_freq( cdfieldname )   
    474676      !!--------------------------------------------------------------------- 
     
    578780   SUBROUTINE oasis_def_var(k1,cd1,k2,k3,k4,k5,k6,k7) 
    579781      CHARACTER(*), INTENT(in   ) ::  cd1 
    580       INTEGER     , INTENT(in   ) ::  k2,k3(2),k4,k5(2,2),k6 
     782      INTEGER     , INTENT(in   ) ::  k2,k3(2),k4,k5(*),k6 
    581783      INTEGER     , INTENT(  out) ::  k1,k7 
    582784      k1 = -1 ; k7 = -1 
     
    598800   END SUBROUTINE oasis_put 
    599801 
    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) 
    601811      REAL(wp), DIMENSION(:,:), INTENT(  out) ::  p1 
    602812      INTEGER                 , INTENT(in   ) ::  k1,k2 
    603813      INTEGER                 , INTENT(  out) ::  k3 
    604814      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 
    607817 
    608818   SUBROUTINE oasis_get_freqs(k1,k5,k2,k3,k4) 
  • NEMO/branches/UKMO/NEMO_4.0.3_icesheet_and_river_coupling/src/OCE/SBC/sbc_oce.F90

    r13587 r13778  
    137137   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask          !: coupling mask for ln_mixcpl (warning: allocated in sbccpl) 
    138138   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  
    139141 
    140142   !!---------------------------------------------------------------------- 
     
    150152   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   frq_m     !: mean (nn_fsbc time-step) fraction of solar net radiation absorbed in the 1st T level [-] 
    151153 
     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 
    152181   !! * Substitutions 
    153182#  include "vectopt_loop_substitute.h90" 
     
    183212         &      ssu_m  (jpi,jpj) , sst_m    (jpi,jpj) , frq_m(jpi,jpj) ,  & 
    184213         &      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) )  
    185216         ! 
    186217      ALLOCATE( e3t_m(jpi,jpj) , STAT=ierr(5) ) 
  • NEMO/branches/UKMO/NEMO_4.0.3_icesheet_and_river_coupling/src/OCE/SBC/sbccpl.F90

    r13587 r13778  
    3636   USE eosbn2         !  
    3737   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  
    3839   USE sbcisf  , ONLY : l_isfcpl 
    3940#if defined key_cice 
     
    120121   INTEGER, PARAMETER ::   jpr_tauwy  = 56   ! y component of the ocean stress from waves 
    121122   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 
    124129 
    125130   INTEGER, PARAMETER ::   jps_fice   =  1   ! ice fraction sent to the atmosphere 
     
    186191   TYPE(FLD_C) ::   sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_tauw, sn_rcv_dqnsdt, sn_rcv_qsr,  & 
    187192      &             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 
    189195   ! Send to waves  
    190196   TYPE(FLD_C) ::   sn_snd_ifrac, sn_snd_crtw, sn_snd_wlev  
     
    271277         &                  sn_rcv_iceflx, sn_rcv_co2   , sn_rcv_mslp ,                                & 
    272278         &                  sn_rcv_icb   , sn_rcv_isf   , sn_rcv_wfreq, sn_rcv_tauw  ,                 & 
    273          &                  sn_rcv_ts_ice 
     279         &                  sn_rcv_ts_ice, sn_rcv_grnm  , sn_rcv_antm  ,                               & 
     280         &                  nn_coupled_iceshelf_fluxes  , ln_iceshelf_init_atmos ,                     & 
     281         &                  rn_greenland_total_fw_flux  , rn_greenland_calving_fraction  ,             & 
     282         &                  rn_antarctica_total_fw_flux , rn_antarctica_calving_fraction ,             & 
     283         &                  rn_iceshelf_fluxes_tolerance 
     284 
    274285      !!--------------------------------------------------------------------- 
    275286      ! 
     
    310321         WRITE(numout,*)'      runoffs                         = ', TRIM(sn_rcv_rnf%cldes   ), ' (', TRIM(sn_rcv_rnf%clcat   ), ')' 
    311322         WRITE(numout,*)'      calving                         = ', TRIM(sn_rcv_cal%cldes   ), ' (', TRIM(sn_rcv_cal%clcat   ), ')' 
     323         WRITE(numout,*)'      Greenland ice mass              = ', TRIM(sn_rcv_grnm%cldes  ), ' (', TRIM(sn_rcv_grnm%clcat  ), ')'  
     324         WRITE(numout,*)'      Antarctica ice mass             = ', TRIM(sn_rcv_antm%cldes  ), ' (', TRIM(sn_rcv_antm%clcat  ), ')'  
    312325         WRITE(numout,*)'      iceberg                         = ', TRIM(sn_rcv_icb%cldes   ), ' (', TRIM(sn_rcv_icb%clcat   ), ')' 
    313326         WRITE(numout,*)'      ice shelf                       = ', TRIM(sn_rcv_isf%cldes   ), ' (', TRIM(sn_rcv_isf%clcat   ), ')' 
     
    345358         WRITE(numout,*)'                      - orientation   = ', sn_snd_crtw%clvor  
    346359         WRITE(numout,*)'                      - mesh          = ', sn_snd_crtw%clvgrd  
     360         WRITE(numout,*)'  nn_coupled_iceshelf_fluxes          = ', nn_coupled_iceshelf_fluxes 
     361         WRITE(numout,*)'  ln_iceshelf_init_atmos              = ', ln_iceshelf_init_atmos 
     362         WRITE(numout,*)'  rn_greenland_total_fw_flux          = ', rn_greenland_total_fw_flux 
     363         WRITE(numout,*)'  rn_antarctica_total_fw_flux         = ', rn_antarctica_total_fw_flux 
     364         WRITE(numout,*)'  rn_greenland_calving_fraction       = ', rn_greenland_calving_fraction 
     365         WRITE(numout,*)'  rn_antarctica_calving_fraction      = ', rn_antarctica_calving_fraction 
     366         WRITE(numout,*)'  rn_iceshelf_fluxes_tolerance        = ', rn_iceshelf_fluxes_tolerance 
    347367      ENDIF 
    348368 
     
    360380 
    361381      ! default definitions of srcv 
    362       srcv(:)%laction = .FALSE.   ;   srcv(:)%clgrid = 'T'   ;   srcv(:)%nsgn = 1.   ;   srcv(:)%nct = 1 
     382      srcv(:)%laction = .FALSE.  
     383      srcv(:)%clgrid = 'T'  
     384      srcv(:)%nsgn = 1.  
     385      srcv(:)%nct = 1  
     386      srcv(:)%dimensions = 2  
    363387 
    364388      !                                                      ! ------------------------- ! 
     
    479503      !                                                      ! ------------------------- ! 
    480504      srcv(jpr_rnf   )%clname = 'O_Runoff' 
    481       IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN 
    482          srcv(jpr_rnf)%laction = .TRUE. 
     505      srcv(jpr_rnf_1d   )%clname = 'ORunff1D'  
     506      IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' .OR. TRIM( sn_rcv_rnf%cldes ) == 'coupled1d' ) THEN   
     507         IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) srcv(jpr_rnf)%laction = .TRUE.  
     508         IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled1d' ) THEN  
     509            srcv(jpr_rnf_1d)%laction = .TRUE.  
     510            srcv(jpr_rnf_1d)%dimensions = 1 ! 1D field passed through coupler  
     511         END IF  
    483512         l_rnfcpl              = .TRUE.                      ! -> no need to read runoffs in sbcrnf 
    484513         ln_rnf                = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas 
     
    487516      ENDIF 
    488517      ! 
    489       srcv(jpr_cal)%clname = 'OCalving'   ;  IF( TRIM( sn_rcv_cal%cldes) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE. 
     518      srcv(jpr_cal   )%clname = 'OCalving'     
     519      IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE.       
     520  
     521      srcv(jpr_grnm  )%clname = 'OGrnmass'   
     522      IF( TRIM( sn_rcv_grnm%cldes ) == 'coupled' ) THEN  
     523         srcv(jpr_grnm)%laction = .TRUE.   
     524         srcv(jpr_grnm)%dimensions = 0 ! Scalar field 
     525      ENDIF  
     526        
     527      srcv(jpr_antm  )%clname = 'OAntmass'  
     528      IF( TRIM( sn_rcv_antm%cldes ) == 'coupled' ) THEN 
     529         srcv(jpr_antm)%laction = .TRUE. 
     530         srcv(jpr_antm)%dimensions = 0 ! Scalar field 
     531      ENDIF 
     532 
    490533      srcv(jpr_isf)%clname = 'OIcshelf'   ;  IF( TRIM( sn_rcv_isf%cldes) == 'coupled' )   srcv(jpr_isf)%laction = .TRUE. 
    491534      srcv(jpr_icb)%clname = 'OIceberg'   ;  IF( TRIM( sn_rcv_icb%cldes) == 'coupled' )   srcv(jpr_icb)%laction = .TRUE. 
     
    738781         ENDIF 
    739782      ENDIF 
    740        
    741       ! =================================================== ! 
    742       ! Allocate all parts of frcv used for received fields ! 
    743       ! =================================================== ! 
    744       DO jn = 1, jprcv 
    745          IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 
    746       END DO 
    747       ! Allocate taum part of frcv which is used even when not received as coupling field 
    748       IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 
    749       ! Allocate w10m part of frcv which is used even when not received as coupling field 
    750       IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 
    751       ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 
    752       IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 
    753       IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 
    754       ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 
    755       IF( k_ice /= 0 ) THEN 
    756          IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) ) 
    757          IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) ) 
    758       END IF 
    759783 
    760784      ! ================================ ! 
     
    766790       
    767791      ! default definitions of nsnd 
    768       ssnd(:)%laction = .FALSE.   ;   ssnd(:)%clgrid = 'T'   ;   ssnd(:)%nsgn = 1.  ; ssnd(:)%nct = 1 
     792      ssnd(:)%laction = .FALSE.  
     793      ssnd(:)%clgrid = 'T'  
     794      ssnd(:)%nsgn = 1.  
     795      ssnd(:)%nct = 1  
     796      ssnd(:)%dimensions = 2  
    769797          
    770798      !                                                      ! ------------------------- ! 
     
    10491077      ENDIF 
    10501078 
     1079      ! Initialise 1D river outflow scheme  
     1080      nn_cpl_river = 1  
     1081      IF ( TRIM( sn_rcv_rnf%cldes ) == 'coupled1d' ) CALL cpl_rnf_1d_init   ! Coupled runoff using 1D array 
     1082       
     1083      ! =================================================== ! 
     1084      ! Allocate all parts of frcv used for received fields ! 
     1085      ! =================================================== ! 
     1086      DO jn = 1, jprcv 
     1087 
     1088         IF ( srcv(jn)%laction ) THEN  
     1089            SELECT CASE( srcv(jn)%dimensions ) 
     1090            ! 
     1091            CASE( 0 )   ! Scalar field 
     1092               ALLOCATE( frcv(jn)%z3(1,1,1) ) 
     1093                
     1094            CASE( 1 )   ! 1D field 
     1095               ALLOCATE( frcv(jn)%z3(nn_cpl_river,1,1) ) 
     1096                
     1097            CASE DEFAULT  ! 2D (or pseudo 3D) field. 
     1098               ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 
     1099                
     1100            END SELECT 
     1101         END IF 
     1102 
     1103      END DO 
     1104      ! Allocate taum part of frcv which is used even when not received as coupling field 
     1105      IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 
     1106      ! Allocate w10m part of frcv which is used even when not received as coupling field 
     1107      IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 
     1108      ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 
     1109      IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 
     1110      IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 
     1111      ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 
     1112      IF( k_ice /= 0 ) THEN 
     1113         IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) ) 
     1114         IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) ) 
     1115      END IF 
     1116 
    10511117      ! 
    10521118      ! ================================ ! 
     
    10661132      ENDIF 
    10671133      xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 ) 
     1134      ! 
     1135      IF( nn_coupled_iceshelf_fluxes .gt. 0 ) THEN  
     1136          ! Crude masks to separate the Antarctic and Greenland icesheets. Obviously something  
     1137          ! more complicated could be done if required.  
     1138          greenland_icesheet_mask = 0.0  
     1139          WHERE( gphit >= 0.0 ) greenland_icesheet_mask = 1.0  
     1140          antarctica_icesheet_mask = 0.0  
     1141          WHERE( gphit < 0.0 ) antarctica_icesheet_mask = 1.0  
     1142   
     1143          IF( .not. ln_rstart ) THEN  
     1144             greenland_icesheet_mass = 0.0   
     1145             greenland_icesheet_mass_rate_of_change = 0.0   
     1146             greenland_icesheet_timelapsed = 0.0  
     1147             antarctica_icesheet_mass = 0.0   
     1148             antarctica_icesheet_mass_rate_of_change = 0.0   
     1149             antarctica_icesheet_timelapsed = 0.0  
     1150          ENDIF  
     1151  
     1152      ENDIF  
    10681153      ! 
    10691154   END SUBROUTINE sbc_cpl_init 
     
    11261211      REAL(wp) ::   zcumulneg, zcumulpos   ! temporary scalars      
    11271212      REAL(wp) ::   zcoef                  ! temporary scalar 
     1213      LOGICAL  ::   ll_wrtstp              ! write diagnostics? 
    11281214      REAL(wp) ::   zrhoa  = 1.22          ! Air density kg/m3 
    11291215      REAL(wp) ::   zcdrag = 1.5e-3        ! drag coefficient 
     1216      REAL(wp) ::   zgreenland_icesheet_mass_in, zantarctica_icesheet_mass_in  
     1217      REAL(wp) ::   zgreenland_icesheet_mass_b, zantarctica_icesheet_mass_b  
     1218      REAL(wp) ::   zmask_sum, zepsilon     
    11301219      REAL(wp) ::   zzx, zzy               ! temporary variables 
    11311220      REAL(wp), DIMENSION(jpi,jpj) ::   ztx, zty, zmsk, zemp, zqns, zqsr, zcloud_fra 
    11321221      !!---------------------------------------------------------------------- 
     1222      ! 
     1223      ll_wrtstp  = (( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend )) .AND. (nn_print>0) 
    11331224      ! 
    11341225      IF( kt == nit000 ) THEN 
     
    11471238      isec = ( kt - nit000 ) * NINT( rdt )                      ! date of exchanges 
    11481239      DO jn = 1, jprcv                                          ! received fields sent by the atmosphere 
    1149          IF( srcv(jn)%laction )   CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) 
     1240        IF( srcv(jn)%laction ) THEN   
     1241  
     1242          IF ( srcv(jn)%dimensions <= 1 ) THEN  
     1243            CALL cpl_rcv_1d( jn, isec, frcv(jn)%z3, SIZE(frcv(jn)%z3), nrcvinfo(jn) )  
     1244          ELSE  
     1245            CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) )  
     1246          END IF  
     1247 
     1248        END IF  
    11501249      END DO 
    11511250 
     
    14741573         IF( srcv(jpr_fice )%laction )   fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1) 
    14751574         ! 
     1575      ENDIF 
     1576 
     1577      !                                                        ! land ice masses : Greenland 
     1578      zepsilon = rn_iceshelf_fluxes_tolerance 
     1579 
     1580      IF( srcv(jpr_grnm)%laction .AND. nn_coupled_iceshelf_fluxes == 1 ) THEN 
     1581       
     1582         ! This is a zero dimensional, single value field.  
     1583         zgreenland_icesheet_mass_in =  frcv(jpr_grnm)%z3(1,1,1) 
     1584            
     1585         greenland_icesheet_timelapsed = greenland_icesheet_timelapsed + rdt          
     1586 
     1587         IF( ln_iceshelf_init_atmos .AND. kt == 1 ) THEN 
     1588            ! On the first timestep (of an NRUN) force the ocean to ignore the icesheet masses in the ocean restart 
     1589            ! and take them from the atmosphere to avoid problems with using inconsistent ocean and atmosphere restarts. 
     1590            zgreenland_icesheet_mass_b = zgreenland_icesheet_mass_in 
     1591            greenland_icesheet_mass = zgreenland_icesheet_mass_in 
     1592         ENDIF 
     1593 
     1594         IF( ABS( zgreenland_icesheet_mass_in - greenland_icesheet_mass ) > zepsilon ) THEN 
     1595            zgreenland_icesheet_mass_b = greenland_icesheet_mass 
     1596             
     1597            ! Only update the mass if it has increased. 
     1598            IF ( (zgreenland_icesheet_mass_in - greenland_icesheet_mass) > 0.0 ) THEN 
     1599               greenland_icesheet_mass = zgreenland_icesheet_mass_in 
     1600            ENDIF 
     1601             
     1602            IF( zgreenland_icesheet_mass_b /= 0.0 ) & 
     1603           &     greenland_icesheet_mass_rate_of_change = ( greenland_icesheet_mass - zgreenland_icesheet_mass_b ) / greenland_icesheet_timelapsed  
     1604            greenland_icesheet_timelapsed = 0.0_wp        
     1605         ENDIF 
     1606         IF(lwp .AND. ll_wrtstp) THEN 
     1607            WRITE(numout,*) 'Greenland icesheet mass (kg) read in is ', zgreenland_icesheet_mass_in 
     1608            WRITE(numout,*) 'Greenland icesheet mass (kg) used is    ', greenland_icesheet_mass 
     1609            WRITE(numout,*) 'Greenland icesheet mass rate of change (kg/s) is ', greenland_icesheet_mass_rate_of_change 
     1610            WRITE(numout,*) 'Greenland icesheet seconds lapsed since last change is ', greenland_icesheet_timelapsed 
     1611         ENDIF 
     1612      ELSE IF ( nn_coupled_iceshelf_fluxes == 2 ) THEN 
     1613         greenland_icesheet_mass_rate_of_change = rn_greenland_total_fw_flux 
     1614      ENDIF 
     1615 
     1616      !                                                        ! land ice masses : Antarctica 
     1617      IF( srcv(jpr_antm)%laction .AND. nn_coupled_iceshelf_fluxes == 1 ) THEN 
     1618          
     1619         ! This is a zero dimensional, single value field.  
     1620         zantarctica_icesheet_mass_in = frcv(jpr_antm)%z3(1,1,1) 
     1621            
     1622         antarctica_icesheet_timelapsed = antarctica_icesheet_timelapsed + rdt          
     1623 
     1624         IF( ln_iceshelf_init_atmos .AND. kt == 1 ) THEN 
     1625            ! On the first timestep (of an NRUN) force the ocean to ignore the icesheet masses in the ocean restart 
     1626            ! and take them from the atmosphere to avoid problems with using inconsistent ocean and atmosphere restarts. 
     1627            zantarctica_icesheet_mass_b = zantarctica_icesheet_mass_in 
     1628            antarctica_icesheet_mass = zantarctica_icesheet_mass_in 
     1629         ENDIF 
     1630 
     1631         IF( ABS( zantarctica_icesheet_mass_in - antarctica_icesheet_mass ) > zepsilon ) THEN 
     1632            zantarctica_icesheet_mass_b = antarctica_icesheet_mass 
     1633             
     1634            ! Only update the mass if it has increased. 
     1635            IF ( (zantarctica_icesheet_mass_in - antarctica_icesheet_mass) > 0.0 ) THEN 
     1636               antarctica_icesheet_mass = zantarctica_icesheet_mass_in 
     1637            END IF 
     1638             
     1639            IF( zantarctica_icesheet_mass_b /= 0.0 ) & 
     1640          &      antarctica_icesheet_mass_rate_of_change = ( antarctica_icesheet_mass - zantarctica_icesheet_mass_b ) / antarctica_icesheet_timelapsed  
     1641            antarctica_icesheet_timelapsed = 0.0_wp        
     1642         ENDIF 
     1643         IF(lwp .AND. ll_wrtstp) THEN 
     1644            WRITE(numout,*) 'Antarctica icesheet mass (kg) read in is ', zantarctica_icesheet_mass_in 
     1645            WRITE(numout,*) 'Antarctica icesheet mass (kg) used is    ', antarctica_icesheet_mass 
     1646            WRITE(numout,*) 'Antarctica icesheet mass rate of change (kg/s) is ', antarctica_icesheet_mass_rate_of_change 
     1647            WRITE(numout,*) 'Antarctica icesheet seconds lapsed since last change is ', antarctica_icesheet_timelapsed 
     1648         ENDIF 
     1649      ELSE IF ( nn_coupled_iceshelf_fluxes == 2 ) THEN 
     1650         antarctica_icesheet_mass_rate_of_change = rn_antarctica_total_fw_flux 
    14761651      ENDIF 
    14771652      ! 
     
    17461921       
    17471922      ! --- Continental fluxes --- ! 
    1748       IF( srcv(jpr_rnf)%laction ) THEN   ! runoffs (included in emp later on) 
     1923      IF( srcv(jpr_rnf)%laction ) THEN   ! 2D runoffs (included in emp later on) 
    17491924         rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
     1925      ENDIF 
     1926      IF( srcv(jpr_rnf_1d)%laction ) THEN ! 1D runoff 
     1927         CALL cpl_rnf_1d_to_2d(frcv(jpr_rnf_1d)%z3(:,:,:)) 
    17501928      ENDIF 
    17511929      IF( srcv(jpr_cal)%laction ) THEN   ! calving (put in emp_tot and emp_oce) 
     
    17861964      zsnw(:,:) = picefr(:,:) 
    17871965      ! --- Continental fluxes --- ! 
    1788       IF( srcv(jpr_rnf)%laction ) THEN   ! runoffs (included in emp later on) 
     1966      IF( srcv(jpr_rnf)%laction ) THEN   ! 2D runoffs (included in emp later on) 
    17891967         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(:,:,:))  
    17901971      ENDIF 
    17911972      IF( srcv(jpr_cal)%laction ) THEN   ! calving (put in emp_tot) 
  • NEMO/branches/UKMO/NEMO_4.0.3_icesheet_and_river_coupling/src/OCE/SBC/sbcisf.F90

    r13587 r13778  
    9292      INTEGER ::   ji, jj, jk   ! loop index 
    9393      INTEGER ::   ikt, ikb     ! local integers 
     94      REAL(wp)                     ::   zgreenland_fwfisf_sum, zantarctica_fwfisf_sum  
    9495      REAL(wp), DIMENSION(jpi,jpj) ::   zt_frz, zdep   ! freezing temperature (zt_frz) at depth (zdep)  
    9596      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   zqhcisf2d 
    9697      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   zfwfisf3d, zqhcisf3d, zqlatisf3d 
     98      LOGICAL :: ll_wrtstp 
    9799      !!--------------------------------------------------------------------- 
    98100      ! 
     101      ll_wrtstp  = (( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend )) .AND. (nn_print>0) 
    99102      IF( MOD( kt-1, nn_fsbc) == 0 ) THEN    ! compute salt and heat flux 
    100103         ! 
     
    127130               fwfisf(:,:) = - sf_rnfisf(1)%fnow(:,:,1)         ! fresh water flux from the isf (fwfisf <0 mean melting)  
    128131            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 
    129173            qisf(:,:)   = fwfisf(:,:) * rLfusisf             ! heat flux 
    130174            stbl(:,:)   = soce 
     
    137181               fwfisf(:,:) = -sf_fwfisf(1)%fnow(:,:,1)            ! fwf 
    138182            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 
    139224            qisf(:,:)   = fwfisf(:,:) * rLfusisf               ! heat flux 
    140225            stbl(:,:)   = soce 
Note: See TracChangeset for help on using the changeset viewer.