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 9817 for branches/UKMO/dev_r5518_nemo2cice_prints/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90 – NEMO

Ignore:
Timestamp:
2018-06-21T11:58:42+02:00 (6 years ago)
Author:
dancopsey
Message:

Merged in GO6 package branch up to revision 8356.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_nemo2cice_prints/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90

    r9816 r9817  
    1212   !!            -    !                            Currently needs a fixed processor 
    1313   !!            -    !                            layout between restarts 
     14   !!            -    !  2015-11  Dave Storkey     Convert icb_rst_read to use IOM so can 
     15   !!                                              read single restart files 
    1416   !!---------------------------------------------------------------------- 
    1517   !!---------------------------------------------------------------------- 
     
    1820   !!---------------------------------------------------------------------- 
    1921   USE par_oce        ! NEMO parameters 
     22   USE phycst         ! for rday 
    2023   USE dom_oce        ! NEMO domain 
    2124   USE in_out_manager ! NEMO IO routines 
     25   USE ioipsl, ONLY : ju2ymds    ! for calendar 
    2226   USE lib_mpp        ! NEMO MPI library, lk_mpp in particular 
    2327   USE netcdf         ! netcdf routines for IO 
     28   USE iom 
    2429   USE icb_oce        ! define iceberg arrays 
    2530   USE icbutl         ! iceberg utility routines 
     
    5762      INTEGER                      ::   idim, ivar, iatt 
    5863      INTEGER                      ::   jn, iunlim_dim, ibergs_in_file 
    59       INTEGER                      ::   iclass 
    60       INTEGER, DIMENSION(1)        ::   istrt, ilngth, idata 
    61       INTEGER, DIMENSION(2)        ::   istrt2, ilngth2 
    62       INTEGER, DIMENSION(nkounts)  ::   idata2 
    63       REAL(wp), DIMENSION(1)       ::   zdata                                         ! need 1d array to read in with 
    64                                                                                             ! start and count arrays 
     64      INTEGER                      ::   ii,ij,iclass 
     65      REAL(wp), DIMENSION(nkounts) ::   zdata       
    6566      LOGICAL                      ::   ll_found_restart 
    6667      CHARACTER(len=256)           ::   cl_path 
     
    7172      !!---------------------------------------------------------------------- 
    7273 
    73       ! Find a restart file. Assume iceberg restarts in same directory as ocean restarts.  
     74      ! Find a restart file. Assume iceberg restarts in same directory as ocean restarts 
     75      ! and are called TRIM(cn_ocerst)//'_icebergs' 
    7476      cl_path = TRIM(cn_ocerst_indir) 
    7577      IF( cl_path(LEN_TRIM(cl_path):) /= '/' ) cl_path = TRIM(cl_path) // '/' 
    76       cl_filename = ' ' 
    77       IF ( lk_mpp ) THEN 
    78          cl_filename = ' ' 
    79          WRITE( cl_filename, '("restart_icebergs_",I4.4,".nc")' ) narea-1 
    80          INQUIRE( file=TRIM(cl_path)//TRIM(cl_filename), exist=ll_found_restart ) 
    81       ELSE 
    82          cl_filename = 'restart_icebergs.nc' 
    83          INQUIRE( file=TRIM(cl_path)//TRIM(cl_filename), exist=ll_found_restart ) 
    84       ENDIF 
    85  
    86       IF ( .NOT. ll_found_restart) THEN                     ! only do the following if a file was found 
    87          CALL ctl_stop('icebergs: no restart file found') 
    88       ENDIF 
    89  
    90       IF (nn_verbose_level >= 0 .AND. lwp)  & 
    91          WRITE(numout,'(2a)') 'icebergs, read_restart_bergs: found restart file = ',TRIM(cl_path)//TRIM(cl_filename) 
    92  
    93       nret = NF90_OPEN(TRIM(cl_path)//TRIM(cl_filename), NF90_NOWRITE, ncid) 
    94       IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, read_restart_bergs: nf_open failed') 
    95  
    96       nret = nf90_inquire(ncid, idim, ivar, iatt, iunlim_dim) 
    97       IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, read_restart_bergs: nf_inquire failed') 
    98  
    99       IF( iunlim_dim .NE. -1) THEN 
    100  
    101          nret = nf90_inquire_dimension(ncid, iunlim_dim, cl_dname, ibergs_in_file) 
    102          IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, read_restart_bergs: nf_inq_dimlen failed') 
    103  
    104          nret = NF90_INQ_VARID(ncid, 'number', numberid) 
    105          nret = NF90_INQ_VARID(ncid, 'mass_scaling', nscaling_id) 
    106          nret = NF90_INQ_VARID(ncid, 'xi', nxid) 
    107          nret = NF90_INQ_VARID(ncid, 'yj', nyid) 
    108          nret = NF90_INQ_VARID(ncid, 'lon', nlonid) 
    109          nret = NF90_INQ_VARID(ncid, 'lat', nlatid) 
    110          nret = NF90_INQ_VARID(ncid, 'uvel', nuvelid) 
    111          nret = NF90_INQ_VARID(ncid, 'vvel', nvvelid) 
    112          nret = NF90_INQ_VARID(ncid, 'mass', nmassid) 
    113          nret = NF90_INQ_VARID(ncid, 'thickness', nthicknessid) 
    114          nret = NF90_INQ_VARID(ncid, 'width', nwidthid) 
    115          nret = NF90_INQ_VARID(ncid, 'length', nlengthid) 
    116          nret = NF90_INQ_VARID(ncid, 'year', nyearid) 
    117          nret = NF90_INQ_VARID(ncid, 'day', ndayid) 
    118          nret = NF90_INQ_VARID(ncid, 'mass_of_bits', nmass_of_bits_id) 
    119          nret = NF90_INQ_VARID(ncid, 'heat_density', nheat_density_id) 
    120  
    121          ilngth(1) = 1 
    122          istrt2(1) = 1 
    123          ilngth2(1) = nkounts 
    124          ilngth2(2) = 1 
    125          DO jn=1, ibergs_in_file 
    126  
    127             istrt(1) = jn 
    128             istrt2(2) = jn 
    129  
    130             nret = NF90_GET_VAR(ncid, numberid, idata2, istrt2, ilngth2 ) 
    131             localberg%number(:) = idata2(:) 
    132  
    133             nret = NF90_GET_VAR(ncid, nscaling_id, zdata, istrt, ilngth ) 
    134             localberg%mass_scaling = zdata(1) 
    135  
    136             nret = NF90_GET_VAR(ncid, nlonid, zdata, istrt, ilngth) 
    137             localpt%lon = zdata(1) 
    138             nret = NF90_GET_VAR(ncid, nlatid, zdata, istrt, ilngth) 
    139             localpt%lat = zdata(1) 
    140             IF (nn_verbose_level >= 2 .AND. lwp) THEN 
    141                WRITE(numout,'(a,i5,a,2f10.4,a,i5)') 'icebergs, read_restart_bergs: berg ',jn,' is at ', & 
    142                                               localpt%lon,localpt%lat,' on PE ',narea-1 
     78      cl_filename = TRIM(cn_ocerst_in)//'_icebergs' 
     79      CALL iom_open( TRIM(cl_path)//cl_filename, ncid ) 
     80 
     81      IF( iom_file(ncid)%iduld .GE. 0) THEN 
     82 
     83         ibergs_in_file = iom_file(ncid)%lenuld 
     84         DO jn = 1,ibergs_in_file 
     85 
     86            ! iom_get treats the unlimited dimension as time. Here the unlimited dimension  
     87            ! is the iceberg index, but we can still use the ktime keyword to get the iceberg we want.  
     88 
     89            CALL iom_get( ncid, 'xi'     ,localpt%xi  , ktime=jn ) 
     90            CALL iom_get( ncid, 'yj'     ,localpt%yj  , ktime=jn ) 
     91 
     92            ii = INT( localpt%xi + 0.5 ) 
     93            ij = INT( localpt%yj + 0.5 ) 
     94            ! Only proceed if this iceberg is on the local processor (excluding halos). 
     95            IF ( ii .GE. nldi+nimpp-1 .AND. ii .LE. nlei+nimpp-1 .AND. & 
     96           &     ij .GE. nldj+njmpp-1 .AND. ij .LE. nlej+njmpp-1 ) THEN            
     97 
     98               CALL iom_get( ncid, jpdom_unknown, 'number'       , zdata(:) , ktime=jn, kstart=(/1/), kcount=(/nkounts/) ) 
     99               localberg%number(:) = INT(zdata(:)) 
     100               CALL iom_get( ncid, 'mass_scaling' , localberg%mass_scaling, ktime=jn ) 
     101               CALL iom_get( ncid, 'lon'          , localpt%lon           , ktime=jn ) 
     102               CALL iom_get( ncid, 'lat'          , localpt%lat           , ktime=jn ) 
     103               CALL iom_get( ncid, 'uvel'         , localpt%uvel          , ktime=jn ) 
     104               CALL iom_get( ncid, 'vvel'         , localpt%vvel          , ktime=jn ) 
     105               CALL iom_get( ncid, 'mass'         , localpt%mass          , ktime=jn ) 
     106               CALL iom_get( ncid, 'thickness'    , localpt%thickness     , ktime=jn ) 
     107               CALL iom_get( ncid, 'width'        , localpt%width         , ktime=jn ) 
     108               CALL iom_get( ncid, 'length'       , localpt%length        , ktime=jn ) 
     109               CALL iom_get( ncid, 'year'         , zdata(1)              , ktime=jn ) 
     110               localpt%year = INT(zdata(1)) 
     111               CALL iom_get( ncid, 'day'          , localpt%day           , ktime=jn ) 
     112               CALL iom_get( ncid, 'mass_of_bits' , localpt%mass_of_bits  , ktime=jn ) 
     113               CALL iom_get( ncid, 'heat_density' , localpt%heat_density  , ktime=jn ) 
     114 
     115               ! 
     116               CALL icb_utl_add( localberg, localpt ) 
     117 
    143118            ENDIF 
    144             nret = NF90_GET_VAR(ncid, nxid, zdata, istrt, ilngth) 
    145             localpt%xi = zdata(1) 
    146             nret = NF90_GET_VAR(ncid, nyid, zdata, istrt, ilngth) 
    147             localpt%yj = zdata(1) 
    148             nret = NF90_GET_VAR(ncid, nuvelid, zdata, istrt, ilngth ) 
    149             localpt%uvel = zdata(1) 
    150             nret = NF90_GET_VAR(ncid, nvvelid, zdata, istrt, ilngth ) 
    151             localpt%vvel = zdata(1) 
    152             nret = NF90_GET_VAR(ncid, nmassid, zdata, istrt, ilngth ) 
    153             localpt%mass = zdata(1) 
    154             nret = NF90_GET_VAR(ncid, nthicknessid, zdata, istrt, ilngth ) 
    155             localpt%thickness = zdata(1) 
    156             nret = NF90_GET_VAR(ncid, nwidthid, zdata, istrt, ilngth ) 
    157             localpt%width = zdata(1) 
    158             nret = NF90_GET_VAR(ncid, nlengthid, zdata, istrt, ilngth ) 
    159             localpt%length = zdata(1) 
    160             nret = NF90_GET_VAR(ncid, nyearid, idata, istrt, ilngth ) 
    161             localpt%year = idata(1) 
    162             nret = NF90_GET_VAR(ncid, ndayid, zdata, istrt, ilngth ) 
    163             localpt%day = zdata(1) 
    164             nret = NF90_GET_VAR(ncid, nmass_of_bits_id, zdata, istrt, ilngth ) 
    165             localpt%mass_of_bits = zdata(1) 
    166             nret = NF90_GET_VAR(ncid, nheat_density_id, zdata, istrt, ilngth ) 
    167             localpt%heat_density = zdata(1) 
    168             ! 
    169             CALL icb_utl_add( localberg, localpt ) 
     119 
    170120         END DO 
    171          ! 
    172       ENDIF 
    173  
    174       nret = NF90_INQ_DIMID( ncid, 'c', nc_dim ) 
    175       IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, read_restart: nf_inq_dimid c failed') 
    176  
    177       nret = NF90_INQUIRE_DIMENSION( ncid, nc_dim, cl_dname, iclass ) 
    178       IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, read_restart: nf_inquire_dimension failed') 
    179  
    180       nret = NF90_INQ_VARID(ncid, 'kount'       , nkountid) 
    181       nret = NF90_INQ_VARID(ncid, 'calving'     , ncalvid) 
    182       nret = NF90_INQ_VARID(ncid, 'calving_hflx', ncalvhid) 
    183       nret = NF90_INQ_VARID(ncid, 'stored_ice'  , nsiceid) 
    184       nret = NF90_INQ_VARID(ncid, 'stored_heat' , nsheatid) 
    185  
    186       nstrt3(1) = 1 
    187       nstrt3(2) = 1 
    188       nlngth3(1) = jpi 
    189       nlngth3(2) = jpj 
    190       nlngth3(3) = 1 
    191  
    192       DO jn = 1, iclass 
    193          nstrt3(3) = jn 
    194          nret      = NF90_GET_VAR( ncid, nsiceid , griddata, nstrt3, nlngth3 ) 
    195          berg_grid%stored_ice(:,:,jn) = griddata(:,:,1) 
    196       END DO 
    197  
    198       nret = NF90_GET_VAR( ncid, ncalvid , src_calving          (:,:) ) 
    199       nret = NF90_GET_VAR( ncid, ncalvhid, src_calving_hflx     (:,:) ) 
    200       nret = NF90_GET_VAR( ncid, nsheatid, berg_grid%stored_heat(:,:) ) 
    201       nret = NF90_GET_VAR( ncid, nkountid, idata2(:) ) 
    202       num_bergs(:) = idata2(:) 
    203  
    204       ! Finish up 
    205       nret = NF90_CLOSE(ncid) 
    206       IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, read_restart: nf_close failed') 
     121 
     122      ENDIF  
     123 
     124      ! Gridded variables 
     125      CALL iom_get( ncid, jpdom_autoglo,    'calving'     , src_calving  ) 
     126      CALL iom_get( ncid, jpdom_autoglo,    'calving_hflx', src_calving_hflx  ) 
     127      CALL iom_get( ncid, jpdom_autoglo,    'stored_heat' , berg_grid%stored_heat  ) 
     128      CALL iom_get( ncid, jpdom_autoglo_xy, 'stored_ice'  , berg_grid%stored_ice, kstart=(/1,1,1/), kcount=(/1,1,nclasses/) ) 
     129       
     130      CALL iom_get( ncid, jpdom_unknown, 'kount' , zdata(:) ) 
     131      num_bergs(:) = INT(zdata(:)) 
    207132 
    208133      ! Sanity check 
     
    211136         WRITE(numout,'(2(a,i5))') 'icebergs, read_restart_bergs: # bergs =',jn,' on PE',narea-1 
    212137      IF( lk_mpp ) THEN 
    213          CALL mpp_sum(ibergs_in_file) 
     138         ! Only mpp_sum ibergs_in_file if we are reading from multiple restart files.  
     139         IF( INDEX(iom_file(ncid)%name,'icebergs.nc' ) .EQ. 0 ) CALL mpp_sum(ibergs_in_file) 
    214140         CALL mpp_sum(jn) 
    215141      ENDIF 
     
    217143         &                                    ' bergs in the restart file and', jn,' bergs have been read' 
    218144      ! 
     145      ! Finish up 
     146      CALL iom_close( ncid ) 
     147      ! 
    219148      IF( lwp .and. nn_verbose_level >= 0)  WRITE(numout,'(a)') 'icebergs, read_restart_bergs: completed' 
    220149      ! 
     
    231160      INTEGER ::   jn   ! dummy loop index 
    232161      INTEGER ::   ix_dim, iy_dim, ik_dim, in_dim 
    233       CHARACTER(len=256)     :: cl_path 
    234       CHARACTER(len=256)     :: cl_filename 
     162      INTEGER             ::   iyear, imonth, iday 
     163      REAL (wp)           ::   zsec 
     164      REAL (wp)           ::   zfjulday 
     165      CHARACTER(len=256)  :: cl_path 
     166      CHARACTER(len=256)  :: cl_filename 
     167      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character 
    235168      TYPE(iceberg), POINTER :: this 
    236169      TYPE(point)  , POINTER :: pt 
     
    240173      cl_path = TRIM(cn_ocerst_outdir) 
    241174      IF( cl_path(LEN_TRIM(cl_path):) /= '/' ) cl_path = TRIM(cl_path) // '/' 
     175      IF ( ln_rstdate ) THEN 
     176         zfjulday = fjulday + rdttra(1) / rday 
     177         IF( ABS(zfjulday - REAL(NINT(zfjulday),wp)) < 0.1 / rday )   zfjulday = REAL(NINT(zfjulday),wp)   ! avoid truncation error 
     178         CALL ju2ymds( zfjulday, iyear, imonth, iday, zsec )            
     179         WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday 
     180      ELSE 
     181         IF( kt > 999999999 ) THEN   ;   WRITE(clkt, *       ) kt 
     182         ELSE                        ;   WRITE(clkt, '(i8.8)') kt 
     183         ENDIF 
     184      ENDIF 
    242185      IF( lk_mpp ) THEN 
    243          WRITE(cl_filename,'(A,"_icebergs_",I8.8,"_restart_",I4.4,".nc")') TRIM(cexper), kt, narea-1 
     186         WRITE(cl_filename,'(A,"_icebergs_",A,"_restart_",I4.4,".nc")') TRIM(cexper), TRIM(ADJUSTL(clkt)), narea-1 
    244187      ELSE 
    245          WRITE(cl_filename,'(A,"_icebergs_",I8.8,"_restart.nc")') TRIM(cexper), kt 
     188         WRITE(cl_filename,'(A,"_icebergs_",A,"_restart.nc")') TRIM(cexper), TRIM(ADJUSTL(clkt)) 
    246189      ENDIF 
    247190      IF (nn_verbose_level >= 0) WRITE(numout,'(2a)') 'icebergs, write_restart: creating ',TRIM(cl_path)//TRIM(cl_filename) 
Note: See TracChangeset for help on using the changeset viewer.