!!---------------------------------------------------------------------- !! *** limrst_dimg.h90 *** !!---------------------------------------------------------------------- !! LIM 2.0, UCL-LOCEAN-IPSL (2005) !! $Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/limrst_dimg.h90,v 1.2 2005/03/27 18:34:42 opalod Exp $ !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt !!---------------------------------------------------------------------- SUBROUTINE lim_rst_write( kt ) !!----------------------------------------------------------------------- !! *** ROUTINE lim_rst_write *** !! !! ** Purpose : Write restart fields for the LIM in mpp. !! one file per process, in the same manner as the ocean. !! !! ** Methode : Each nstock time step, save which are necessary !! for restart !! Record #1 hold general information on the state of the run !! Data fields (either 3D or 2D ) starts ar record #2 !! !! History : !! 9.0 : 04-05 (J.M. Molines ) from limrst_fdir.h90 !!----------------------------------------------------------------------- !! * Arguments USE par_ice INTEGER, INTENT(in) :: kt ! number of iteration !- dummy variables : INTEGER :: ji, jj, jf INTEGER :: inum=61, it0, irecl8, irec REAL(wp),DIMENSION(jpi,jpj,35) :: zmoment REAL(wp),DIMENSION(2) :: zinfo CHARACTER(len=45) :: ccfile = 'restart_ice_out', clres !!----------------------------------------------------------------------- !! This routine is called from icestep if it is the right time to use it. !! no additional check is necessary. ! 0. Initializations ! ------------------ IF(lwp) THEN WRITE(numout,*) ' ' WRITE(numout,*) ' lim_rst_write: output done in inum = ', & inum,' at it= ',kt,' date= ',ndastp WRITE(numout,*) ' -------' ENDIF ! Open direct access file, with reclength for 2D wp fields irecl8= jpi * jpj * wp WRITE(clres,'(a,".",i3.3)') TRIM(ccfile),narea OPEN(inum,FILE=clres,FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl8 ) it0 = kt zinfo(1) = FLOAT( nfice ) ! iteration number zinfo(2) = FLOAT( it0 ) ! time-step in second ! Write in inum zmoment(:,:,1) = sxice (:,:) zmoment(:,:,2) = syice (:,:) zmoment(:,:,3) = sxxice(:,:) zmoment(:,:,4) = syyice(:,:) zmoment(:,:,5) = sxyice(:,:) zmoment(:,:,6) = sxsn (:,:) zmoment(:,:,7) = sysn (:,:) zmoment(:,:,8) = sxxsn (:,:) zmoment(:,:,9) = syysn (:,:) zmoment(:,:,10) = sxysn (:,:) zmoment(:,:,11) = sxa (:,:) zmoment(:,:,12) = sya (:,:) zmoment(:,:,13) = sxxa (:,:) zmoment(:,:,14) = syya (:,:) zmoment(:,:,15) = sxya (:,:) zmoment(:,:,16) = sxc0 (:,:) zmoment(:,:,17) = syc0 (:,:) zmoment(:,:,18) = sxxc0 (:,:) zmoment(:,:,19) = syyc0 (:,:) zmoment(:,:,20) = sxyc0 (:,:) zmoment(:,:,21) = sxc1 (:,:) zmoment(:,:,22) = syc1 (:,:) zmoment(:,:,23) = sxxc1 (:,:) zmoment(:,:,24) = syyc1 (:,:) zmoment(:,:,25) = sxyc1 (:,:) zmoment(:,:,26) = sxc2 (:,:) zmoment(:,:,27) = syc2 (:,:) zmoment(:,:,28) = sxxc2 (:,:) zmoment(:,:,29) = syyc2 (:,:) zmoment(:,:,30) = sxyc2 (:,:) zmoment(:,:,31) = sxst (:,:) zmoment(:,:,32) = syst (:,:) zmoment(:,:,33) = sxxst (:,:) zmoment(:,:,34) = syyst (:,:) zmoment(:,:,35) = sxyst (:,:) WRITE(inum,REC=1) irecl8, nfice, it0, & & ndastp, adatrj, jpi, jpj, jpk, & & jpni, jpnj, jpnij, narea, jpiglo, jpjglo, & & nlcit, nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt irec= 2 WRITE(inum,REC=irec) ht_i(:,:,1) ! prognostic variables irec = irec + 1 WRITE(inum,REC=irec) ht_s(:,:,1) irec = irec + 1 WRITE(inum,REC=irec) frld(:,:) irec = irec + 1 ! WRITE(inum,REC=irec) sist(:,:) ! irec = irec + 1 WRITE(inum,REC=irec) t_su(:,:,1) irec = irec + 1 # if defined key_coupled WRITE(inum,REC=irec) albege(:,:) irec = irec + 1 # endif ! DO jf=1, jplayersp1 ! WRITE(inum,REC=irec) tbif(:,:,jf) ! irec = irec + 1 ! END DO ! MV 2005 DO jf=1, nlay_s WRITE(inum,REC=irec) t_s(:,:,jf,1) irec = irec + 1 END DO ! END MV 2005 ! MV 2005 DO jf=1, nlay_i WRITE(inum,REC=irec) t_i(:,:,jf,1) irec = irec + 1 END DO ! END MV 2005 WRITE(inum,REC=irec) u_ice(:,:) irec = irec + 1 WRITE(inum,REC=irec) v_ice(:,:) irec = irec + 1 WRITE(inum,REC=irec) gtaux(:,:) irec = irec + 1 WRITE(inum,REC=irec) gtauy(:,:) irec = irec + 1 ! MV 2005 ! WRITE(inum,REC=irec) qstoif(:,:) ! irec = irec + 1 ! END MV 2005 WRITE(inum,REC=irec) fsbbq(:,:) irec = irec + 1 DO jf=1,35 WRITE(inum,REC=irec) zmoment(:,:,jf) irec = irec + 1 END DO CLOSE(inum) END SUBROUTINE lim_rst_write SUBROUTINE lim_rst_read(kt ) !!----------------------------------------------------------------------- !! restart from a state defined in a binary file !!----------------------------------------------------------------------- !! * Arguments USE par_ice INTEGER ,INTENT(out) :: kt ! number of iteration !- dummy variables : INTEGER :: ji, jj, jf INTEGER :: inum=71, it0, it1, ifice, irecl8, irec REAL(wp),DIMENSION(jpi,jpj,35) :: zmoment REAL(wp),DIMENSION(2) :: zinfo CHARACTER(len=45) :: ccfile = 'restart_ice_in',clres !!----------------------------------------------------------------------- !Initialisations ! Open direct access file, with reclength for 2D wp fields WRITE(clres,'(a,".",i3.3)') TRIM(ccfile),narea OPEN(inum,FILE=clres,FORM='UNFORMATTED', ACCESS='DIRECT', RECL=8) READ(inum,REC=1) irecl8 CLOSE(inum) OPEN(inum,FILE=clres,FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl8) READ(inum,REC=1) irecl8, ifice, it1 !Read inumrst it0 = nit000 IF (lwp) THEN WRITE(numout,*) WRITE(numout,*) 'lim_rst_fdir : READ restart file name ', ccfile, ' at time step : ', it1 WRITE(numout,*) '~~~~~~~~~~~~' END IF !Control of date IF( ( it0 - it1 ) /= 1 .AND. ABS( nrstdt ) == 1 ) THEN IF (lwp) THEN WRITE(numout,cform_err) WRITE(numout,*) ' ===>>>> : problem with nit000 for the restart' WRITE(numout,*) ' we stop. verify the file or rerun with the value 0 for the' WRITE(numout,*) ' control of time parameter nrstdt' END IF nstop = nstop + 1 ENDIF irec = 2 READ(inum,REC=irec) ht_i(:,:,1) ! prognostic variables irec = irec +1 READ(inum,REC=irec) ht_s(:,:,1) irec = irec +1 READ(inum,REC=irec) frld(:,:) irec = irec +1 ! READ(inum,REC=irec) sist(:,:) ! irec = irec +1 READ(inum,REC=irec) t_su(:,:) irec = irec +1 # if defined key_coupled READ(inum,REC=irec) albege(:,:) irec = irec +1 # endif ! DO jf = 1, jplayersp1 ! READ(inum,REC=irec) tbif(:,:,jf) ! irec = irec +1 ! END DO ! MV 2005 DO jf = 1, nlay_s READ(inum,REC=irec) t_s(:,:,jf,1) irec = irec +1 END DO DO jf = 1, nlay_i READ(inum,REC=irec) t_i(:,:,jf) irec = irec +1 END DO ! MV 2005 READ(inum,REC=irec) u_ice(:,:) irec = irec +1 READ(inum,REC=irec) v_ice(:,:) irec = irec +1 READ(inum,REC=irec) gtaux(:,:) irec = irec +1 READ(inum,REC=irec) gtauy(:,:) irec = irec +1 ! MV 2005 ! READ(inum,REC=irec) qstoif(:,:) ! irec = irec +1 ! END MV 2005 READ(inum,REC=irec) fsbbq(:,:) irec = irec +1 DO jf = 1, 35 READ(inum,REC=irec) zmoment(:,:,jf) irec = irec +1 END DO CLOSE(inum) kt = it1 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) END SUBROUTINE lim_rst_read