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 @ 1465

Last change on this file since 1465 was 1465, checked in by smasson, 15 years ago

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