Changeset 10065


Ignore:
Timestamp:
2018-08-23T18:14:54+02:00 (2 years ago)
Author:
acc
Message:

Additional sanity checks in icbrst.F90 to avoid the risk of generating duplicate iceberg_numbers when restarting from a collated iceberg restart file. See ticket #2128

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/OCE/ICB/icbrst.F90

    r9932 r10065  
    6060      INTEGER                      ::   idim, ivar, iatt 
    6161      INTEGER                      ::   jn, iunlim_dim, ibergs_in_file 
    62       INTEGER                      ::   ii,ij,iclass 
     62      INTEGER                      ::   ii, ij, iclass, ibase_err, imax_icb 
    6363      REAL(wp), DIMENSION(nkounts) ::   zdata       
    6464      LOGICAL                      ::   ll_found_restart 
     
    7777      CALL iom_open( TRIM(cl_path)//cl_filename, ncid ) 
    7878 
     79      imax_icb = 0 
    7980      IF( iom_file(ncid)%iduld .GE. 0) THEN 
    8081 
     
    9697               CALL iom_get( ncid, jpdom_unknown, 'number'       , zdata(:) , ktime=jn, kstart=(/1/), kcount=(/nkounts/) ) 
    9798               localberg%number(:) = INT(zdata(:)) 
     99               imax_icb = MAX( imax_icb, INT(zdata(1)) ) 
    98100               CALL iom_get( ncid, 'mass_scaling' , localberg%mass_scaling, ktime=jn ) 
    99101               CALL iom_get( ncid, 'lon'          , localpt%lon           , ktime=jn ) 
     
    129131      CALL iom_get( ncid, jpdom_unknown, 'kount' , zdata(:) ) 
    130132      num_bergs(:) = INT(zdata(:)) 
    131  
    132       ! Sanity check 
     133      ! Close file 
     134      CALL iom_close( ncid ) 
     135      ! 
     136 
     137      ! Sanity checks 
    133138      jn = icb_utl_count() 
    134139      IF ( lwp .AND. nn_verbose_level >= 0 )   & 
     
    142147         &                                    ' bergs in the restart file and', jn,' bergs have been read' 
    143148      ! 
    144       ! Finish up 
    145       CALL iom_close( ncid ) 
     149      ! Confirm that all areas have a suitable base for assigning new iceberg 
     150      ! numbers. This will not be the case if restarting from a collated dataset 
     151      ! (even if using the same processor decomposition) 
     152      ! 
     153      ibase_err = 0 
     154      IF( num_bergs(1) < 0 .AND. num_bergs(1) /= narea - jpnij ) THEN 
     155         ! If this area has never calved a new berg then the base should be 
     156         ! set to narea - jpnij. If it is negative but something else then 
     157         ! a new base will be needed to guarantee unique, future iceberg numbers 
     158         ibase_err = 1 
     159      ELSEIF( MOD( num_bergs(1) - narea , jpnij ) /= 0 ) THEN 
     160         ! If this area has a base which is not in the set {narea + N*jpnij} 
     161         ! for positive integers N then a new base will be needed to guarantee  
     162         ! unique, future iceberg numbers 
     163         ibase_err = 1 
     164      ENDIF 
     165      IF( lk_mpp ) THEN 
     166         CALL mpp_sum(ibase_err) 
     167      ENDIF 
     168      IF( ibase_err > 0 ) THEN 
     169         !  
     170         ! A new base is needed. The only secure solution is to set bases such that 
     171         ! all future icebergs numbers will be greater than the current global maximum 
     172         IF( lk_mpp ) THEN 
     173            CALL mpp_max(imax_icb) 
     174         ENDIF 
     175         num_bergs(1) = imax_icb - jpnij + narea 
     176      ENDIF 
    146177      ! 
    147178      IF( lwp .AND. nn_verbose_level >= 0 )  WRITE(numout,'(a)') 'icebergs, icb_rst_read: completed' 
Note: See TracChangeset for help on using the changeset viewer.