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 10843 for NEMO/branches/UKMO/dev_r10037_GPU/src/OCE/ICB/icbrst.F90 – NEMO

Ignore:
Timestamp:
2019-04-05T16:01:32+02:00 (5 years ago)
Author:
andmirek
Message:

ticket #2197 merge with dev_r9950_GO8_package at 10320

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/dev_r10037_GPU/src/OCE/ICB/icbrst.F90

    r9950 r10843  
    2525   USE netcdf         ! netcdf routines for IO 
    2626   USE iom 
     27   USE ioipsl, ONLY : ju2ymds    ! for calendar 
    2728   USE icb_oce        ! define iceberg arrays 
    2829   USE icbutl         ! iceberg utility routines 
     
    4647   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    4748   !! $Id$ 
    48    !! Software governed by the CeCILL licence     (./LICENSE) 
     49   !! Software governed by the CeCILL license (see ./LICENSE) 
    4950   !!---------------------------------------------------------------------- 
    5051CONTAINS 
     
    6061      INTEGER                      ::   idim, ivar, iatt 
    6162      INTEGER                      ::   jn, iunlim_dim, ibergs_in_file 
    62       INTEGER                      ::   ii,ij,iclass 
     63      INTEGER                      ::   ii, ij, iclass, ibase_err, imax_icb 
    6364      REAL(wp), DIMENSION(nkounts) ::   zdata       
    6465      LOGICAL                      ::   ll_found_restart 
     
    7778      CALL iom_open( TRIM(cl_path)//cl_filename, ncid ) 
    7879 
     80      imax_icb = 0 
    7981      IF( iom_file(ncid)%iduld .GE. 0) THEN 
    8082 
     
    9698               CALL iom_get( ncid, jpdom_unknown, 'number'       , zdata(:) , ktime=jn, kstart=(/1/), kcount=(/nkounts/) ) 
    9799               localberg%number(:) = INT(zdata(:)) 
     100               imax_icb = MAX( imax_icb, INT(zdata(1)) ) 
    98101               CALL iom_get( ncid, 'mass_scaling' , localberg%mass_scaling, ktime=jn ) 
    99102               CALL iom_get( ncid, 'lon'          , localpt%lon           , ktime=jn ) 
     
    129132      CALL iom_get( ncid, jpdom_unknown, 'kount' , zdata(:) ) 
    130133      num_bergs(:) = INT(zdata(:)) 
    131  
    132       ! Sanity check 
     134      ! Close file 
     135      CALL iom_close( ncid ) 
     136      ! 
     137 
     138      ! Sanity checks 
    133139      jn = icb_utl_count() 
    134140      IF ( lwp .AND. nn_verbose_level >= 0 )   & 
     
    142148         &                                    ' bergs in the restart file and', jn,' bergs have been read' 
    143149      ! 
    144       ! Finish up 
    145       CALL iom_close( ncid ) 
     150      ! Confirm that all areas have a suitable base for assigning new iceberg 
     151      ! numbers. This will not be the case if restarting from a collated dataset 
     152      ! (even if using the same processor decomposition) 
     153      ! 
     154      ibase_err = 0 
     155      IF( num_bergs(1) < 0 .AND. num_bergs(1) /= narea - jpnij ) THEN 
     156         ! If this area has never calved a new berg then the base should be 
     157         ! set to narea - jpnij. If it is negative but something else then 
     158         ! a new base will be needed to guarantee unique, future iceberg numbers 
     159         ibase_err = 1 
     160      ELSEIF( MOD( num_bergs(1) - narea , jpnij ) /= 0 ) THEN 
     161         ! If this area has a base which is not in the set {narea + N*jpnij} 
     162         ! for positive integers N then a new base will be needed to guarantee  
     163         ! unique, future iceberg numbers 
     164         ibase_err = 1 
     165      ENDIF 
     166      IF( lk_mpp ) THEN 
     167         CALL mpp_sum(ibase_err) 
     168      ENDIF 
     169      IF( ibase_err > 0 ) THEN 
     170         !  
     171         ! A new base is needed. The only secure solution is to set bases such that 
     172         ! all future icebergs numbers will be greater than the current global maximum 
     173         IF( lk_mpp ) THEN 
     174            CALL mpp_max(imax_icb) 
     175         ENDIF 
     176         num_bergs(1) = imax_icb - jpnij + narea 
     177      ENDIF 
    146178      ! 
    147179      IF( lwp .AND. nn_verbose_level >= 0 )  WRITE(numout,'(a)') 'icebergs, icb_rst_read: completed' 
     
    159191      INTEGER ::   jn   ! dummy loop index 
    160192      INTEGER ::   ix_dim, iy_dim, ik_dim, in_dim 
    161       CHARACTER(len=256)     :: cl_path 
    162       CHARACTER(len=256)     :: cl_filename 
     193      INTEGER             ::   iyear, imonth, iday 
     194      REAL (wp)           ::   zsec 
     195      REAL (wp)           ::   zfjulday 
     196      CHARACTER(len=256)  :: cl_path 
     197      CHARACTER(len=256)  :: cl_filename 
     198      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character 
    163199      TYPE(iceberg), POINTER :: this 
    164200      TYPE(point)  , POINTER :: pt 
     
    175211         cl_path = TRIM(cn_ocerst_outdir) 
    176212         IF( cl_path(LEN_TRIM(cl_path):) /= '/' ) cl_path = TRIM(cl_path) // '/' 
     213         IF ( ln_rstdate ) THEN 
     214            zfjulday = fjulday + rdt / rday 
     215            IF( ABS(zfjulday - REAL(NINT(zfjulday),wp)) < 0.1 / rday )   zfjulday = REAL(NINT(zfjulday),wp)   ! avoid truncation error 
     216            CALL ju2ymds( zfjulday, iyear, imonth, iday, zsec )            
     217            WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday 
     218         ELSE 
     219            IF( kt > 999999999 ) THEN   ;   WRITE(clkt, *       ) kt 
     220            ELSE                        ;   WRITE(clkt, '(i8.8)') kt 
     221            ENDIF 
     222         ENDIF 
    177223         IF( lk_mpp ) THEN 
    178             WRITE(cl_filename,'(A,"_icebergs_",I8.8,"_restart_",I4.4,".nc")') TRIM(cexper), kt, narea-1 
     224            WRITE(cl_filename,'(A,"_icebergs_",A,"_restart_",I4.4,".nc")') TRIM(cexper), TRIM(ADJUSTL(clkt)), narea-1 
    179225         ELSE 
    180             WRITE(cl_filename,'(A,"_icebergs_",I8.8,"_restart.nc")') TRIM(cexper), kt 
     226            WRITE(cl_filename,'(A,"_icebergs_",A,"_restart.nc")') TRIM(cexper), TRIM(ADJUSTL(clkt)) 
    181227         ENDIF 
    182228         IF ( lwp .AND. nn_verbose_level >= 0) WRITE(numout,'(2a)') 'icebergs, write_restart: creating ',  & 
Note: See TracChangeset for help on using the changeset viewer.