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 15662 – NEMO

Changeset 15662


Ignore:
Timestamp:
2022-01-19T19:47:22+01:00 (2 years ago)
Author:
jpalmier
Message:

6th and 7th merge : fix a ip and icesheet-river coupling

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  
    332332 
    333333          <!-- * variable related to ice shelf forcing * --> 
     334          <field id="berg_calve"   long_name="Iceberg calving"                               unit="kg/m2/s"  />  
    334335          <field id="fwfisf"       long_name="Ice shelf melting"                             unit="kg/m2/s"  /> 
    335336          <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  
    293293   ln_scale_ice_flux = .false. !  use ice fluxes that are already "ice weighted" ( i.e. multiplied ice concentration) 
    294294   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 
    295309   !_____________!__________________________!____________!_____________!______________________!________! 
    296310   !             !        description       !  multiple  !    vector   !       vector         ! vector ! 
     
    319333   sn_rcv_emp    =   'conservative'         ,    'no'    ,     ''      ,         ''           ,   '' 
    320334   sn_rcv_rnf    =   'coupled'              ,    'no'    ,     ''      ,         ''           ,   '' 
     335   sn_rcv_antm   =   'none'                 ,    'no'    ,     ''      ,         ''           ,   '' 
     336   sn_rcv_grnm   =   'none'                 ,    'no'    ,     ''      ,         ''           ,   '' 
    321337   sn_rcv_cal    =   'coupled'              ,    'no'    ,     ''      ,         ''           ,   '' 
    322338   sn_rcv_co2    =   'coupled'              ,    'no'    ,     ''      ,         ''           ,   '' 
     
    419435      rn_dep_max  = 150.      !  depth over which runoffs is spread ( ln_rnf_depth_ini = .true ) 
    420436      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 
    422439 
    423440   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  
    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.4_GO8_paquage_branch/src/OCE/IOM/iom.F90

    r15658 r15662  
    4747   USE lib_fortran  
    4848   USE diurnal_bulk, ONLY : ln_diurnal_only, ln_diurnal 
     49   USE timing 
    4950 
    5051   IMPLICIT NONE 
     
    15321533      LOGICAL :: llx                ! local xios write flag 
    15331534      INTEGER :: ivid   ! variable id 
     1535       
     1536      IF (ln_timing) CALL timing_start('iom_rst_put') 
    15341537 
    15351538      llx = .FALSE. 
     
    15501553         ENDIF 
    15511554      ENDIF 
     1555      IF (ln_timing) CALL timing_stop('iom_rst_put') 
    15521556   END SUBROUTINE iom_rp0d 
    15531557 
     
    15631567      INTEGER :: ivid   ! variable id 
    15641568 
     1569      IF (ln_timing) CALL timing_start('iom_rst_put') 
    15651570      llx = .FALSE. 
    15661571      IF(PRESENT(ldxios)) llx = ldxios 
     
    15801585         ENDIF 
    15811586      ENDIF 
     1587      IF (ln_timing) CALL timing_stop('iom_rst_put') 
    15821588   END SUBROUTINE iom_rp1d 
    15831589 
     
    15931599      INTEGER :: ivid   ! variable id 
    15941600 
     1601      IF (ln_timing) CALL timing_start('iom_rst_put') 
    15951602      llx = .FALSE. 
    15961603      IF(PRESENT(ldxios)) llx = ldxios 
     
    16101617         ENDIF 
    16111618      ENDIF 
     1619      IF (ln_timing) CALL timing_stop('iom_rst_put') 
    16121620   END SUBROUTINE iom_rp2d 
    16131621 
     
    16231631      INTEGER :: ivid   ! variable id 
    16241632 
     1633      IF (ln_timing) CALL timing_start('iom_rst_put') 
    16251634      llx = .FALSE. 
    16261635      IF(PRESENT(ldxios)) llx = ldxios 
     
    16401649         ENDIF 
    16411650      ENDIF 
     1651      IF (ln_timing) CALL timing_stop('iom_rst_put') 
    16421652   END SUBROUTINE iom_rp3d 
    16431653 
  • NEMO/branches/UKMO/NEMO_4.0.4_GO8_paquage_branch/src/OCE/IOM/restart.F90

    r15658 r15662  
    3030   USE diurnal_bulk 
    3131   USE lib_mpp         ! distribued memory computing library 
     32   USE sbc_oce         ! for icesheet freshwater input variables  
    3233 
    3334   IMPLICIT NONE 
     
    172173                     CALL iom_rstput( kt, nitrst, numrow, 'sshn'   , sshn, ldxios = lwxios      ) 
    173174                     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 
    174187                  ! extra variable needed for the ice sheet coupling 
    175188                  IF ( ln_iscpl ) THEN  
     
    320333      ENDIF 
    321334      ! 
     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      ! 
    322354      IF( neuler == 0 ) THEN                                  ! Euler restart (neuler=0) 
    323355         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  
    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 
     
    8297      INTEGER               ::   nct       ! Number of categories in field 
    8398      INTEGER               ::   ncplmodel ! Maximum number of models to/from which this variable may be sent/received 
     99      INTEGER               ::   dimensions ! Number of dimensions of coupling field  
    84100   END TYPE FLD_CPL 
    85101 
     
    106122      CHARACTER(len = *), INTENT(in   ) ::   cd_modname   ! model name as set in namcouple file 
    107123      INTEGER           , INTENT(  out) ::   kl_comm      ! local communicator of the model 
     124      INTEGER                           ::   error 
    108125      !!-------------------------------------------------------------------- 
    109126 
     
    142159      ! 
    143160      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  
    144164      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).   
    146173      INTEGER :: ji,jc,jm       ! local loop indicees 
    147174      CHARACTER(LEN=64) :: zclname 
     
    199226      ishape(3) = 1 
    200227      ishape(4) = nlej-nldj+1 
     228 
     229      ishape0d1d(1) = 0  
     230      ishape0d1d(2) = 0  
    201231      ! 
    202232      ! ... Allocate memory for data exchange 
     
    225255    
    226256      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 
    227287      ! 
    228288      ! ... Announce send variables.  
     
    303363#endif 
    304364                  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 
    307402                  IF ( nerror /= OASIS_Ok ) THEN 
    308403                     WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 
     
    505600 
    506601 
     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 
    507709   INTEGER FUNCTION cpl_freq( cdfieldname )   
    508710      !!--------------------------------------------------------------------- 
     
    612814   SUBROUTINE oasis_def_var(k1,cd1,k2,k3,k4,k5,k6,k7) 
    613815      CHARACTER(*), INTENT(in   ) ::  cd1 
    614       INTEGER     , INTENT(in   ) ::  k2,k3(2),k4,k5(2,2),k6 
     816      INTEGER     , INTENT(in   ) ::  k2,k3(2),k4,k5(*),k6 
    615817      INTEGER     , INTENT(  out) ::  k1,k7 
    616818      k1 = -1 ; k7 = -1 
     
    632834   END SUBROUTINE oasis_put 
    633835 
    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) 
    635845      REAL(wp), DIMENSION(:,:), INTENT(  out) ::  p1 
    636846      INTEGER                 , INTENT(in   ) ::  k1,k2 
    637847      INTEGER                 , INTENT(  out) ::  k3 
    638848      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 
    641851 
    642852   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  
    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.4_GO8_paquage_branch/src/OCE/SBC/sbccpl.F90

    r15661 r15662  
    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 
     
    4849   USE lib_mpp        ! distribued memory computing library 
    4950   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     51   USE timing         ! timing 
    5052 
    5153#if defined key_oasis3  
     
    120122   INTEGER, PARAMETER ::   jpr_tauwy  = 56   ! y component of the ocean stress from waves 
    121123   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 
    124130 
    125131   INTEGER, PARAMETER ::   jps_fice   =  1   ! ice fraction sent to the atmosphere 
     
    186192   TYPE(FLD_C) ::   sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_tauw, sn_rcv_dqnsdt, sn_rcv_qsr,  & 
    187193      &             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 
    189196   ! Send to waves  
    190197   TYPE(FLD_C) ::   sn_snd_ifrac, sn_snd_crtw, sn_snd_wlev  
     
    277284         &                  sn_rcv_iceflx, sn_rcv_co2   , sn_rcv_mslp ,                                & 
    278285         &                  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 
    280292      !!--------------------------------------------------------------------- 
    281293      ! 
     
    284296      ! ================================ ! 
    285297      ! 
     298      IF (ln_timing) CALL timing_start('sbc_cpl_init') 
    286299      REWIND( numnam_ref )              ! Namelist namsbc_cpl in reference namelist : Variables for OASIS coupling 
    287300      READ  ( numnam_ref, namsbc_cpl, IOSTAT = ios, ERR = 901) 
     
    316329         WRITE(numout,*)'      runoffs                         = ', TRIM(sn_rcv_rnf%cldes   ), ' (', TRIM(sn_rcv_rnf%clcat   ), ')' 
    317330         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  ), ')'  
    318333         WRITE(numout,*)'      iceberg                         = ', TRIM(sn_rcv_icb%cldes   ), ' (', TRIM(sn_rcv_icb%clcat   ), ')' 
    319334         WRITE(numout,*)'      ice shelf                       = ', TRIM(sn_rcv_isf%cldes   ), ' (', TRIM(sn_rcv_isf%clcat   ), ')' 
     
    351366         WRITE(numout,*)'                      - orientation   = ', sn_snd_crtw%clvor  
    352367         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 
    353375      ENDIF 
    354376 
     
    366388 
    367389      ! 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  
    369395 
    370396      !                                                      ! ------------------------- ! 
     
    489515      !                                                      ! ------------------------- ! 
    490516      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  
    493524         l_rnfcpl              = .TRUE.                      ! -> no need to read runoffs in sbcrnf 
    494525         ln_rnf                = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas 
     
    497528      ENDIF 
    498529      ! 
    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 
    500545      srcv(jpr_isf)%clname = 'OIcshelf'   ;  IF( TRIM( sn_rcv_isf%cldes) == 'coupled' )   srcv(jpr_isf)%laction = .TRUE. 
    501546      srcv(jpr_icb)%clname = 'OIceberg'   ;  IF( TRIM( sn_rcv_icb%cldes) == 'coupled' )   srcv(jpr_icb)%laction = .TRUE. 
     
    748793         ENDIF 
    749794      ENDIF 
    750        
    751       ! =================================================== ! 
    752       ! Allocate all parts of frcv used for received fields ! 
    753       ! =================================================== ! 
    754       DO jn = 1, jprcv 
    755          IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 
    756       END DO 
    757       ! Allocate taum part of frcv which is used even when not received as coupling field 
    758       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 field 
    760       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 field 
    762       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 ) THEN 
    766          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 IF 
    769795 
    770796      ! ================================ ! 
     
    776802       
    777803      ! 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  
    779809          
    780810      !                                                      ! ------------------------- ! 
     
    10591089      ENDIF 
    10601090 
     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 
    10611129      ! 
    10621130      ! ================================ ! 
     
    10761144      ENDIF 
    10771145      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') 
    10781167      ! 
    10791168   END SUBROUTINE sbc_cpl_init 
     
    11381227      REAL(wp) ::   zcumulneg, zcumulpos   ! temporary scalars      
    11391228      REAL(wp) ::   zcoef                  ! temporary scalar 
     1229      LOGICAL  ::   ll_wrtstp              ! write diagnostics? 
    11401230      REAL(wp) ::   zrhoa  = 1.22          ! Air density kg/m3 
    11411231      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     
    11421235      REAL(wp) ::   zzx, zzy               ! temporary variables 
    11431236      REAL(wp), DIMENSION(jpi,jpj) ::   ztx, zty, zmsk, zemp, zqns, zqsr, zcloud_fra 
    11441237      !!---------------------------------------------------------------------- 
     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) 
    11451243      ! 
    11461244      IF( kt == nit000 ) THEN 
     
    11591257      isec = ( kt - nit000 ) * NINT( rdt )                      ! date of exchanges 
    11601258      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  
    11621268      END DO 
    11631269 
     
    15091615         ! 
    15101616      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') 
    15121695   END SUBROUTINE sbc_cpl_rcv 
    15131696    
     
    15531736      !!---------------------------------------------------------------------- 
    15541737      ! 
     1738      IF (ln_timing) CALL timing_start('sbc_cpl_snd') 
    15551739      IF( srcv(jpr_itx1)%laction ) THEN   ;   itx =  jpr_itx1    
    15561740      ELSE                                ;   itx =  jpr_otx1 
     
    17801964       
    17811965      ! --- 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) 
    17831967         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(:,:,:)) 
    17841971      ENDIF 
    17851972      IF( srcv(jpr_cal)%laction ) THEN   ! calving (put in emp_tot and emp_oce) 
     
    18202007      zsnw(:,:) = picefr(:,:) 
    18212008      ! --- 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) 
    18232010         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(:,:,:))  
    18242014      ENDIF 
    18252015      IF( srcv(jpr_cal)%laction ) THEN   ! calving (put in emp_tot) 
     
    27422932#endif 
    27432933      ! 
     2934      IF (ln_timing) CALL timing_stop('sbc_cpl_snd') 
    27442935   END SUBROUTINE sbc_cpl_snd 
    27452936    
  • NEMO/branches/UKMO/NEMO_4.0.4_GO8_paquage_branch/src/OCE/SBC/sbcisf.F90

    r15658 r15662  
    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 
  • NEMO/branches/UKMO/NEMO_4.0.4_GO8_paquage_branch/src/OCE/SBC/sbcrnf.F90

    r15658 r15662  
    4242   REAL(wp)                   ::      rn_rnf_max        !: maximum value of the runoff climatologie (ln_rnf_depth_ini =T) 
    4343   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) 
    4445   INTEGER                    ::      nn_rnf_depth_file !: create (=1) a runoff depth file or not (=0) 
    4546   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 
    4648   LOGICAL                    ::   ln_rnf_tem        !: temperature river runoffs attribute specified in a file 
    4749   LOGICAL           , PUBLIC ::   ln_rnf_sal        !: salinity    river runoffs attribute specified in a file 
     
    109111      !!---------------------------------------------------------------------- 
    110112      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 
    111115      ! 
    112116      ! 
     
    118122      IF( .NOT. l_rnfcpl )  THEN 
    119123                            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 required 
    121       ENDIF 
     124      ENDIF 
     125      IF(   ln_rnf_icb   )   CALL fld_read ( kt, nn_fsbc, sf_i_rnf )    ! idem for iceberg flux if required 
    122126      IF(   ln_rnf_tem   )   CALL fld_read ( kt, nn_fsbc, sf_t_rnf )    ! idem for runoffs temperature if required 
    123127      IF(   ln_rnf_sal   )   CALL fld_read ( kt, nn_fsbc, sf_s_rnf )    ! idem for runoffs salinity    if required 
     
    127131         IF( .NOT. l_rnfcpl ) THEN 
    128132             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 
    134169         ENDIF 
    135170         ! 
     
    257292      REAL(wp), DIMENSION(jpi,jpj,2) :: zrnfcl     
    258293      !! 
    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,  & 
    260295         &                 sn_rnf, sn_cnf    , sn_i_rnf, sn_s_rnf    , sn_t_rnf  , sn_dep_rnf,   & 
    261296         &                 ln_rnf_mouth      , rn_hrnf     , rn_avt_rnf, rn_rfact,     & 
     
    315350         CALL fld_fill( sf_rnf, (/ sn_rnf /), cn_dir, 'sbc_rnf_init', 'read runoffs data', 'namsbc_rnf', no_print ) 
    316351         ! 
    317          IF( ln_rnf_icb ) THEN                      ! Create (if required) sf_i_rnf structure 
    318             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 ) THEN 
    322                CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_i_rnf structure' )   ;   RETURN 
    323             ENDIF 
    324             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          ELSE 
    328             fwficb(:,:) = 0._wp 
    329          ENDIF 
    330  
    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 
    332367      ! 
    333368      IF( ln_rnf_tem ) THEN                      ! Create (if required) sf_t_rnf structure 
Note: See TracChangeset for help on using the changeset viewer.