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.
limrst.F90 in trunk/NEMO/LIM_SRC_3 – NEMO

source: trunk/NEMO/LIM_SRC_3/limrst.F90 @ 913

Last change on this file since 913 was 888, checked in by ctlod, 16 years ago

merge dev_001_SBC branche with the trunk to include the New Surface Module package, see ticket: #113
File size: 32.8 KB
Line 
1MODULE limrst
2   !!======================================================================
3   !!                     ***  MODULE  limrst  ***
4   !! Ice restart :  write the ice restart file
5   !!======================================================================
6#if defined key_lim3
7   !!----------------------------------------------------------------------
8   !!   'key_lim3' :                                   LIM sea-ice model
9   !!----------------------------------------------------------------------
10   !!   lim_rst_opn     : open ice restart file
11   !!   lim_rst_write   : write of the restart file
12   !!   lim_rst_read    : read  the restart file
13   !!----------------------------------------------------------------------
14   !! * Modules used
15   USE ice
16   USE par_ice
17   USE in_out_manager
18   USE dom_oce
19   USE ice_oce         ! ice variables
20   USE sbc_oce         ! Surface boundary condition: ocean fields
21   USE sbc_ice         ! Surface boundary condition: ice fields
22   USE daymod
23   USE iom
24   
25   IMPLICIT NONE
26   PRIVATE
27   
28   !! * Accessibility
29   PUBLIC lim_rst_opn    ! routine called by icestep.F90
30   PUBLIC lim_rst_write  ! routine called by icestep.F90
31   PUBLIC lim_rst_read   ! routine called by iceinit.F90
32
33   LOGICAL, PUBLIC ::   lrst_ice         !: logical to control the ice restart write
34   INTEGER, PUBLIC ::   numrir, numriw   !: logical unit for ice restart (read and write)
35
36   !!----------------------------------------------------------------------
37   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)
38   !! $ Id: $
39   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
40   !!----------------------------------------------------------------------
41
42CONTAINS
43
44   SUBROUTINE lim_rst_opn( kt )
45      !!----------------------------------------------------------------------
46      !!                    ***  lim_rst_opn  ***
47      !!
48      !! ** purpose  :   output of sea-ice variable in a netcdf file
49      !!----------------------------------------------------------------------
50      INTEGER, INTENT(in) ::   kt       ! number of iteration
51      !
52      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character
53      CHARACTER(LEN=50)   ::   clname   ! ice output restart file name
54      !!----------------------------------------------------------------------
55      !
56      IF( kt == nit000 )   lrst_ice = .FALSE.   ! default definition
57     
58      ! to get better performances with NetCDF format:
59      ! we open and define the ice restart file one ice time step before writing the data (-> at nitrst - 2*nn_fsbc + 1)
60      ! except if we write ice 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. nstock == nn_fsbc .OR. ( kt == nitend - nn_fsbc + 1 .AND. .NOT. lrst_ice ) ) THEN
62         ! beware of the format used to write kt (default is i8.8, that should be large enough...)
63         IF( nitrst > 99999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
64         ELSE                           ;   WRITE(clkt, '(i8.8)') nitrst
65         ENDIF
66         ! create the file
67         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_restart_ice"
68         IF(lwp) THEN
69            WRITE(numout,*)
70            SELECT CASE ( jprstlib )
71            CASE ( jprstdimg )   ;   WRITE(numout,*) '             open ice restart binary file: '//clname
72            CASE DEFAULT         ;   WRITE(numout,*) '             open ice restart NetCDF file: '//clname
73            END SELECT
74            IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN   
75               WRITE(numout,*)         '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp
76            ELSE   ;   WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp
77            ENDIF
78         ENDIF
79
80         CALL iom_open( clname, numriw, ldwrt = .TRUE., kiolib = jprstlib )
81         lrst_ice = .TRUE.
82      ENDIF
83      !
84   END SUBROUTINE lim_rst_opn
85
86   SUBROUTINE lim_rst_write( kt )
87      !!----------------------------------------------------------------------
88      !!                    ***  lim_rst_write  ***
89      !!
90      !! ** purpose  :   output of sea-ice variable in a netcdf file
91      !!
92      !!----------------------------------------------------------------------
93      ! Arguments :
94      INTEGER, INTENT(in) ::   kt     ! number of iteration
95
96      ! Local variables :
97      REAL(wp), DIMENSION(jpi,jpj) :: z2d
98      INTEGER :: ji, jj, jk ,jl
99      INTEGER :: iter
100      CHARACTER(len=15) :: znam
101      CHARACTER(len=1)  :: zchar, zchar1
102      !!----------------------------------------------------------------------
103   
104      iter = kt + nn_fsbc - 1   ! ice restarts are written at kt == nitrst - nn_fsbc + 1
105
106      IF( iter == nitrst ) THEN
107         IF(lwp) WRITE(numout,*)
108         IF(lwp) WRITE(numout,*) 'lim_rst_write : write ice restart file  kt =', kt
109         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~'         
110      ENDIF
111
112      ! Write in numriw (if iter == nitrst)
113      ! ------------------
114      !                                                                        ! calendar control
115      CALL iom_rstput( iter, nitrst, numriw, 'nn_fsbc', REAL( nn_fsbc, wp) )      ! time-step
116      CALL iom_rstput( iter, nitrst, numriw, 'kt_ice' , REAL( iter , wp) )        ! date
117
118      ! Prognostic variables
119      DO jl = 1, jpl 
120         WRITE(zchar,'(I1)') jl
121         znam = 'v_i'//'_htc'//zchar
122         z2d(:,:) = v_i(:,:,jl)
123         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
124         znam = 'v_s'//'_htc'//zchar
125         z2d(:,:) = v_s(:,:,jl)
126         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
127         znam = 'smv_i'//'_htc'//zchar
128         z2d(:,:) = smv_i(:,:,jl)
129         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
130         znam = 'oa_i'//'_htc'//zchar
131         z2d(:,:) = oa_i(:,:,jl)
132         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
133         znam = 'a_i'//'_htc'//zchar
134         z2d(:,:) = a_i(:,:,jl)
135         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
136         znam = 't_su'//'_htc'//zchar
137         z2d(:,:) = t_su(:,:,jl)
138         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
139      END DO
140# if defined key_coupled
141      CALL iom_rstput( iter, nitrst, numriw, 'albege', albege(:,:) )
142# endif
143      DO jl = 1, jpl 
144         WRITE(zchar,'(I1)') jl
145         znam = 'tempt_sl1'//'_htc'//zchar
146         z2d(:,:) = e_s(:,:,1,jl)
147         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
148      END DO
149
150      DO jl = 1, jpl 
151         WRITE(zchar,'(I1)') jl
152         DO jk = 1, nlay_i 
153            WRITE(zchar1,'(I1)') jk
154            znam = 'tempt'//'_il'//zchar1//'_htc'//zchar
155            z2d(:,:) = e_i(:,:,jk,jl)
156            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
157         END DO
158      END DO
159
160      CALL iom_rstput( iter, nitrst, numriw, 'u_ice'     , u_ice      )
161      CALL iom_rstput( iter, nitrst, numriw, 'v_ice'     , v_ice      )
162      CALL iom_rstput( iter, nitrst, numriw, 'utaui_ice' , utaui_ice  )
163      CALL iom_rstput( iter, nitrst, numriw, 'vtaui_ice' , vtaui_ice  )
164      CALL iom_rstput( iter, nitrst, numriw, 'fsbbq'     , fsbbq      )
165      CALL iom_rstput( iter, nitrst, numriw, 'stress1_i' , stress1_i  )
166      CALL iom_rstput( iter, nitrst, numriw, 'stress2_i' , stress2_i  )
167      CALL iom_rstput( iter, nitrst, numriw, 'stress12_i', stress12_i )
168
169      DO jl = 1, jpl 
170         WRITE(zchar,'(I1)') jl
171         znam = 'sxice'//'_htc'//zchar
172         z2d(:,:) = sxice(:,:,jl)
173         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
174         znam = 'syice'//'_htc'//zchar
175         z2d(:,:) = syice(:,:,jl)
176         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
177         znam = 'sxxice'//'_htc'//zchar
178         z2d(:,:) = sxxice(:,:,jl)
179         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
180         znam = 'syyice'//'_htc'//zchar
181         z2d(:,:) = syyice(:,:,jl)
182         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
183         znam = 'sxyice'//'_htc'//zchar
184         z2d(:,:) = sxyice(:,:,jl)
185         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
186         znam = 'sxsn'//'_htc'//zchar
187         z2d(:,:) = sxsn(:,:,jl)
188         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
189         znam = 'sysn'//'_htc'//zchar
190         z2d(:,:) = sysn(:,:,jl)
191         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
192         znam = 'sxxsn'//'_htc'//zchar
193         z2d(:,:) = sxxsn(:,:,jl)
194         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
195         znam = 'syysn'//'_htc'//zchar
196         z2d(:,:) = syysn(:,:,jl)
197         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
198         znam = 'sxysn'//'_htc'//zchar
199         z2d(:,:) = sxysn(:,:,jl)
200         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
201         znam = 'sxa'//'_htc'//zchar
202         z2d(:,:) = sxa(:,:,jl)
203         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
204         znam = 'sya'//'_htc'//zchar
205         z2d(:,:) = sya(:,:,jl)
206         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
207         znam = 'sxxa'//'_htc'//zchar
208         z2d(:,:) = sxxa(:,:,jl)
209         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
210         znam = 'syya'//'_htc'//zchar
211         z2d(:,:) = syya(:,:,jl)
212         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
213         znam = 'sxya'//'_htc'//zchar
214         z2d(:,:) = sxya(:,:,jl)
215         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
216         znam = 'sxc0'//'_htc'//zchar
217         z2d(:,:) = sxc0(:,:,jl)
218         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
219         znam = 'syc0'//'_htc'//zchar
220         z2d(:,:) = syc0(:,:,jl)
221         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
222         znam = 'sxxc0'//'_htc'//zchar
223         z2d(:,:) = sxxc0(:,:,jl)
224         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
225         znam = 'syyc0'//'_htc'//zchar
226         z2d(:,:) = syyc0(:,:,jl)
227         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
228         znam = 'sxyc0'//'_htc'//zchar
229         z2d(:,:) = sxyc0(:,:,jl)
230         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
231         znam = 'sxsal'//'_htc'//zchar
232         z2d(:,:) = sxsal(:,:,jl)
233         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
234         znam = 'sysal'//'_htc'//zchar
235         z2d(:,:) = sysal(:,:,jl)
236         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
237         znam = 'sxxsal'//'_htc'//zchar
238         z2d(:,:) = sxxsal(:,:,jl)
239         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
240         znam = 'syysal'//'_htc'//zchar
241         z2d(:,:) = syysal(:,:,jl)
242         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
243         znam = 'sxysal'//'_htc'//zchar
244         z2d(:,:) = sxysal(:,:,jl)
245         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
246         znam = 'sxage'//'_htc'//zchar
247         z2d(:,:) = sxage(:,:,jl)
248         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
249         znam = 'syage'//'_htc'//zchar
250         z2d(:,:) = syage(:,:,jl)
251         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
252         znam = 'sxxage'//'_htc'//zchar
253         z2d(:,:) = sxxage(:,:,jl)
254         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
255         znam = 'syyage'//'_htc'//zchar
256         z2d(:,:) = syyage(:,:,jl)
257         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
258         znam = 'sxyage'//'_htc'//zchar
259         z2d(:,:) = sxyage(:,:,jl)
260         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
261      END DO
262
263      CALL iom_rstput( iter, nitrst, numriw, 'sxopw ' ,  sxopw  )
264      CALL iom_rstput( iter, nitrst, numriw, 'syopw ' ,  syopw  )
265      CALL iom_rstput( iter, nitrst, numriw, 'sxxopw' ,  sxxopw )
266      CALL iom_rstput( iter, nitrst, numriw, 'syyopw' ,  syyopw )
267      CALL iom_rstput( iter, nitrst, numriw, 'sxyopw' ,  sxyopw )
268
269      DO jl = 1, jpl 
270         WRITE(zchar,'(I1)') jl
271         DO jk = 1, nlay_i 
272            WRITE(zchar1,'(I1)') jk
273            znam = 'sxe'//'_il'//zchar1//'_htc'//zchar
274            z2d(:,:) = sxe(:,:,jk,jl)
275            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
276            znam = 'sye'//'_il'//zchar1//'_htc'//zchar
277            z2d(:,:) = sye(:,:,jk,jl)
278            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
279            znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar
280            z2d(:,:) = sxxe(:,:,jk,jl)
281            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
282            znam = 'syye'//'_il'//zchar1//'_htc'//zchar
283            z2d(:,:) = syye(:,:,jk,jl)
284            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
285            znam = 'sxye'//'_il'//zchar1//'_htc'//zchar
286            z2d(:,:) = sxye(:,:,jk,jl)
287            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
288         END DO
289      END DO
290
291      IF( iter == nitrst ) THEN
292         CALL iom_close( numriw )                         ! close the restart file
293         lrst_ice = .FALSE.
294      ENDIF
295      !
296   
297   !+++++++++++ CHECK EVERYTHING ++++++++++
298               WRITE(numout,*)
299               WRITE(numout,*) ' lim_rst_write : CHUKCHI SEA POINT '
300               WRITE(numout,*) ' ~~~~~~~~~~'
301               WRITE(numout,*) ' ~~~ Arctic'
302   
303               ji = jiindx
304               jj = jjindx
305   
306               WRITE(numout,*) ' ji, jj ', ji, jj
307               WRITE(numout,*) ' ICE VARIABLES '
308               WRITE(numout,*) ' open water ', ato_i(ji,jj)
309               DO jl = 1, jpl
310                  WRITE(numout,*) ' *** CATEGORY NUMBER *** ', jl
311                  WRITE(numout,*) ' '
312                  WRITE(numout,*) ' a_i        : ', a_i(ji,jj,jl)     
313                  WRITE(numout,*) ' v_i        : ', v_i(ji,jj,jl) 
314                  WRITE(numout,*) ' v_s        : ', v_s(ji,jj,jl)   
315                  WRITE(numout,*) ' e_s        : ', e_s(ji,jj,1,jl)/1.0e9
316                  WRITE(numout,*) ' e_i1       : ', e_i(ji,jj,1,jl)/1.0e9     
317                  WRITE(numout,*) ' e_i2       : ', e_i(ji,jj,2,jl)/1.0e9     
318                  WRITE(numout,*) ' smv_i      : ', smv_i(ji,jj,jl) 
319                  WRITE(numout,*) ' oa_i       : ', oa_i(ji,jj,jl)
320                  WRITE(numout,*) ' t_su       : ', t_su(ji,jj,jl)
321               END DO
322   
323               WRITE(numout,*) ' MOMENTS OF ADVECTION '
324   
325               WRITE(numout,*) ' open water '
326               WRITE(numout,*) ' sxopw  ', sxopw(ji,jj)
327               WRITE(numout,*) ' syopw  ', syopw(ji,jj)
328               WRITE(numout,*) ' sxxopw ', sxxopw(ji,jj)
329               WRITE(numout,*) ' syyopw ', syyopw(ji,jj)
330               WRITE(numout,*) ' sxyopw ', sxyopw(ji,jj)
331               DO jl = 1, jpl
332                  WRITE(numout,*) ' jl, ice volume content ', jl
333                  WRITE(numout,*) ' sxice  ', sxice(ji,jj,jl)
334                  WRITE(numout,*) ' syice  ', syice(ji,jj,jl)
335                  WRITE(numout,*) ' sxxice ', sxxice(ji,jj,jl)
336                  WRITE(numout,*) ' syyice ', syyice(ji,jj,jl)
337                  WRITE(numout,*) ' sxyice ', sxyice(ji,jj,jl)
338                  WRITE(numout,*) ' jl, snow volume content ', jl
339                  WRITE(numout,*) ' sxsn   ', sxsn(ji,jj,jl)
340                  WRITE(numout,*) ' sysn   ', sysn(ji,jj,jl)
341                  WRITE(numout,*) ' sxxsn  ', sxxsn(ji,jj,jl)
342                  WRITE(numout,*) ' syysn  ', syysn(ji,jj,jl)
343                  WRITE(numout,*) ' sxysn  ', sxysn(ji,jj,jl)
344                  WRITE(numout,*) ' jl, ice area in category ', jl
345                  WRITE(numout,*) ' sxa    ', sxa (ji,jj,jl)
346                  WRITE(numout,*) ' sya    ', sya (ji,jj,jl)
347                  WRITE(numout,*) ' sxxa   ', sxxa (ji,jj,jl)
348                  WRITE(numout,*) ' syya   ', syya (ji,jj,jl)
349                  WRITE(numout,*) ' sxya   ', sxya (ji,jj,jl)
350                  WRITE(numout,*) ' jl, snow temp ', jl
351                  WRITE(numout,*) ' sxc0   ', sxc0(ji,jj,jl)
352                  WRITE(numout,*) ' syc0   ', syc0(ji,jj,jl)
353                  WRITE(numout,*) ' sxxc0  ', sxxc0(ji,jj,jl)
354                  WRITE(numout,*) ' syyc0  ', syyc0(ji,jj,jl)
355                  WRITE(numout,*) ' sxyc0  ', sxyc0(ji,jj,jl)
356                  WRITE(numout,*) ' jl, ice salinity ', jl
357                  WRITE(numout,*) ' sxsal  ', sxsal(ji,jj,jl)
358                  WRITE(numout,*) ' sysal  ', sysal(ji,jj,jl)
359                  WRITE(numout,*) ' sxxsal ', sxxsal(ji,jj,jl)
360                  WRITE(numout,*) ' syysal ', syysal(ji,jj,jl)
361                  WRITE(numout,*) ' sxysal ', sxysal(ji,jj,jl)
362                  WRITE(numout,*) ' jl, ice age      ', jl
363                  WRITE(numout,*) ' sxage  ', sxage(ji,jj,jl)
364                  WRITE(numout,*) ' syage  ', syage(ji,jj,jl)
365                  WRITE(numout,*) ' sxxage ', sxxage(ji,jj,jl)
366                  WRITE(numout,*) ' syyage ', syyage(ji,jj,jl)
367                  WRITE(numout,*) ' sxyage ', sxyage(ji,jj,jl)
368               END DO
369               DO jl = 1, jpl
370                  DO jk = 1, nlay_i
371                     WRITE(numout,*) ' jk, jl, ice heat content', jk, jl
372                     WRITE(numout,*) ' sxe    ', sxe(ji,jj,jk,jl)
373                     WRITE(numout,*) ' sye    ', sye(ji,jj,jk,jl)
374                     WRITE(numout,*) ' sxxe   ', sxxe(ji,jj,jk,jl)
375                     WRITE(numout,*) ' syye   ', syye(ji,jj,jk,jl)
376                     WRITE(numout,*) ' sxye   ', sxye(ji,jj,jk,jl)
377                  END DO
378               END DO
379   
380   !+++++++++++ END CHECK +++++++++++++++++
381   
382      END SUBROUTINE lim_rst_write
383   
384   SUBROUTINE lim_rst_read
385      !!----------------------------------------------------------------------
386      !!                    ***  lim_rst_read  ***
387      !!
388      !! ** purpose  :   read of sea-ice variable restart in a netcdf file
389      !!----------------------------------------------------------------------
390      ! Local variables
391      INTEGER :: ji, jj, jk, jl, indx
392      REAL(wp) ::   zfice, ziter
393      REAL(wp) :: & !parameters for the salinity profile
394         zs_inf, z_slope_s, zsmax, zsmin, zalpha, zindb
395      REAL(wp), DIMENSION(nlay_i) :: zs_zero 
396      REAL(wp), DIMENSION(jpi,jpj) :: z2d
397      CHARACTER(len=15) :: znam
398      CHARACTER(len=1) :: zchar, zchar1
399      !!----------------------------------------------------------------------
400   
401      IF(lwp) THEN
402         WRITE(numout,*)
403         WRITE(numout,*) 'lim_rst_read : read ice NetCDF restart file'
404         WRITE(numout,*) '~~~~~~~~~~~~~~'
405      ENDIF
406
407      CALL iom_open ( 'restart_ice_in', numrir, kiolib = jprstlib )
408
409      CALL iom_get( numrir, 'nn_fsbc', zfice )
410      CALL iom_get( numrir, 'kt_ice' , ziter )   
411      IF(lwp) WRITE(numout,*) '   read ice restart file at time step    : ', ziter
412      IF(lwp) WRITE(numout,*) '   in any case we force it to nit000 - 1 : ', nit000 - 1
413
414      !Control of date
415     
416      IF( ( nit000 - INT(ziter) ) /= 1 .AND. ABS( nrstdt ) == 1 )   &
417         &     CALL ctl_stop( 'lim_rst_read ===>>>> : problem with nit000 in ice restart',  &
418         &                   '   verify the file or rerun with the value 0 for the',        &
419         &                   '   control of time parameter  nrstdt' )
420      IF( INT(zfice) /= nn_fsbc          .AND. ABS( nrstdt ) == 1 )   &
421         &     CALL ctl_stop( 'lim_rst_read ===>>>> : problem with nn_fsbc in ice restart',  &
422         &                   '   verify the file or rerun with the value 0 for the',         &
423         &                   '   control of time parameter  nrstdt' )
424
425      DO jl = 1, jpl 
426         WRITE(zchar,'(I1)') jl
427         znam = 'v_i'//'_htc'//zchar
428         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
429         v_i(:,:,jl) = z2d(:,:)
430         znam = 'v_s'//'_htc'//zchar
431         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
432         v_s(:,:,jl) = z2d(:,:) 
433         znam = 'smv_i'//'_htc'//zchar
434         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
435         smv_i(:,:,jl) = z2d(:,:)
436         znam = 'oa_i'//'_htc'//zchar
437         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
438         oa_i(:,:,jl) = z2d(:,:)
439         znam = 'a_i'//'_htc'//zchar
440         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
441         a_i(:,:,jl) = z2d(:,:)
442         znam = 't_su'//'_htc'//zchar
443         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
444         t_su(:,:,jl) = z2d(:,:)
445      END DO
446
447      ! we first with bulk ice salinity
448      DO jl = 1, jpl
449         DO jj = 1, jpj
450            DO ji = 1, jpi
451               zindb          = MAX( 0.0 , SIGN( 1.0 , v_i(ji,jj,jl) - 1.0e-4 ) ) 
452               sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX(v_i(ji,jj,jl),1.0e-6) * zindb
453               ht_i(ji,jj,jl) = v_i(ji,jj,jl)   / MAX(a_i(ji,jj,jl),1.0e-6) * zindb
454            END DO
455         END DO
456      END DO
457   
458      DO jk = 1, nlay_i
459         s_i(:,:,jk,:) = sm_i(:,:,:)
460      END DO
461   
462      ! Salinity profile
463      !-----------------
464      WRITE(numout,*) ' num_sal - will restart understand salinity profile ', num_sal
465   
466      num_sal = 2
467      IF(num_sal.eq.2) THEN
468   !     CALL lim_var_salprof
469         DO jl = 1, jpl
470            DO jk = 1, nlay_i
471               DO jj = 1, jpj
472                  DO ji = 1, jpi
473                     zs_inf        = sm_i(ji,jj,jl)
474                     z_slope_s     = 2.0*sm_i(ji,jj,jl)/MAX(0.01,ht_i(ji,jj,jl))
475                                     !- slope of the salinity profile
476                     zs_zero(jk)   = z_slope_s * ( FLOAT(jk)-1.0/2.0 ) * &
477                                                  ht_i(ji,jj,jl) / FLOAT(nlay_i)
478                     zsmax = 4.5
479                     zsmin = 3.5
480                     IF( sm_i(ji,jj,jl) .LT. zsmin ) THEN
481                        zalpha = 1.0
482                     ELSEIF( sm_i(ji,jj,jl) .LT.zsmax ) THEN
483                        zalpha = sm_i(ji,jj,jl) / (zsmin-zsmax) + zsmax / (zsmax-zsmin)
484                     ELSE
485                        zalpha = 0.0
486                     ENDIF
487                     s_i(ji,jj,jk,jl) = zalpha*zs_zero(jk) + ( 1.0 - zalpha )*zs_inf
488                  END DO
489               END DO
490            END DO
491         END DO
492      ENDIF
493         
494# if defined key_coupled 
495      CALL iom_get( numrir, jpdom_autoglo, 'albege'   , albege )
496# endif
497      DO jl = 1, jpl 
498         WRITE(zchar,'(I1)') jl
499         znam = 'tempt_sl1'//'_htc'//zchar
500         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
501         e_s(:,:,1,jl) = z2d(:,:)
502      END DO
503   
504      DO jl = 1, jpl 
505         WRITE(zchar,'(I1)') jl
506         DO jk = 1, nlay_i 
507            WRITE(zchar1,'(I1)') jk
508            znam = 'tempt'//'_il'//zchar1//'_htc'//zchar
509            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
510            e_i(:,:,jk,jl) = z2d(:,:)
511         END DO
512      END DO
513
514      CALL iom_get( numrir, jpdom_autoglo, 'u_ice'     , u_ice      )
515      CALL iom_get( numrir, jpdom_autoglo, 'v_ice'     , v_ice      )
516      CALL iom_get( numrir, jpdom_autoglo, 'utaui_ice' , utaui_ice  )
517      CALL iom_get( numrir, jpdom_autoglo, 'vtaui_ice' , vtaui_ice  )
518      CALL iom_get( numrir, jpdom_autoglo, 'fsbbq'     , fsbbq      )
519      CALL iom_get( numrir, jpdom_autoglo, 'stress1_i' , stress1_i  )
520      CALL iom_get( numrir, jpdom_autoglo, 'stress2_i' , stress2_i  )
521      CALL iom_get( numrir, jpdom_autoglo, 'stress12_i', stress12_i )
522
523      DO jl = 1, jpl 
524         WRITE(zchar,'(I1)') jl
525         znam = 'sxice'//'_htc'//zchar
526         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
527         sxice(:,:,jl) = z2d(:,:)
528         znam = 'syice'//'_htc'//zchar
529         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
530         syice(:,:,jl) = z2d(:,:)
531         znam = 'sxxice'//'_htc'//zchar
532         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
533         sxxice(:,:,jl) = z2d(:,:)
534         znam = 'syyice'//'_htc'//zchar
535         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
536         syyice(:,:,jl) = z2d(:,:)
537         znam = 'sxyice'//'_htc'//zchar
538         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
539         sxyice(:,:,jl) = z2d(:,:)
540         znam = 'sxsn'//'_htc'//zchar
541         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
542         sxsn(:,:,jl) = z2d(:,:)
543         znam = 'sysn'//'_htc'//zchar
544         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
545         sysn(:,:,jl) = z2d(:,:)
546         znam = 'sxxsn'//'_htc'//zchar
547         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
548         sxxsn(:,:,jl) = z2d(:,:)
549         znam = 'syysn'//'_htc'//zchar
550         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
551         syysn(:,:,jl) = z2d(:,:)
552         znam = 'sxysn'//'_htc'//zchar
553         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
554         sxysn(:,:,jl) = z2d(:,:)
555         znam = 'sxa'//'_htc'//zchar
556         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
557         sxa(:,:,jl) = z2d(:,:)
558         znam = 'sya'//'_htc'//zchar
559         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
560         sya(:,:,jl) = z2d(:,:)
561         znam = 'sxxa'//'_htc'//zchar
562         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
563         sxxa(:,:,jl) = z2d(:,:)
564         znam = 'syya'//'_htc'//zchar
565         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
566         syya(:,:,jl) = z2d(:,:)
567         znam = 'sxya'//'_htc'//zchar
568         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
569         sxya(:,:,jl) = z2d(:,:)
570         znam = 'sxc0'//'_htc'//zchar
571         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
572         sxc0(:,:,jl) = z2d(:,:)
573         znam = 'syc0'//'_htc'//zchar
574         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
575         syc0(:,:,jl) = z2d(:,:)
576         znam = 'sxxc0'//'_htc'//zchar
577         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
578         sxxc0(:,:,jl) = z2d(:,:)
579         znam = 'syyc0'//'_htc'//zchar
580         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
581         syyc0(:,:,jl) = z2d(:,:)
582         znam = 'sxyc0'//'_htc'//zchar
583         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
584         sxyc0(:,:,jl) = z2d(:,:)
585         znam = 'sxsal'//'_htc'//zchar
586         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
587         sxsal(:,:,jl) = z2d(:,:)
588         znam = 'sysal'//'_htc'//zchar
589         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
590         sysal(:,:,jl) = z2d(:,:)
591         znam = 'sxxsal'//'_htc'//zchar
592         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
593         sxxsal(:,:,jl) = z2d(:,:)
594         znam = 'syysal'//'_htc'//zchar
595         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
596         syysal(:,:,jl) = z2d(:,:)
597         znam = 'sxysal'//'_htc'//zchar
598         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
599         sxysal(:,:,jl) = z2d(:,:)
600         znam = 'sxage'//'_htc'//zchar
601         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
602         sxage(:,:,jl) = z2d(:,:)
603         znam = 'syage'//'_htc'//zchar
604         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
605         syage(:,:,jl) = z2d(:,:)
606         znam = 'sxxage'//'_htc'//zchar
607         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
608         sxxage(:,:,jl) = z2d(:,:)
609         znam = 'syyage'//'_htc'//zchar
610         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
611         syyage(:,:,jl) = z2d(:,:)
612         znam = 'sxyage'//'_htc'//zchar
613         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
614         sxyage(:,:,jl)= z2d(:,:)
615      END DO
616
617      CALL iom_get( numrir, jpdom_autoglo, 'sxopw ' ,  sxopw  )
618      CALL iom_get( numrir, jpdom_autoglo, 'syopw ' ,  syopw  )
619      CALL iom_get( numrir, jpdom_autoglo, 'sxxopw' ,  sxxopw )
620      CALL iom_get( numrir, jpdom_autoglo, 'syyopw' ,  syyopw )
621      CALL iom_get( numrir, jpdom_autoglo, 'sxyopw' ,  sxyopw )
622
623      DO jl = 1, jpl 
624         WRITE(zchar,'(I1)') jl
625         DO jk = 1, nlay_i 
626            WRITE(zchar1,'(I1)') jk
627            znam = 'sxe'//'_il'//zchar1//'_htc'//zchar
628            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
629            sxe(:,:,jk,jl) = z2d(:,:)
630            znam = 'sye'//'_il'//zchar1//'_htc'//zchar
631            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
632            sye(:,:,jk,jl) = z2d(:,:)
633            znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar
634            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
635            sxxe(:,:,jk,jl) = z2d(:,:)
636            znam = 'syye'//'_il'//zchar1//'_htc'//zchar
637            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
638            syye(:,:,jk,jl) = z2d(:,:)
639            znam = 'sxye'//'_il'//zchar1//'_htc'//zchar
640            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
641            sxye(:,:,jk,jl) = z2d(:,:)
642         END DO
643      END DO
644
645      CALL iom_close( numrir )
646
647   !+++++++++++ CHECK EVERYTHING ++++++++++
648   
649               WRITE(numout,*)
650               WRITE(numout,*) ' lim_rst_read  : CHUKCHI SEA POINT '
651               WRITE(numout,*) ' ~~~~~~~~~~'
652               WRITE(numout,*) ' ~~~ Arctic'
653   
654               indx = 1
655               ji = 24
656               jj = 24
657               WRITE(numout,*) ' ji, jj ', ji, jj
658               WRITE(numout,*) ' ICE VARIABLES '
659               WRITE(numout,*) ' open water ', ato_i(ji,jj)
660   
661               DO jl = 1, jpl
662                  WRITE(numout,*) ' *** CATEGORY NUMBER *** ', jl
663                  WRITE(numout,*) ' '
664                  WRITE(numout,*) ' a_i        : ', a_i(ji,jj,jl)     
665                  WRITE(numout,*) ' v_i        : ', v_i(ji,jj,jl) 
666                  WRITE(numout,*) ' v_s        : ', v_s(ji,jj,jl)   
667                  WRITE(numout,*) ' e_i1       : ', e_i(ji,jj,1,jl)/1.0e9     
668                  WRITE(numout,*) ' e_i2       : ', e_i(ji,jj,2,jl)/1.0e9     
669                  WRITE(numout,*) ' e_s        : ', e_s(ji,jj,1,jl)     
670                  WRITE(numout,*) ' smv_i      : ', smv_i(ji,jj,jl) 
671                  WRITE(numout,*) ' oa_i       : ', oa_i(ji,jj,jl)
672                  WRITE(numout,*) ' t_su       : ', t_su(ji,jj,jl)
673               END DO
674   
675               WRITE(numout,*) ' open water '
676               WRITE(numout,*) ' sxopw  ', sxopw(ji,jj)
677               WRITE(numout,*) ' syopw  ', syopw(ji,jj)
678               WRITE(numout,*) ' sxxopw ', sxxopw(ji,jj)
679               WRITE(numout,*) ' syyopw ', syyopw(ji,jj)
680               WRITE(numout,*) ' sxyopw ', sxyopw(ji,jj)
681               DO jl = 1, jpl
682                  WRITE(numout,*) ' jl, ice volume content ', jl
683                  WRITE(numout,*) ' sxice  ', sxice(ji,jj,jl)
684                  WRITE(numout,*) ' syice  ', syice(ji,jj,jl)
685                  WRITE(numout,*) ' sxxice ', sxxice(ji,jj,jl)
686                  WRITE(numout,*) ' syyice ', syyice(ji,jj,jl)
687                  WRITE(numout,*) ' sxyice ', sxyice(ji,jj,jl)
688                  WRITE(numout,*) ' jl, snow volume content ', jl
689                  WRITE(numout,*) ' sxsn   ', sxsn(ji,jj,jl)
690                  WRITE(numout,*) ' sysn   ', sysn(ji,jj,jl)
691                  WRITE(numout,*) ' sxxsn  ', sxxsn(ji,jj,jl)
692                  WRITE(numout,*) ' syysn  ', syysn(ji,jj,jl)
693                  WRITE(numout,*) ' sxysn  ', sxysn(ji,jj,jl)
694                  WRITE(numout,*) ' jl, ice area in category ', jl
695                  WRITE(numout,*) ' sxa    ', sxa (ji,jj,jl)
696                  WRITE(numout,*) ' sya    ', sya (ji,jj,jl)
697                  WRITE(numout,*) ' sxxa   ', sxxa (ji,jj,jl)
698                  WRITE(numout,*) ' syya   ', syya (ji,jj,jl)
699                  WRITE(numout,*) ' sxya   ', sxya (ji,jj,jl)
700                  WRITE(numout,*) ' jl, snow temp ', jl
701                  WRITE(numout,*) ' sxc0   ', sxc0(ji,jj,jl)
702                  WRITE(numout,*) ' syc0   ', syc0(ji,jj,jl)
703                  WRITE(numout,*) ' sxxc0  ', sxxc0(ji,jj,jl)
704                  WRITE(numout,*) ' syyc0  ', syyc0(ji,jj,jl)
705                  WRITE(numout,*) ' sxyc0  ', sxyc0(ji,jj,jl)
706                  WRITE(numout,*) ' jl, ice salinity ', jl
707                  WRITE(numout,*) ' sxsal  ', sxsal(ji,jj,jl)
708                  WRITE(numout,*) ' sysal  ', sysal(ji,jj,jl)
709                  WRITE(numout,*) ' sxxsal ', sxxsal(ji,jj,jl)
710                  WRITE(numout,*) ' syysal ', syysal(ji,jj,jl)
711                  WRITE(numout,*) ' sxysal ', sxysal(ji,jj,jl)
712                  WRITE(numout,*) ' jl, ice age      ', jl
713                  WRITE(numout,*) ' sxage  ', sxage(ji,jj,jl)
714                  WRITE(numout,*) ' syage  ', syage(ji,jj,jl)
715                  WRITE(numout,*) ' sxxage ', sxxage(ji,jj,jl)
716                  WRITE(numout,*) ' syyage ', syyage(ji,jj,jl)
717                  WRITE(numout,*) ' sxyage ', sxyage(ji,jj,jl)
718               END DO
719               DO jl = 1, jpl
720                  DO jk = 1, nlay_i
721                     WRITE(numout,*) ' jk, jl, ice heat content', jk, jl
722                     WRITE(numout,*) ' sxe    ', sxe(ji,jj,jk,jl)
723                     WRITE(numout,*) ' sye    ', sye(ji,jj,jk,jl)
724                     WRITE(numout,*) ' sxxe   ', sxxe(ji,jj,jk,jl)
725                     WRITE(numout,*) ' syye   ', syye(ji,jj,jk,jl)
726                     WRITE(numout,*) ' sxye   ', sxye(ji,jj,jk,jl)
727                  END DO
728               END DO
729   
730   !+++++++++++ END CHECK +++++++++++++++++
731   
732      END SUBROUTINE lim_rst_read
733   
734   
735#else
736   !!----------------------------------------------------------------------
737   !!   Default option :       Empty module            NO LIM sea-ice model
738   !!----------------------------------------------------------------------
739CONTAINS
740   SUBROUTINE lim_rst_read             ! Empty routine
741   END SUBROUTINE lim_rst_read
742   SUBROUTINE lim_rst_write            ! Empty routine
743   END SUBROUTINE lim_rst_write
744#endif
745
746   !!======================================================================
747END MODULE limrst
Note: See TracBrowser for help on using the repository browser.