source: NEMO/branches/UKMO/r12083_restart_datestamp/src/ICE/icerst.F90 @ 12477

Last change on this file since 12477 was 12477, checked in by jcastill, 12 months ago

Changes as in the original branch, plus changes for bgc restart (in branch AMM15_v3_6_STABLE_package_collate)

File size: 13.6 KB
Line 
1MODULE icerst
2   !!======================================================================
3   !!                     ***  MODULE  icerst  ***
4   !!   sea-ice :  write/read the ice restart file
5   !!======================================================================
6   !! History:   4.0  !  2018     (many people)      SI3 [aka Sea Ice cube]
7   !!----------------------------------------------------------------------
8#if defined key_si3
9   !!----------------------------------------------------------------------
10   !!   'key_si3'                                       SI3 sea-ice model
11   !!----------------------------------------------------------------------
12   !!   ice_rst_opn   : open  restart file
13   !!   ice_rst_write : write restart file
14   !!   ice_rst_read  : read  restart file
15   !!----------------------------------------------------------------------
16   USE ice            ! sea-ice: variables
17   USE dom_oce        ! ocean domain
18   USE phycst  , ONLY : rt0
19   USE sbc_oce , ONLY : nn_fsbc, ln_cpl
20   USE iceistate      ! sea-ice: initial state
21   USE icectl         ! sea-ice: control
22   !
23   USE in_out_manager ! I/O manager
24   USE iom            ! I/O manager library
25   USE ioipsl  , ONLY : ju2ymds    ! for calendar
26   USE lib_mpp        ! MPP library
27   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
28
29   IMPLICIT NONE
30   PRIVATE
31
32   PUBLIC   ice_rst_opn     ! called by icestp
33   PUBLIC   ice_rst_write   ! called by icestp
34   PUBLIC   ice_rst_read    ! called by ice_init
35
36   !!----------------------------------------------------------------------
37   !! NEMO/ICE 4.0 , NEMO Consortium (2018)
38   !! $Id$
39   !! Software governed by the CeCILL license (see ./LICENSE)
40   !!----------------------------------------------------------------------
41CONTAINS
42
43   SUBROUTINE ice_rst_opn( kt )
44      !!----------------------------------------------------------------------
45      !!                    ***  ice_rst_opn  ***
46      !!
47      !! ** purpose  :   open restart file
48      !!----------------------------------------------------------------------
49      INTEGER             ::   iyear, imonth, iday 
50      REAL (wp)           ::   zsec 
51      REAL (wp)           ::   zfjulday      !!
52      INTEGER, INTENT(in) ::   kt       ! number of iteration
53      !
54      CHARACTER(len=20)   ::   clkt     ! ocean time-step define as a character
55      CHARACTER(len=50)   ::   clname   ! ice output restart file name
56      CHARACTER(len=256)  ::   clpath   ! full path to ice output restart file
57      !!----------------------------------------------------------------------
58      !
59      IF( kt == nit000 )   lrst_ice = .FALSE.   ! default definition
60
61      IF( ln_rst_list .OR. nn_stock /= -1 ) THEN
62      ! in order to get better performances with NetCDF format, we open and define the ice restart file
63      ! one ice time step before writing the data (-> at nitrst - 2*nn_fsbc + 1), except if we write ice
64      ! restart files every ice time step or if an ice restart file was writen at nitend - 2*nn_fsbc + 1
65      IF( kt == nitrst - 2*nn_fsbc + 1 .OR. nn_stock == nn_fsbc    &
66         &                             .OR. ( kt == nitend - nn_fsbc + 1 .AND. .NOT. lrst_ice ) ) THEN
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 ( ln_rstdate ) THEN 
70               zfjulday = fjulday + rdt / rday 
71               IF( ABS(zfjulday - REAL(NINT(zfjulday),wp)) < 0.1 / rday )   zfjulday = REAL(NINT(zfjulday),wp)   ! avoid truncation error 
72               CALL ju2ymds( zfjulday, iyear, imonth, iday, zsec )             
73               WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday   
74            ELSE 
75              IF( nitrst > 999999999 ) THEN     
76                WRITE(clkt, *       ) nitrst 
77              ELSE               
78                WRITE(clkt, '(i8.8)') nitrst 
79              ENDIF
80            ENDIF
81            ! create the file
82            clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out)
83            clpath = TRIM(cn_icerst_outdir) 
84            IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath)//'/'
85            IF(lwp) THEN
86               WRITE(numout,*)
87               WRITE(numout,*) '             open ice restart NetCDF file: ',TRIM(clpath)//clname
88               IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN
89                  WRITE(numout,*) '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp
90               ELSE
91                  WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp
92               ENDIF
93            ENDIF
94            !
95            CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kdlev = jpl )
96            lrst_ice = .TRUE.
97         ENDIF
98      ENDIF
99      ENDIF
100      !
101      IF( ln_icectl )   CALL ice_prt( kt, iiceprt, jiceprt, 1, ' - Beginning the time step - ' )   ! control print
102      !
103   END SUBROUTINE ice_rst_opn
104
105
106   SUBROUTINE ice_rst_write( kt )
107      !!----------------------------------------------------------------------
108      !!                    ***  ice_rst_write  ***
109      !!
110      !! ** purpose  :   write restart file
111      !!----------------------------------------------------------------------
112      INTEGER, INTENT(in) ::   kt     ! number of iteration
113      !!
114      INTEGER ::   jk    ! dummy loop indices
115      INTEGER ::   iter
116      CHARACTER(len=25) ::   znam
117      CHARACTER(len=2)  ::   zchar, zchar1
118      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z3d   ! 3D workspace
119      !!----------------------------------------------------------------------
120
121      iter = kt + nn_fsbc - 1   ! ice restarts are written at kt == nitrst - nn_fsbc + 1
122
123      IF( iter == nitrst ) THEN
124         IF(lwp) WRITE(numout,*)
125         IF(lwp) WRITE(numout,*) 'ice_rst_write : write ice restart file  kt =', kt
126         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~'         
127      ENDIF
128
129      ! Write in numriw (if iter == nitrst)
130      ! ------------------
131      !                                                                        ! calendar control
132      CALL iom_rstput( iter, nitrst, numriw, 'nn_fsbc', REAL( nn_fsbc, wp ) )      ! time-step
133      CALL iom_rstput( iter, nitrst, numriw, 'kt_ice' , REAL( iter   , wp ) )      ! date
134      CALL iom_delay_rst( 'WRITE', 'ICE', numriw )   ! save only ice delayed global communication variables
135
136      ! Prognostic variables
137      CALL iom_rstput( iter, nitrst, numriw, 'v_i'  , v_i   )
138      CALL iom_rstput( iter, nitrst, numriw, 'v_s'  , v_s   )
139      CALL iom_rstput( iter, nitrst, numriw, 'sv_i' , sv_i  )
140      CALL iom_rstput( iter, nitrst, numriw, 'a_i'  , a_i   )
141      CALL iom_rstput( iter, nitrst, numriw, 't_su' , t_su  )
142      CALL iom_rstput( iter, nitrst, numriw, 'u_ice', u_ice )
143      CALL iom_rstput( iter, nitrst, numriw, 'v_ice', v_ice )
144      CALL iom_rstput( iter, nitrst, numriw, 'oa_i' , oa_i  )
145      CALL iom_rstput( iter, nitrst, numriw, 'a_ip' , a_ip  )
146      CALL iom_rstput( iter, nitrst, numriw, 'v_ip' , v_ip  )
147      ! Snow enthalpy
148      DO jk = 1, nlay_s 
149         WRITE(zchar1,'(I2.2)') jk
150         znam = 'e_s'//'_l'//zchar1
151         z3d(:,:,:) = e_s(:,:,jk,:)
152         CALL iom_rstput( iter, nitrst, numriw, znam , z3d )
153      END DO
154      ! Ice enthalpy
155      DO jk = 1, nlay_i 
156         WRITE(zchar1,'(I2.2)') jk
157         znam = 'e_i'//'_l'//zchar1
158         z3d(:,:,:) = e_i(:,:,jk,:)
159         CALL iom_rstput( iter, nitrst, numriw, znam , z3d )
160      END DO
161      ! fields needed for Met Office (Jules) coupling
162      IF( ln_cpl ) THEN
163         CALL iom_rstput( iter, nitrst, numriw, 'cnd_ice', cnd_ice )
164         CALL iom_rstput( iter, nitrst, numriw, 't1_ice' , t1_ice  )
165      ENDIF
166      !
167
168      ! close restart file
169      ! ------------------
170      IF( iter == nitrst ) THEN
171         CALL iom_close( numriw )
172         lrst_ice = .FALSE.
173      ENDIF
174      !
175   END SUBROUTINE ice_rst_write
176
177
178   SUBROUTINE ice_rst_read
179      !!----------------------------------------------------------------------
180      !!                    ***  ice_rst_read  ***
181      !!
182      !! ** purpose  :   read restart file
183      !!----------------------------------------------------------------------
184      INTEGER           ::   jk
185      LOGICAL           ::   llok
186      INTEGER           ::   id0, id1, id2, id3, id4   ! local integer
187      CHARACTER(len=25) ::   znam
188      CHARACTER(len=2)  ::   zchar, zchar1
189      REAL(wp)          ::   zfice, ziter
190      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z3d   ! 3D workspace
191      !!----------------------------------------------------------------------
192
193      IF(lwp) THEN
194         WRITE(numout,*)
195         WRITE(numout,*) 'ice_rst_read: read ice NetCDF restart file'
196         WRITE(numout,*) '~~~~~~~~~~~~'
197      ENDIF
198
199      CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir, kdlev = jpl )
200
201      ! test if v_i exists
202      id0 = iom_varid( numrir, 'v_i' , ldstop = .FALSE. )
203
204      !                    ! ------------------------------ !
205      IF( id0 > 0 ) THEN   ! == case of a normal restart == !
206         !                 ! ------------------------------ !
207         
208         ! Time info
209         CALL iom_get( numrir, 'nn_fsbc', zfice )
210         CALL iom_get( numrir, 'kt_ice' , ziter )   
211         IF(lwp) WRITE(numout,*) '   read ice restart file at time step    : ', ziter
212         IF(lwp) WRITE(numout,*) '   in any case we force it to nit000 - 1 : ', nit000 - 1
213
214         ! Control of date
215         IF( ( nit000 - NINT(ziter) ) /= 1 .AND. ABS( nrstdt ) == 1 )   &
216            &     CALL ctl_stop( 'ice_rst_read ===>>>> : problem with nit000 in ice restart',  &
217            &                   '   verify the file or rerun with the value 0 for the',        &
218            &                   '   control of time parameter  nrstdt' )
219         IF( NINT(zfice) /= nn_fsbc          .AND. ABS( nrstdt ) == 1 )   &
220            &     CALL ctl_stop( 'ice_rst_read ===>>>> : problem with nn_fsbc in ice restart',  &
221            &                   '   verify the file or rerun with the value 0 for the',         &
222            &                   '   control of time parameter  nrstdt' )
223
224         ! --- mandatory fields --- !
225         CALL iom_get( numrir, jpdom_autoglo, 'v_i'  , v_i   )
226         CALL iom_get( numrir, jpdom_autoglo, 'v_s'  , v_s   )
227         CALL iom_get( numrir, jpdom_autoglo, 'sv_i' , sv_i  )
228         CALL iom_get( numrir, jpdom_autoglo, 'a_i'  , a_i   )
229         CALL iom_get( numrir, jpdom_autoglo, 't_su' , t_su  )
230         CALL iom_get( numrir, jpdom_autoglo, 'u_ice', u_ice )
231         CALL iom_get( numrir, jpdom_autoglo, 'v_ice', v_ice )
232         ! Snow enthalpy
233         DO jk = 1, nlay_s
234            WRITE(zchar1,'(I2.2)') jk
235            znam = 'e_s'//'_l'//zchar1
236            CALL iom_get( numrir, jpdom_autoglo, znam , z3d )
237            e_s(:,:,jk,:) = z3d(:,:,:)
238         END DO
239         ! Ice enthalpy
240         DO jk = 1, nlay_i
241            WRITE(zchar1,'(I2.2)') jk
242            znam = 'e_i'//'_l'//zchar1
243            CALL iom_get( numrir, jpdom_autoglo, znam , z3d )
244            e_i(:,:,jk,:) = z3d(:,:,:)
245         END DO
246         ! -- optional fields -- !
247         ! ice age
248         id1 = iom_varid( numrir, 'oa_i' , ldstop = .FALSE. )
249         IF( id1 > 0 ) THEN                       ! fields exist
250            CALL iom_get( numrir, jpdom_autoglo, 'oa_i', oa_i )
251         ELSE                                     ! start from rest
252            IF(lwp) WRITE(numout,*) '   ==>>   previous run without ice age output then set it to zero'
253            oa_i(:,:,:) = 0._wp
254         ENDIF
255         ! melt ponds
256         id2 = iom_varid( numrir, 'a_ip' , ldstop = .FALSE. )
257         IF( id2 > 0 ) THEN                       ! fields exist
258            CALL iom_get( numrir, jpdom_autoglo, 'a_ip' , a_ip )
259            CALL iom_get( numrir, jpdom_autoglo, 'v_ip' , v_ip )
260         ELSE                                     ! start from rest
261            IF(lwp) WRITE(numout,*) '   ==>>   previous run without melt ponds output then set it to zero'
262            a_ip(:,:,:) = 0._wp
263            v_ip(:,:,:) = 0._wp
264         ENDIF
265         ! fields needed for Met Office (Jules) coupling
266         IF( ln_cpl ) THEN
267            id3 = iom_varid( numrir, 'cnd_ice' , ldstop = .FALSE. )
268            id4 = iom_varid( numrir, 't1_ice'  , ldstop = .FALSE. )
269            IF( id3 > 0 .AND. id4 > 0 ) THEN         ! fields exist
270               CALL iom_get( numrir, jpdom_autoglo, 'cnd_ice', cnd_ice )
271               CALL iom_get( numrir, jpdom_autoglo, 't1_ice' , t1_ice  )
272            ELSE                                     ! start from rest
273               IF(lwp) WRITE(numout,*) '   ==>>   previous run without conductivity output then set it to zero'
274               cnd_ice(:,:,:) = 0._wp
275               t1_ice (:,:,:) = rt0
276            ENDIF
277         ENDIF
278
279         CALL iom_delay_rst( 'READ', 'ICE', numrir )   ! read only ice delayed global communication variables
280
281         !                 ! ---------------------------------- !
282      ELSE                 ! == case of a simplified restart == !
283         !                 ! ---------------------------------- !
284         CALL ctl_warn('ice_rst_read: you are using a simplified ice restart')
285         !
286         CALL ice_istate_init
287         CALL ice_istate( nit000 )
288         !
289         IF( .NOT.ln_iceini .OR. .NOT.ln_iceini_file ) &
290            &   CALL ctl_stop('STOP', 'ice_rst_read: you need ln_ice_ini=T and ln_iceini_file=T')
291         !
292      ENDIF
293
294   END SUBROUTINE ice_rst_read
295
296#else
297   !!----------------------------------------------------------------------
298   !!   Default option :       Empty module           NO SI3 sea-ice model
299   !!----------------------------------------------------------------------
300#endif
301
302   !!======================================================================
303END MODULE icerst
Note: See TracBrowser for help on using the repository browser.