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 5965 for branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90 – NEMO

Ignore:
Timestamp:
2015-12-01T16:35:30+01:00 (8 years ago)
Author:
timgraham
Message:

Upgraded branch to r5518 of trunk (v3.6 stable revision)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90

    r4205 r5965  
    1818   USE ice            ! sea-ice variables 
    1919   USE oce     , ONLY :  snwice_mass, snwice_mass_b 
    20    USE par_ice        ! sea-ice parameters 
    2120   USE dom_oce        ! ocean domain 
    2221   USE sbc_oce        ! Surface boundary condition: ocean fields 
     
    2726   USE wrk_nemo       ! work arrays 
    2827   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     28   USE limctl 
    2929 
    3030   IMPLICIT NONE 
     
    3333   PUBLIC   lim_rst_opn    ! routine called by icestep.F90 
    3434   PUBLIC   lim_rst_write  ! routine called by icestep.F90 
    35    PUBLIC   lim_rst_read   ! routine called by iceini.F90 
     35   PUBLIC   lim_rst_read   ! routine called by sbc_lim_init 
    3636 
    3737   LOGICAL, PUBLIC ::   lrst_ice         !: logical to control the ice restart write  
     
    5555      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character 
    5656      CHARACTER(LEN=50)   ::   clname   ! ice output restart file name 
     57      CHARACTER(len=256)  ::   clpath   ! full path to ice output restart file  
    5758      !!---------------------------------------------------------------------- 
    5859      ! 
     
    6465      IF( kt == nitrst - 2*nn_fsbc + 1 .OR. nstock == nn_fsbc    & 
    6566         &                             .OR. ( kt == nitend - nn_fsbc + 1 .AND. .NOT. lrst_ice ) ) THEN 
    66          ! beware of the format used to write kt (default is i8.8, that should be large enough...) 
    67          IF( nitrst > 99999999 ) THEN   ;   WRITE(clkt, *       ) nitrst 
    68          ELSE                           ;   WRITE(clkt, '(i8.8)') nitrst 
     67         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN 
     68            ! beware of the format used to write kt (default is i8.8, that should be large enough...) 
     69            IF( nitrst > 99999999 ) THEN   ;   WRITE(clkt, *       ) nitrst 
     70            ELSE                           ;   WRITE(clkt, '(i8.8)') nitrst 
     71            ENDIF 
     72            ! create the file 
     73            clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out) 
     74            clpath = TRIM(cn_icerst_outdir)  
     75            IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath)//'/' 
     76            IF(lwp) THEN 
     77               WRITE(numout,*) 
     78               SELECT CASE ( jprstlib ) 
     79               CASE ( jprstdimg ) 
     80                  WRITE(numout,*) '             open ice restart binary file: ',TRIM(clpath)//clname 
     81               CASE DEFAULT 
     82                  WRITE(numout,*) '             open ice restart NetCDF file: ',TRIM(clpath)//clname 
     83               END SELECT 
     84               IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN    
     85                  WRITE(numout,*)         '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp 
     86               ELSE   ;   WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp 
     87               ENDIF 
     88            ENDIF 
     89            ! 
     90            CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kiolib = jprstlib ) 
     91            lrst_ice = .TRUE. 
    6992         ENDIF 
    70          ! create the file 
    71          clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out) 
    72          IF(lwp) THEN 
    73             WRITE(numout,*) 
    74             SELECT CASE ( jprstlib ) 
    75             CASE ( jprstdimg )   ;   WRITE(numout,*) '             open ice restart binary file: '//clname 
    76             CASE DEFAULT         ;   WRITE(numout,*) '             open ice restart NetCDF file: '//clname 
    77             END SELECT 
    78             IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN    
    79                WRITE(numout,*)         '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp 
    80             ELSE   ;   WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp 
    81             ENDIF 
    82          ENDIF 
    83          ! 
    84          CALL iom_open( clname, numriw, ldwrt = .TRUE., kiolib = jprstlib ) 
    85          lrst_ice = .TRUE. 
    8693      ENDIF 
    8794      ! 
     95      IF( ln_icectl )   CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - Beginning the time step - ' )   ! control print 
    8896   END SUBROUTINE lim_rst_opn 
    8997 
     
    162170      CALL iom_rstput( iter, nitrst, numriw, 'u_ice'        , u_ice      ) 
    163171      CALL iom_rstput( iter, nitrst, numriw, 'v_ice'        , v_ice      ) 
    164       CALL iom_rstput( iter, nitrst, numriw, 'fsbbq'        , fsbbq      ) 
    165172      CALL iom_rstput( iter, nitrst, numriw, 'stress1_i'    , stress1_i  ) 
    166173      CALL iom_rstput( iter, nitrst, numriw, 'stress2_i'    , stress2_i  ) 
    167174      CALL iom_rstput( iter, nitrst, numriw, 'stress12_i'   , stress12_i ) 
    168       CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass'  , snwice_mass )   !clem modif 
    169       CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass_b', snwice_mass_b ) !clem modif 
     175      CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass'  , snwice_mass ) 
     176      CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass_b', snwice_mass_b ) 
    170177 
    171178      DO jl = 1, jpl  
     
    307314      !! ** purpose  :   read of sea-ice variable restart in a netcdf file 
    308315      !!---------------------------------------------------------------------- 
    309       INTEGER :: ji, jj, jk, jl, indx 
     316      INTEGER :: ji, jj, jk, jl 
    310317      REAL(wp) ::   zfice, ziter 
    311       REAL(wp) ::   zs_inf, z_slope_s, zsmax, zsmin, zalpha, zindb   ! local scalars used for the salinity profile 
    312       REAL(wp), POINTER, DIMENSION(:)  ::   zs_zero  
    313318      REAL(wp), POINTER, DIMENSION(:,:) ::   z2d 
    314319      CHARACTER(len=15) ::   znam 
     
    318323      !!---------------------------------------------------------------------- 
    319324 
    320       CALL wrk_alloc( nlay_i, zs_zero ) 
    321325      CALL wrk_alloc( jpi, jpj, z2d ) 
    322326 
     
    330334        ! eventually read netcdf file (monobloc)  for restarting on different number of processors 
    331335        ! if {cn_icerst_in}.nc exists, then set jlibalt to jpnf90 
    332         INQUIRE( FILE = TRIM(cn_icerst_in)//'.nc', EXIST = llok ) 
     336        INQUIRE( FILE = TRIM(cn_icerst_indir)//'/'//TRIM(cn_icerst_in)//'.nc', EXIST = llok ) 
    333337        IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF 
    334338      ENDIF 
    335339 
    336       CALL iom_open ( cn_icerst_in, numrir, kiolib = jprstlib ) 
     340      CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir, kiolib = jprstlib ) 
    337341 
    338342      CALL iom_get( numrir, 'nn_fsbc', zfice ) 
     
    393397      CALL iom_get( numrir, jpdom_autoglo, 'u_ice'     , u_ice      ) 
    394398      CALL iom_get( numrir, jpdom_autoglo, 'v_ice'     , v_ice      ) 
    395       CALL iom_get( numrir, jpdom_autoglo, 'fsbbq'     , fsbbq      ) 
    396399      CALL iom_get( numrir, jpdom_autoglo, 'stress1_i' , stress1_i  ) 
    397400      CALL iom_get( numrir, jpdom_autoglo, 'stress2_i' , stress2_i  ) 
    398401      CALL iom_get( numrir, jpdom_autoglo, 'stress12_i', stress12_i ) 
    399       CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass'  , snwice_mass )   !clem modif 
    400       CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass_b', snwice_mass_b ) !clem modif 
     402      CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass'  , snwice_mass ) 
     403      CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass_b', snwice_mass_b ) 
    401404 
    402405      DO jl = 1, jpl  
     
    522525      END DO 
    523526      ! 
     527      ! clem: I do not understand why the following IF is needed 
     528      !       I suspect something inconsistent in the main code with option nn_icesal=1 
     529      IF( nn_icesal == 1 ) THEN 
     530         DO jl = 1, jpl  
     531            sm_i(:,:,jl) = rn_icesal 
     532            DO jk = 1, nlay_i  
     533               s_i(:,:,jk,jl) = rn_icesal 
     534            END DO 
     535         END DO 
     536      ENDIF 
     537      ! 
    524538      !CALL iom_close( numrir ) !clem: closed in sbcice_lim.F90 
    525539      ! 
    526       CALL wrk_dealloc( nlay_i, zs_zero ) 
    527540      CALL wrk_dealloc( jpi, jpj, z2d ) 
    528541      ! 
Note: See TracChangeset for help on using the changeset viewer.