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

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

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