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

Last change on this file since 1146 was 1146, checked in by rblod, 16 years ago

Add svn Id (first try), see ticket #210
  • Property svn:keywords set to Id
File size: 31.7 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      IF( ln_nicep) THEN
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      ENDIF
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      DO jl = 1, jpl 
448         CALL lbc_lnk( smv_i(:,:,jl) , 'T' ,  1. )
449         CALL lbc_lnk( v_i  (:,:,jl) , 'T' ,  1. )
450         CALL lbc_lnk( a_i  (:,:,jl) , 'T' ,  1. )
451      END DO
452
453      ! we first with bulk ice salinity
454      DO jl = 1, jpl
455         DO jj = 1, jpj
456            DO ji = 1, jpi
457               zindb          = MAX( 0.0 , SIGN( 1.0 , v_i(ji,jj,jl) - 1.0e-4 ) ) 
458               sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX(v_i(ji,jj,jl),1.0e-6) * zindb
459               ht_i(ji,jj,jl) = v_i(ji,jj,jl)   / MAX(a_i(ji,jj,jl),1.0e-6) * zindb
460            END DO
461         END DO
462      END DO
463
464      DO jk = 1, nlay_i
465         s_i(:,:,jk,:) = sm_i(:,:,:)
466      END DO
467
468      ! Salinity profile
469      !-----------------
470      WRITE(numout,*) ' num_sal - will restart understand salinity profile ', num_sal
471
472      num_sal = 2
473      IF(num_sal.eq.2) THEN
474         !     CALL lim_var_salprof
475         DO jl = 1, jpl
476            DO jk = 1, nlay_i
477               DO jj = 1, jpj
478                  DO ji = 1, jpi
479                     zs_inf        = sm_i(ji,jj,jl)
480                     z_slope_s     = 2.0*sm_i(ji,jj,jl)/MAX(0.01,ht_i(ji,jj,jl))
481                     !- slope of the salinity profile
482                     zs_zero(jk)   = z_slope_s * ( FLOAT(jk)-1.0/2.0 ) * &
483                        ht_i(ji,jj,jl) / FLOAT(nlay_i)
484                     zsmax = 4.5
485                     zsmin = 3.5
486                     IF( sm_i(ji,jj,jl) .LT. zsmin ) THEN
487                        zalpha = 1.0
488                     ELSEIF( sm_i(ji,jj,jl) .LT.zsmax ) THEN
489                        zalpha = sm_i(ji,jj,jl) / (zsmin-zsmax) + zsmax / (zsmax-zsmin)
490                     ELSE
491                        zalpha = 0.0
492                     ENDIF
493                     s_i(ji,jj,jk,jl) = zalpha*zs_zero(jk) + ( 1.0 - zalpha )*zs_inf
494                  END DO
495               END DO
496            END DO
497         END DO
498      ENDIF
499
500# if defined key_coupled 
501      CALL iom_get( numrir, jpdom_autoglo, 'albege'   , albege )
502# endif
503      DO jl = 1, jpl 
504         WRITE(zchar,'(I1)') jl
505         znam = 'tempt_sl1'//'_htc'//zchar
506         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
507         e_s(:,:,1,jl) = z2d(:,:)
508      END DO
509
510      DO jl = 1, jpl 
511         WRITE(zchar,'(I1)') jl
512         DO jk = 1, nlay_i 
513            WRITE(zchar1,'(I1)') jk
514            znam = 'tempt'//'_il'//zchar1//'_htc'//zchar
515            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
516            e_i(:,:,jk,jl) = z2d(:,:)
517         END DO
518      END DO
519
520      CALL iom_get( numrir, jpdom_autoglo, 'u_ice'     , u_ice      )
521      CALL iom_get( numrir, jpdom_autoglo, 'v_ice'     , v_ice      )
522      CALL iom_get( numrir, jpdom_autoglo, 'utaui_ice' , utaui_ice  )
523      CALL iom_get( numrir, jpdom_autoglo, 'vtaui_ice' , vtaui_ice  )
524      CALL iom_get( numrir, jpdom_autoglo, 'fsbbq'     , fsbbq      )
525      CALL iom_get( numrir, jpdom_autoglo, 'stress1_i' , stress1_i  )
526      CALL iom_get( numrir, jpdom_autoglo, 'stress2_i' , stress2_i  )
527      CALL iom_get( numrir, jpdom_autoglo, 'stress12_i', stress12_i )
528
529      DO jl = 1, jpl 
530         WRITE(zchar,'(I1)') jl
531         znam = 'sxice'//'_htc'//zchar
532         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
533         sxice(:,:,jl) = z2d(:,:)
534         znam = 'syice'//'_htc'//zchar
535         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
536         syice(:,:,jl) = z2d(:,:)
537         znam = 'sxxice'//'_htc'//zchar
538         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
539         sxxice(:,:,jl) = z2d(:,:)
540         znam = 'syyice'//'_htc'//zchar
541         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
542         syyice(:,:,jl) = z2d(:,:)
543         znam = 'sxyice'//'_htc'//zchar
544         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
545         sxyice(:,:,jl) = z2d(:,:)
546         znam = 'sxsn'//'_htc'//zchar
547         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
548         sxsn(:,:,jl) = z2d(:,:)
549         znam = 'sysn'//'_htc'//zchar
550         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
551         sysn(:,:,jl) = z2d(:,:)
552         znam = 'sxxsn'//'_htc'//zchar
553         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
554         sxxsn(:,:,jl) = z2d(:,:)
555         znam = 'syysn'//'_htc'//zchar
556         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
557         syysn(:,:,jl) = z2d(:,:)
558         znam = 'sxysn'//'_htc'//zchar
559         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
560         sxysn(:,:,jl) = z2d(:,:)
561         znam = 'sxa'//'_htc'//zchar
562         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
563         sxa(:,:,jl) = z2d(:,:)
564         znam = 'sya'//'_htc'//zchar
565         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
566         sya(:,:,jl) = z2d(:,:)
567         znam = 'sxxa'//'_htc'//zchar
568         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
569         sxxa(:,:,jl) = z2d(:,:)
570         znam = 'syya'//'_htc'//zchar
571         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
572         syya(:,:,jl) = z2d(:,:)
573         znam = 'sxya'//'_htc'//zchar
574         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
575         sxya(:,:,jl) = z2d(:,:)
576         znam = 'sxc0'//'_htc'//zchar
577         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
578         sxc0(:,:,jl) = z2d(:,:)
579         znam = 'syc0'//'_htc'//zchar
580         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
581         syc0(:,:,jl) = z2d(:,:)
582         znam = 'sxxc0'//'_htc'//zchar
583         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
584         sxxc0(:,:,jl) = z2d(:,:)
585         znam = 'syyc0'//'_htc'//zchar
586         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
587         syyc0(:,:,jl) = z2d(:,:)
588         znam = 'sxyc0'//'_htc'//zchar
589         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
590         sxyc0(:,:,jl) = z2d(:,:)
591         znam = 'sxsal'//'_htc'//zchar
592         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
593         sxsal(:,:,jl) = z2d(:,:)
594         znam = 'sysal'//'_htc'//zchar
595         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
596         sysal(:,:,jl) = z2d(:,:)
597         znam = 'sxxsal'//'_htc'//zchar
598         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
599         sxxsal(:,:,jl) = z2d(:,:)
600         znam = 'syysal'//'_htc'//zchar
601         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
602         syysal(:,:,jl) = z2d(:,:)
603         znam = 'sxysal'//'_htc'//zchar
604         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
605         sxysal(:,:,jl) = z2d(:,:)
606         znam = 'sxage'//'_htc'//zchar
607         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
608         sxage(:,:,jl) = z2d(:,:)
609         znam = 'syage'//'_htc'//zchar
610         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
611         syage(:,:,jl) = z2d(:,:)
612         znam = 'sxxage'//'_htc'//zchar
613         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
614         sxxage(:,:,jl) = z2d(:,:)
615         znam = 'syyage'//'_htc'//zchar
616         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
617         syyage(:,:,jl) = z2d(:,:)
618         znam = 'sxyage'//'_htc'//zchar
619         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
620         sxyage(:,:,jl)= z2d(:,:)
621      END DO
622
623      CALL iom_get( numrir, jpdom_autoglo, 'sxopw ' ,  sxopw  )
624      CALL iom_get( numrir, jpdom_autoglo, 'syopw ' ,  syopw  )
625      CALL iom_get( numrir, jpdom_autoglo, 'sxxopw' ,  sxxopw )
626      CALL iom_get( numrir, jpdom_autoglo, 'syyopw' ,  syyopw )
627      CALL iom_get( numrir, jpdom_autoglo, 'sxyopw' ,  sxyopw )
628
629      DO jl = 1, jpl 
630         WRITE(zchar,'(I1)') jl
631         DO jk = 1, nlay_i 
632            WRITE(zchar1,'(I1)') jk
633            znam = 'sxe'//'_il'//zchar1//'_htc'//zchar
634            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
635            sxe(:,:,jk,jl) = z2d(:,:)
636            znam = 'sye'//'_il'//zchar1//'_htc'//zchar
637            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
638            sye(:,:,jk,jl) = z2d(:,:)
639            znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar
640            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
641            sxxe(:,:,jk,jl) = z2d(:,:)
642            znam = 'syye'//'_il'//zchar1//'_htc'//zchar
643            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
644            syye(:,:,jk,jl) = z2d(:,:)
645            znam = 'sxye'//'_il'//zchar1//'_htc'//zchar
646            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
647            sxye(:,:,jk,jl) = z2d(:,:)
648         END DO
649      END DO
650
651      CALL iom_close( numrir )
652
653      !+++++++++++ CHECK EVERYTHING ++++++++++
654
655      WRITE(numout,*)
656      WRITE(numout,*) ' lim_rst_read  : CHUKCHI SEA POINT '
657      WRITE(numout,*) ' ~~~~~~~~~~'
658      WRITE(numout,*) ' ~~~ Arctic'
659
660      indx = 1
661      ji = 24
662      jj = 24
663      WRITE(numout,*) ' ji, jj ', ji, jj
664      WRITE(numout,*) ' ICE VARIABLES '
665      WRITE(numout,*) ' open water ', ato_i(ji,jj)
666
667      DO jl = 1, jpl
668         WRITE(numout,*) ' *** CATEGORY NUMBER *** ', jl
669         WRITE(numout,*) ' '
670         WRITE(numout,*) ' a_i        : ', a_i(ji,jj,jl)     
671         WRITE(numout,*) ' v_i        : ', v_i(ji,jj,jl) 
672         WRITE(numout,*) ' v_s        : ', v_s(ji,jj,jl)   
673         WRITE(numout,*) ' e_i1       : ', e_i(ji,jj,1,jl)/1.0e9     
674         WRITE(numout,*) ' e_i2       : ', e_i(ji,jj,2,jl)/1.0e9     
675         WRITE(numout,*) ' e_s        : ', e_s(ji,jj,1,jl)     
676         WRITE(numout,*) ' smv_i      : ', smv_i(ji,jj,jl) 
677         WRITE(numout,*) ' oa_i       : ', oa_i(ji,jj,jl)
678         WRITE(numout,*) ' t_su       : ', t_su(ji,jj,jl)
679      END DO
680
681      WRITE(numout,*) ' open water '
682      WRITE(numout,*) ' sxopw  ', sxopw(ji,jj)
683      WRITE(numout,*) ' syopw  ', syopw(ji,jj)
684      WRITE(numout,*) ' sxxopw ', sxxopw(ji,jj)
685      WRITE(numout,*) ' syyopw ', syyopw(ji,jj)
686      WRITE(numout,*) ' sxyopw ', sxyopw(ji,jj)
687      DO jl = 1, jpl
688         WRITE(numout,*) ' jl, ice volume content ', jl
689         WRITE(numout,*) ' sxice  ', sxice(ji,jj,jl)
690         WRITE(numout,*) ' syice  ', syice(ji,jj,jl)
691         WRITE(numout,*) ' sxxice ', sxxice(ji,jj,jl)
692         WRITE(numout,*) ' syyice ', syyice(ji,jj,jl)
693         WRITE(numout,*) ' sxyice ', sxyice(ji,jj,jl)
694         WRITE(numout,*) ' jl, snow volume content ', jl
695         WRITE(numout,*) ' sxsn   ', sxsn(ji,jj,jl)
696         WRITE(numout,*) ' sysn   ', sysn(ji,jj,jl)
697         WRITE(numout,*) ' sxxsn  ', sxxsn(ji,jj,jl)
698         WRITE(numout,*) ' syysn  ', syysn(ji,jj,jl)
699         WRITE(numout,*) ' sxysn  ', sxysn(ji,jj,jl)
700         WRITE(numout,*) ' jl, ice area in category ', jl
701         WRITE(numout,*) ' sxa    ', sxa (ji,jj,jl)
702         WRITE(numout,*) ' sya    ', sya (ji,jj,jl)
703         WRITE(numout,*) ' sxxa   ', sxxa (ji,jj,jl)
704         WRITE(numout,*) ' syya   ', syya (ji,jj,jl)
705         WRITE(numout,*) ' sxya   ', sxya (ji,jj,jl)
706         WRITE(numout,*) ' jl, snow temp ', jl
707         WRITE(numout,*) ' sxc0   ', sxc0(ji,jj,jl)
708         WRITE(numout,*) ' syc0   ', syc0(ji,jj,jl)
709         WRITE(numout,*) ' sxxc0  ', sxxc0(ji,jj,jl)
710         WRITE(numout,*) ' syyc0  ', syyc0(ji,jj,jl)
711         WRITE(numout,*) ' sxyc0  ', sxyc0(ji,jj,jl)
712         WRITE(numout,*) ' jl, ice salinity ', jl
713         WRITE(numout,*) ' sxsal  ', sxsal(ji,jj,jl)
714         WRITE(numout,*) ' sysal  ', sysal(ji,jj,jl)
715         WRITE(numout,*) ' sxxsal ', sxxsal(ji,jj,jl)
716         WRITE(numout,*) ' syysal ', syysal(ji,jj,jl)
717         WRITE(numout,*) ' sxysal ', sxysal(ji,jj,jl)
718         WRITE(numout,*) ' jl, ice age      ', jl
719         WRITE(numout,*) ' sxage  ', sxage(ji,jj,jl)
720         WRITE(numout,*) ' syage  ', syage(ji,jj,jl)
721         WRITE(numout,*) ' sxxage ', sxxage(ji,jj,jl)
722         WRITE(numout,*) ' syyage ', syyage(ji,jj,jl)
723         WRITE(numout,*) ' sxyage ', sxyage(ji,jj,jl)
724      END DO
725      DO jl = 1, jpl
726         DO jk = 1, nlay_i
727            WRITE(numout,*) ' jk, jl, ice heat content', jk, jl
728            WRITE(numout,*) ' sxe    ', sxe(ji,jj,jk,jl)
729            WRITE(numout,*) ' sye    ', sye(ji,jj,jk,jl)
730            WRITE(numout,*) ' sxxe   ', sxxe(ji,jj,jk,jl)
731            WRITE(numout,*) ' syye   ', syye(ji,jj,jk,jl)
732            WRITE(numout,*) ' sxye   ', sxye(ji,jj,jk,jl)
733         END DO
734      END DO
735
736      !+++++++++++ END CHECK +++++++++++++++++
737
738   END SUBROUTINE lim_rst_read
739
740
741#else
742   !!----------------------------------------------------------------------
743   !!   Default option :       Empty module            NO LIM sea-ice model
744   !!----------------------------------------------------------------------
745CONTAINS
746   SUBROUTINE lim_rst_read             ! Empty routine
747   END SUBROUTINE lim_rst_read
748   SUBROUTINE lim_rst_write            ! Empty routine
749   END SUBROUTINE lim_rst_write
750#endif
751
752   !!======================================================================
753END MODULE limrst
Note: See TracBrowser for help on using the repository browser.