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.
icerst.F90 in NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/ICE – NEMO

source: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/ICE/icerst.F90 @ 12587

Last change on this file since 12587 was 12377, checked in by acc, 4 years ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

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