MODULE limrst !!====================================================================== !! *** MODULE limrst *** !! Ice restart : write the ice restart file !!====================================================================== #if defined key_ice_lim !!---------------------------------------------------------------------- !! 'key_ice_lim' : LIM sea-ice model !!---------------------------------------------------------------------- !! lim_rst_write : write of the restart file !! lim_rst_read : read the restart file !!---------------------------------------------------------------------- !! * Modules used USE in_out_manager USE ice USE ioipsl USE dom_oce USE ice_oce ! ice variables USE daymod IMPLICIT NONE PRIVATE !! * Accessibility PUBLIC lim_rst_write ! routine called by lim_step.F90 PUBLIC lim_rst_read ! routine called by lim_init.F90 !!---------------------------------------------------------------------- !! LIM 2.0, UCL-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 !! 'key_mpp_shmem' !! 'key_dimgout' : clipper type restart file !! : can be used in mpp !!---------------------------------------------------------------------- # include "limrst_dimg.h90" # else !!---------------------------------------------------------------------- !! Default option NetCDF file !!---------------------------------------------------------------------- SUBROUTINE lim_rst_write( niter ) !!---------------------------------------------------------------------- !! *** lim_rst_write *** !! !! ** purpose : output of sea-ice variable in a netcdf file !! !!---------------------------------------------------------------------- ! Arguments INTEGER :: niter ! number of iteration !- dummy variables : LOGICAL :: & llbon INTEGER :: & ji, jj INTEGER :: & inumwrs, it0, itime REAL(wp), DIMENSION(1) :: & zdept REAL(wp), DIMENSION(2) :: & zinfo REAL(wp),DIMENSION(jpi,jpj,35) :: & zmoment REAL(wp) :: & zsec, zdate0, zdt CHARACTER(len=45) :: ccfile ccfile = 'restart_ice_out.nc' #if defined key_agrif if ( .NOT. Agrif_Root() ) then ccfile= TRIM(Agrif_CFixed())//'_'//TRIM(ccfile) endif #endif inumwrs = 61 INQUIRE ( FILE = ccfile, EXIST = llbon ) IF( llbon ) THEN OPEN ( UNIT = inumwrs , FILE = ccfile, STATUS = 'old' ) CLOSE( inumwrs , STATUS = 'delete' ) ENDIF it0 = niter zinfo(1) = FLOAT( nfice ) ! coupling frequency OPA ICELLN nfice zinfo(2) = FLOAT( it0 ) ! iteration number zsec = 0.e0 itime = 0 zdept(1) = 0.e0 zdt = rdt_ice * nstock ! Write in inumwrs DO jj = 1, jpj ! 3D array: 10 time faster than 35 restput DO ji = 1, jpi zmoment(ji,jj,1) = sxice(ji,jj) zmoment(ji,jj,2) = syice(ji,jj) zmoment(ji,jj,3) = sxxice(ji,jj) zmoment(ji,jj,4) = syyice(ji,jj) zmoment(ji,jj,5) = sxyice(ji,jj) zmoment(ji,jj,6) = sxsn(ji,jj) zmoment(ji,jj,7) = sysn(ji,jj) zmoment(ji,jj,8) = sxxsn(ji,jj) zmoment(ji,jj,9) = syysn(ji,jj) zmoment(ji,jj,10) = sxysn(ji,jj) zmoment(ji,jj,11) = sxa(ji,jj) zmoment(ji,jj,12) = sya(ji,jj) zmoment(ji,jj,13) = sxxa(ji,jj) zmoment(ji,jj,14) = syya(ji,jj) zmoment(ji,jj,15) = sxya(ji,jj) zmoment(ji,jj,16) = sxc0(ji,jj) zmoment(ji,jj,17) = syc0(ji,jj) zmoment(ji,jj,18) = sxxc0(ji,jj) zmoment(ji,jj,19) = syyc0(ji,jj) zmoment(ji,jj,20) = sxyc0(ji,jj) zmoment(ji,jj,21) = sxc1(ji,jj) zmoment(ji,jj,22) = syc1(ji,jj) zmoment(ji,jj,23) = sxxc1(ji,jj) zmoment(ji,jj,24) = syyc1(ji,jj) zmoment(ji,jj,25) = sxyc1(ji,jj) zmoment(ji,jj,26) = sxc2(ji,jj) zmoment(ji,jj,27) = syc2(ji,jj) zmoment(ji,jj,28) = sxxc2(ji,jj) zmoment(ji,jj,29) = syyc2(ji,jj) zmoment(ji,jj,30) = sxyc2(ji,jj) zmoment(ji,jj,31) = sxst(ji,jj) zmoment(ji,jj,32) = syst(ji,jj) zmoment(ji,jj,33) = sxxst(ji,jj) zmoment(ji,jj,34) = syyst(ji,jj) zmoment(ji,jj,35) = sxyst(ji,jj) END DO END DO CALL ymds2ju( nyear, nmonth, nday, zsec, zdate0 ) CALL restini( 'NONE', jpi, jpj, glamt, gphit, 1 , zdept, ccfile, itime, zdate0, zdt, & & inumwrs, domain_id=nidom ) CALL restput( inumwrs, 'info' , 1, 1, 2 , 0, zinfo ) ! restart informations CALL restput( inumwrs, 'hicif' , jpi, jpj, 1 , 0, hicif ) ! prognostic variables CALL restput( inumwrs, 'hsnif' , jpi, jpj, 1 , 0, hsnif ) CALL restput( inumwrs, 'frld' , jpi, jpj, 1 , 0, frld ) CALL restput( inumwrs, 'sist' , jpi, jpj, 1 , 0, sist ) # if defined key_coupled CALL restput( inumwrs, 'albege' , jpi, jpj, 1 , 0, albege ) # endif CALL restput( inumwrs, 'tbif' , jpi, jpj, 3 , 0, tbif ) CALL restput( inumwrs, 'u_ice' , jpi, jpj, 1 , 0, u_ice ) CALL restput( inumwrs, 'v_ice' , jpi, jpj, 1 , 0, v_ice ) CALL restput( inumwrs, 'gtaux' , jpi, jpj, 1 , 0, gtaux ) CALL restput( inumwrs, 'gtauy' , jpi, jpj, 1 , 0, gtauy ) CALL restput( inumwrs, 'qstoif' , jpi, jpj, 1 , 0, qstoif ) CALL restput( inumwrs, 'fsbbq' , jpi, jpj, 1 , 0, fsbbq ) CALL restput( inumwrs, 'moment' , jpi, jpj, 35, 0, zmoment ) CALL restclo( inumwrs ) END SUBROUTINE lim_rst_write SUBROUTINE lim_rst_read( niter ) !----------------------------------------------------------------------- ! restart from a state defined in a binary file !----------------------------------------------------------------------- !! * Modules used USE iom ! Arguments INTEGER :: niter ! number of iteration !- dummy variables : INTEGER :: & inum, it1, ifice REAL(wp),DIMENSION(jpi,jpj,35) :: & zmoment REAL(wp),DIMENSION(1, 1, 2) :: & zinfo CALL iom_open ( 'restart_ice_in', inum ) CALL iom_get (inum, jpdom_unknown, 'info', zinfo) ifice = INT( zinfo(1, 1, 1) ) ! not used ... it1 = INT( zinfo(1, 1, 2) ) IF(lwp) WRITE(numout,*) 'lim_rst_read : READ restart file at time step : ', it1 !Control of date IF( ( nit000 - it1 ) /= 1 .AND. ABS( nrstdt ) == 1 ) & CALL ctl_stop( 'lim_rst_read ===>>>> : problem with nit000 for the restart', & & ' verify the file or rerun with the value 0 for the', & & ' control of time parameter nrstdt' ) CALL iom_get( inum, jpdom_local, 'hicif' , hicif ) CALL iom_get( inum, jpdom_local, 'hsnif' , hsnif ) CALL iom_get( inum, jpdom_local, 'frld' , frld ) CALL iom_get( inum, jpdom_local, 'sist' , sist ) # if defined key_coupled CALL iom_get( inum, jpdom_local, 'albege', albege ) # endif CALL iom_get( inum, jpdom_unknown, 'tbif', tbif ) CALL iom_get( inum, jpdom_local, 'u_ice' , u_ice ) CALL iom_get( inum, jpdom_local, 'v_ice' , v_ice ) CALL iom_get( inum, jpdom_local, 'gtaux' , gtaux ) CALL iom_get( inum, jpdom_local, 'gtauy' , gtauy ) CALL iom_get( inum, jpdom_local, 'qstoif', qstoif ) CALL iom_get( inum, jpdom_local, 'fsbbq' , fsbbq ) CALL iom_get( inum, jpdom_unknown, 'moment', zmoment ) sxice(:,:) = zmoment(:,:,1) syice(:,:) = zmoment(:,:,2) sxxice(:,:) = zmoment(:,:,3) syyice(:,:) = zmoment(:,:,4) sxyice(:,:) = zmoment(:,:,5) sxsn(:,:) = zmoment(:,:,6) sysn(:,:) = zmoment(:,:,7) sxxsn(:,:) = zmoment(:,:,8) syysn(:,:) = zmoment(:,:,9) sxysn(:,:) = zmoment(:,:,10) sxa(:,:) = zmoment(:,:,11) sya(:,:) = zmoment(:,:,12) sxxa(:,:) = zmoment(:,:,13) syya(:,:) = zmoment(:,:,14) sxya(:,:) = zmoment(:,:,15) sxc0(:,:) = zmoment(:,:,16) syc0(:,:) = zmoment(:,:,17) sxxc0(:,:) = zmoment(:,:,18) syyc0(:,:) = zmoment(:,:,19) sxyc0(:,:) = zmoment(:,:,20) sxc1(:,:) = zmoment(:,:,21) syc1(:,:) = zmoment(:,:,22) sxxc1(:,:) = zmoment(:,:,23) syyc1(:,:) = zmoment(:,:,24) sxyc1(:,:) = zmoment(:,:,25) sxc2(:,:) = zmoment(:,:,26) syc2(:,:) = zmoment(:,:,27) sxxc2(:,:) = zmoment(:,:,28) syyc2(:,:) = zmoment(:,:,29) sxyc2(:,:) = zmoment(:,:,30) sxst(:,:) = zmoment(:,:,31) syst(:,:) = zmoment(:,:,32) sxxst(:,:) = zmoment(:,:,33) syyst(:,:) = zmoment(:,:,34) sxyst(:,:) = zmoment(:,:,35) CALL iom_close( inum ) niter = it1 END SUBROUTINE lim_rst_read # endif #else !!---------------------------------------------------------------------- !! Default option : Empty module NO LIM sea-ice model !!---------------------------------------------------------------------- CONTAINS SUBROUTINE lim_rst_read ! Empty routine END SUBROUTINE lim_rst_read SUBROUTINE lim_rst_write ! Empty routine END SUBROUTINE lim_rst_write #endif !!====================================================================== END MODULE limrst