Changeset 10065 for NEMO/trunk/src/OCE/ICB/icbrst.F90
 Timestamp:
 20180823T18:14:54+02:00 (6 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

NEMO/trunk/src/OCE/ICB/icbrst.F90
r9932 r10065 60 60 INTEGER :: idim, ivar, iatt 61 61 INTEGER :: jn, iunlim_dim, ibergs_in_file 62 INTEGER :: ii, ij,iclass62 INTEGER :: ii, ij, iclass, ibase_err, imax_icb 63 63 REAL(wp), DIMENSION(nkounts) :: zdata 64 64 LOGICAL :: ll_found_restart … … 77 77 CALL iom_open( TRIM(cl_path)//cl_filename, ncid ) 78 78 79 imax_icb = 0 79 80 IF( iom_file(ncid)%iduld .GE. 0) THEN 80 81 … … 96 97 CALL iom_get( ncid, jpdom_unknown, 'number' , zdata(:) , ktime=jn, kstart=(/1/), kcount=(/nkounts/) ) 97 98 localberg%number(:) = INT(zdata(:)) 99 imax_icb = MAX( imax_icb, INT(zdata(1)) ) 98 100 CALL iom_get( ncid, 'mass_scaling' , localberg%mass_scaling, ktime=jn ) 99 101 CALL iom_get( ncid, 'lon' , localpt%lon , ktime=jn ) … … 129 131 CALL iom_get( ncid, jpdom_unknown, 'kount' , zdata(:) ) 130 132 num_bergs(:) = INT(zdata(:)) 131 132 ! Sanity check 133 ! Close file 134 CALL iom_close( ncid ) 135 ! 136 137 ! Sanity checks 133 138 jn = icb_utl_count() 134 139 IF ( lwp .AND. nn_verbose_level >= 0 ) & … … 142 147 & ' bergs in the restart file and', jn,' bergs have been read' 143 148 ! 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 146 177 ! 147 178 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.