MODULE restart !!====================================================================== !! *** MODULE restart *** !! Ocean restart : write the ocean restart file !!===================================================================== !!---------------------------------------------------------------------- !! rst_write : write of the restart file !! rst_read : read the restart file !!---------------------------------------------------------------------- !! * Modules used USE dom_oce ! ocean space and time domain USE oce ! ocean dynamics and tracers USE phycst ! physical constants USE in_out_manager ! I/O manager USE daymod ! calendar USE sol_oce ! ocean elliptic solver USE zdf_oce ! ??? USE zdftke ! turbulent kinetic energy scheme USE ice_oce ! ice variables USE blk_oce ! bulk variables USE flx_oce ! sea-ice/ocean forcings variables USE dynspg_oce ! free surface time splitting scheme variables USE cpl_oce, ONLY : lk_cpl ! IMPLICIT NONE PRIVATE !! * Routine accessibility PUBLIC rst_write ! routine called by step.F90 PUBLIC rst_read ! routine called by inidtr.F90 !! * Module variables CHARACTER (len=48) :: & crestart = 'initial.nc' ! restart file name !!---------------------------------------------------------------------- !! OPA 9.0 , LOCEAN-IPSL (2005) !! $Header$ !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt !!---------------------------------------------------------------------- CONTAINS #if ( defined key_mpp_mpi || defined key_mpp_shmem ) && defined key_dimgout !!---------------------------------------------------------------------- !! 'key_mpp_mpi' OR MPI massively parallel processing library !! 'key_mpp_shmem' SHMEM massively parallel processing library !! AND !! 'key_dimgout' !!---------------------------------------------------------------------- !! direct acces file one per processor !! (merging/splitting is done off-line, eventually) !!----------------------------------------------------------------------- # include "restart_dimg.h90" #else !!---------------------------------------------------------------------- !! Default option NetCDF file !!---------------------------------------------------------------------- SUBROUTINE rst_write( kt ) !!--------------------------------------------------------------------- !! *** ROUTINE rstwrite *** !! !! ** Purpose : Write restart fields in NetCDF format !! !! ** Method : Write in numwrs file each nstock time step in NetCDF !! file, save fields which are necessary for restart !! !! History : !! ! 99-11 (M. Imbard) Original code !! 8.5 ! 02-08 (G. Madec) F90: Free form !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization !!---------------------------------------------------------------------- !! * Modules used USE ioipsl !! * Arguments INTEGER, INTENT( in ) :: kt ! ocean time-step !! * Local declarations LOGICAL :: llbon CHARACTER (len=50) :: clname, cln INTEGER :: ic, jc, itime INTEGER :: inumwrs REAL(wp) :: zdate0 REAL(wp), DIMENSION( 1) :: zfice, zfblk ! used only in case of ice & bulk REAL(wp), DIMENSION(10) :: zinfo(10) REAL(wp), DIMENSION(jpi,jpj) :: ztab #if defined key_agrif Integer :: knum #endif !!---------------------------------------------------------------------- IF( kt == nit000 ) THEN IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) 'rst_wri : write restart.output NetCDF file' IF(lwp) WRITE(numout,*) '~~~~~~~' zfice(1) = 1.e0 ; zfblk(1) = 1.e0 ENDIF IF( MOD( kt, nstock ) == 0 .OR. kt == nitend ) THEN ! 0. Initializations ! ------------------ IF(lwp) WRITE(numout,*) ' ' IF(lwp) WRITE(numout,*) 'rst_write : write the restart file in NetCDF format ', & 'at it= ',kt,' date= ',ndastp IF(lwp) WRITE(numout,*) '~~~~~~~~~' ! Job informations zinfo(:) = 0.e0 zinfo(1) = FLOAT( no ) ! job number zinfo(2) = FLOAT( kt ) ! time-step zinfo(3) = FLOAT( 2 - nsolv ) ! pcg solver zinfo(4) = FLOAT( nsolv - 1 ) ! sor solver IF( lk_zdftke ) THEN zinfo(5) = 1.e0 ! TKE ELSE zinfo(5) = 0.e0 ! no TKE ENDIF zinfo(6) = FLOAT( ndastp ) ! date zinfo(7) = adatrj ! ??? ! delete the restart file if it exists INQUIRE( FILE=crestart, EXIST=llbon ) IF(llbon) THEN #if defined key_agrif knum =Agrif_Get_Unit() OPEN( UNIT=knum, FILE=crestart, STATUS='old' ) CLOSE( knum, STATUS='delete' ) #else OPEN( UNIT=inumwrs, FILE=crestart, STATUS='old' ) CLOSE( inumwrs, STATUS='delete' ) #endif ENDIF ! Name of the new restart file ic = 1 DO jc = 1, 16 IF( cexper(jc:jc) /= ' ' ) ic = jc END DO WRITE(cln,'("_",i4.4,i2.2,i2.2,"_restart")') nyear, nmonth, nday clname = cexper(1:ic)//cln ic = 1 DO jc = 1, 48 IF( clname(jc:jc) /= ' ' ) ic = jc END DO crestart = clname(1:ic)//".nc" itime = 0 CALL ymds2ju( nyear, nmonth, nday, 0.e0, zdate0 ) CALL restini( 'NONE', jpi, jpj, glamt, gphit, jpk, gdept_0, clname, & itime, zdate0, rdt*nstock ,inumwrs, domain_id=nidom ) CALL restput( inumwrs, 'info' , 1 , 1 , 10 , 0, zinfo ) ! restart informations CALL restput( inumwrs, 'ub' , jpi, jpj, jpk, 0, ub ) ! prognostic variables CALL restput( inumwrs, 'vb' , jpi, jpj, jpk, 0, vb ) CALL restput( inumwrs, 'tb' , jpi, jpj, jpk, 0, tb ) CALL restput( inumwrs, 'sb' , jpi, jpj, jpk, 0, sb ) CALL restput( inumwrs, 'rotb' , jpi, jpj, jpk, 0, rotb ) CALL restput( inumwrs, 'hdivb' , jpi, jpj, jpk, 0, hdivb ) CALL restput( inumwrs, 'un' , jpi, jpj, jpk, 0, un ) CALL restput( inumwrs, 'vn' , jpi, jpj, jpk, 0, vn ) CALL restput( inumwrs, 'tn' , jpi, jpj, jpk, 0, tn ) CALL restput( inumwrs, 'sn' , jpi, jpj, jpk, 0, sn ) CALL restput( inumwrs, 'rotn' , jpi, jpj, jpk, 0, rotn ) CALL restput( inumwrs, 'hdivn' , jpi, jpj, jpk, 0, hdivn ) ztab(:,:) = gcx(1:jpi,1:jpj) CALL restput( inumwrs, 'gcx' , jpi, jpj, 1 , 0, ztab ) ! Read elliptic solver arrays ztab(:,:) = gcxb(1:jpi,1:jpj) CALL restput( inumwrs, 'gcxb' , jpi, jpj, 1 , 0, ztab ) # if defined key_dynspg_rl CALL restput( inumwrs, 'bsfb' , jpi, jpj, 1 , 0, bsfb ) ! Rigid-lid formulation (bsf) CALL restput( inumwrs, 'bsfn' , jpi, jpj, 1 , 0, bsfn ) CALL restput( inumwrs, 'bsfd' , jpi, jpj, 1 , 0, bsfd ) # else CALL restput( inumwrs, 'sshb' , jpi, jpj, 1 , 0, sshb ) ! free surface formulation (ssh) CALL restput( inumwrs, 'sshn' , jpi, jpj, 1 , 0, sshn ) # if defined key_dynspg_ts CALL restput( inumwrs, 'sshb_b' , jpi, jpj, 1 , 0, sshb_b ) ! free surface formulation (ssh) CALL restput( inumwrs, 'sshn_b' , jpi, jpj, 1 , 0, sshn_b ) ! issued from barotropic loop CALL restput( inumwrs, 'un_b' , jpi, jpj, 1 , 0, un_b ) ! horizontal transports CALL restput( inumwrs, 'vn_b' , jpi, jpj, 1 , 0, vn_b ) ! issued from barotropic loop # endif # endif # if defined key_zdftke || defined key_esopa IF( lk_zdftke ) THEN CALL restput( inumwrs, 'en' , jpi, jpj, jpk, 0, en ) ! TKE arrays ENDIF # endif # if defined key_ice_lim zfice(1) = FLOAT( nfice ) ! Louvain La Neuve Sea Ice Model CALL restput( inumwrs, 'nfice' , 1, 1, 1 , 0, zfice ) CALL restput( inumwrs, 'sst_io' , jpi, jpj, 1 , 0, sst_io ) CALL restput( inumwrs, 'sss_io' , jpi, jpj, 1 , 0, sss_io ) CALL restput( inumwrs, 'u_io' , jpi, jpj, 1 , 0, u_io ) CALL restput( inumwrs, 'v_io' , jpi, jpj, 1 , 0, v_io ) # if defined key_coupled CALL restput( inumwrs, 'alb_ice', jpi, jpj, 1 , 0, alb_ice ) # endif # endif # if defined key_flx_bulk_monthly || defined key_flx_bulk_daily zfblk(1) = FLOAT( nfbulk ) ! Bulk CALL restput( inumwrs, 'nfbulk' , 1, 1, 1 , 0, zfblk ) CALL restput( inumwrs, 'gsst' , jpi, jpj, 1 , 0, gsst ) # endif CALL restclo( inumwrs ) ! close the restart file ENDIF END SUBROUTINE rst_write SUBROUTINE rst_read !!---------------------------------------------------------------------- !! *** ROUTINE rst_read *** !! !! ** Purpose : Read files for restart !! !! ** Method : Read the previous fields on the NetCDF file !! the first record indicates previous characterics !! after control with the present run, we read : !! - prognostic variables on the second record !! - elliptic solver arrays !! - barotropic stream function arrays ("key_dynspg_rl" defined) !! or free surface arrays !! - tke arrays (lk_zdftke=T) !! for this last three records, the previous characteristics !! could be different with those used in the present run. !! !! According to namelist parameter nrstdt, !! nrstdt = 0 no control on the date (nit000 is arbitrary). !! nrstdt = 1 we verify that nit000 is equal to the last !! time step of previous run + 1. !! In both those options, the exact duration of the experiment !! since the beginning (cumulated duration of all previous restart runs) !! is not stored in the restart and is assumed to be (nit000-1)*rdt. !! This is valid is the time step has remained constant. !! !! nrstdt = 2 the duration of the experiment in days (adatrj) !! has been stored in the restart file. !! !! History : !! ! 99-05 (M. Imbard) Original code !! 8.5 ! 02-09 (G. Madec) F90: Free form !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization !!---------------------------------------------------------------------- !! * Modules used USE iom !! * Local declarations INTEGER :: & inum ! temporary logical unit REAL(wp), DIMENSION(1, 1, 10) :: zinfo REAL(wp), DIMENSION(1, 1, 1) :: zzz INTEGER :: ios # if defined key_ice_lim INTEGER :: ji, jj # endif !!---------------------------------------------------------------------- IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) 'rst_read : read the NetCDF restart file' IF(lwp) WRITE(numout,*) '~~~~~~~~' IF(lwp) WRITE(numout,*) ' Info on the present job : ' IF(lwp) WRITE(numout,*) ' job number : ', no IF(lwp) WRITE(numout,*) ' time-step : ', nit000 IF(lwp) WRITE(numout,*) ' solver type : ', nsolv IF( lk_zdftke ) THEN IF(lwp) WRITE(numout,*) ' tke option : 1 ' ELSE IF(lwp) WRITE(numout,*) ' tke option : 0 ' ENDIF IF(lwp) WRITE(numout,*) ' date ndastp : ', ndastp IF(lwp) WRITE(numout,*) ! Time domain : restart ! ------------------------- IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) ' *** restart option' SELECT CASE ( nrstdt ) CASE ( 0 ) IF(lwp) WRITE(numout,*) ' nrstdt = 0 no control of nit000' CASE ( 1 ) IF(lwp) WRITE(numout,*) ' nrstdt = 1 we control the date of nit000' CASE ( 2 ) IF(lwp) WRITE(numout,*) ' nrstdt = 2 the date adatrj is read in restart file' CASE DEFAULT IF(lwp) WRITE(numout,*) ' ===>>>> nrstdt not equal 0, 1 or 2 : no control of the date' IF(lwp) WRITE(numout,*) ' ======= =========' END SELECT CALL iom_open ( 'restart', inum ) CALL iom_get ( inum, jpdom_unknown, 'info', zinfo ) IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) ' Info on the restart file read : ' IF(lwp) WRITE(numout,*) ' job number : ', NINT( zinfo(1, 1, 1) ) IF(lwp) WRITE(numout,*) ' time-step : ', NINT( zinfo(1, 1, 2) ) IF(lwp) WRITE(numout,*) ' solver type : ', NINT( zinfo(1, 1, 4) ) + 1 IF(lwp) WRITE(numout,*) ' tke option : ', NINT( zinfo(1, 1, 5) ) IF(lwp) WRITE(numout,*) ' date ndastp : ', NINT( zinfo(1, 1, 6) ) IF(lwp) WRITE(numout,*) ! Control of date IF( nit000 - NINT( zinfo(1, 1, 2) ) /= 1 .AND. nrstdt /= 0 ) & & CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart', & & ' verify the restart file or rerun with nrstdt = 0 (namelist)' ) ! re-initialisation of adatrj0 adatrj0 = ( FLOAT( nit000-1 ) * rdttra(1) ) / rday IF ( nrstdt == 2 ) THEN ! by default ndatsp has been set to ndate0 in dom_nam ! ndate0 has been read in the namelist (standard OPA 8) ! here when nrstdt=2 we keep the final date of previous run ndastp = NINT( zinfo(1, 1, 6) ) adatrj0 = zinfo(1, 1, 7) ENDIF CALL iom_get( inum, jpdom_local, 'ub' , ub ) ! Read prognostic variables CALL iom_get( inum, jpdom_local, 'vb' , vb ) CALL iom_get( inum, jpdom_local, 'tb' , tb ) CALL iom_get( inum, jpdom_local, 'sb' , sb ) CALL iom_get( inum, jpdom_local, 'rotb' , rotb ) CALL iom_get( inum, jpdom_local, 'hdivb', hdivb ) CALL iom_get( inum, jpdom_local, 'un' , un ) CALL iom_get( inum, jpdom_local, 'vn' , vn ) CALL iom_get( inum, jpdom_local, 'tn' , tn ) CALL iom_get( inum, jpdom_local, 'sn' , sn ) CALL iom_get( inum, jpdom_local, 'rotn' , rotn ) CALL iom_get( inum, jpdom_local, 'hdivn', hdivn ) ! Caution : extrahallow ! gcx and gcxb are defined as: DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj) CALL iom_get( inum, jpdom_local, 'gcx' , gcx (1:jpi,1:jpj) ) CALL iom_get( inum, jpdom_local, 'gcxb', gcxb(1:jpi,1:jpj) ) ! Read elliptic solver arrays # if defined key_dynspg_rl CALL iom_get( inum, jpdom_local, 'bsfb', bsfb ) ! Rigid-lid formulation (bsf) CALL iom_get( inum, jpdom_local, 'bsfn', bsfn ) CALL iom_get( inum, jpdom_local, 'bsfd', bsfd ) # else CALL iom_get( inum, jpdom_local, 'sshb', sshb ) ! free surface formulation (ssh) CALL iom_get( inum, jpdom_local, 'sshn', sshn ) # if defined key_dynspg_ts CALL iom_get( inum, jpdom_local, 'sshb_b', sshb_b ) ! free surface formulation (ssh) CALL iom_get( inum, jpdom_local, 'sshn_b', sshn_b ) ! issued from barotropic loop CALL iom_get( inum, jpdom_local, 'un_b' , un_b ) ! horizontal transports CALL iom_get( inum, jpdom_local, 'vn_b' , vn_b ) ! issued from barotropic loop # endif # endif # if defined key_zdftke || defined key_esopa IF( lk_zdftke ) THEN IF( NINT( zinfo(1, 1, 5) ) == 1 ) THEN ! Read tke arrays CALL iom_get( inum, jpdom_local, 'en', en ) ln_rstke = .FALSE. ELSE IF(lwp) WRITE(numout,*) ' ===>>>> : the previous restart file did not used tke scheme' IF(lwp) WRITE(numout,*) ' ======= =======' nrstdt = 2 ln_rstke = .TRUE. ENDIF ENDIF # endif # if defined key_ice_lim ! Louvain La Neuve Sea Ice Model ios = iom_varid( inum, 'nfice' ) IF( ios > 0 ) then CALL iom_get( inum, jpdom_unknown, 'nfice' , zzz ) zinfo(1, 1, 8) = zzz(1, 1, 1) CALL iom_get( inum, jpdom_local, 'sst_io', sst_io ) CALL iom_get( inum, jpdom_local, 'sss_io', sss_io ) CALL iom_get( inum, jpdom_local, 'u_io' , u_io ) CALL iom_get( inum, jpdom_local, 'v_io' , v_io ) #if defined key_coupled CALL iom_get( inum, jpdom_local, 'alb_ice', alb_ice ) #endif ENDIF IF( zinfo(1, 1, 8) /= FLOAT(nfice) .OR. ios == 0 ) THEN IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) 'rst_read : LLN sea Ice Model => Ice initialization' IF(lwp) WRITE(numout,*) sst_io(:,:) = ( nfice-1 )*( tn(:,:,1) + rt0 ) !!bug a explanation is needed here! sss_io(:,:) = ( nfice-1 )* sn(:,:,1) DO jj = 2, jpj DO ji = 2, jpi u_io(ji,jj) = ( nfice-1 ) * 0.5 * ( un(ji-1,jj ,1) + un(ji-1,jj-1,1) ) v_io(ji,jj) = ( nfice-1 ) * 0.5 * ( vn(ji ,jj-1,1) + vn(ji-1,jj-1,1) ) END DO END DO # if defined key_coupled alb_ice(:,:) = 0.8 * tmask(:,:,1) # endif ENDIF # endif # if defined key_flx_bulk_monthly || defined key_flx_bulk_daily ! Louvain La Neuve Sea Ice Model ios = iom_varid( inum, 'nfbulk' ) IF( ios > 0 ) then CALL iom_get( inum, jpdom_unknown, 'nfbulk' , zzz ) CALL iom_get( inum, jpdom_local, 'gsst' , gsst ) zinfo(1, 1, 9) = zzz(1, 1, 1) ENDIF IF( zinfo(1, 1, 9) /= FLOAT(nfbulk) .OR. ios == 0 ) THEN IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) 'rst_read : LLN sea Ice Model => Ice initialization' IF(lwp) WRITE(numout,*) gsst(:,:) = 0. gsst(:,:) = gsst(:,:) + ( nfbulk-1 )*( tn(:,:,1) + rt0 ) ENDIF # endif CALL iom_close( inum ) ! In case of restart with neuler = 0 then put all before fields = to now fields IF ( neuler == 0 ) THEN tb(:,:,:)=tn(:,:,:) sb(:,:,:)=sn(:,:,:) ub(:,:,:)=un(:,:,:) vb(:,:,:)=vn(:,:,:) rotb(:,:,:)=rotn(:,:,:) hdivb(:,:,:)=hdivn(:,:,:) #if defined key_dynspg_rl ! rigid lid bsfb(:,:)=bsfn(:,:) #else ! free surface formulation (eta) sshb(:,:)=sshn(:,:) #endif ENDIF END SUBROUTINE rst_read #endif !!===================================================================== END MODULE restart