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 tags/nemo_v3_2/nemo_v3_2/NEMO/LIM_SRC_3 – NEMO

source: tags/nemo_v3_2/nemo_v3_2/NEMO/LIM_SRC_3/limrst.F90 @ 1878

Last change on this file since 1878 was 1878, checked in by flavoni, 14 years ago

initial test for nemogcm
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 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 3.0,  UCL-LOCEAN-IPSL (2008)
36   !! $Id: limrst.F90 1715 2009-11-05 15:18:26Z smasson $
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*nn_fsbc + 1)
58      ! 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
59      IF( kt == nitrst - 2*nn_fsbc + 1 .OR. nstock == nn_fsbc .OR. ( kt == nitend - nn_fsbc + 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))//"_"//TRIM(cn_icerst_out)
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*nn_fsbc + 1 ) THEN   
73               WRITE(numout,*)         '             kt = nitrst - 2*nn_fsbc + 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 + nn_fsbc - 1   ! ice restarts are written at kt == nitrst - nn_fsbc + 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, 'nn_fsbc', REAL( nn_fsbc, 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
139      DO jl = 1, jpl 
140         WRITE(zchar,'(I1)') jl
141         znam = 'tempt_sl1'//'_htc'//zchar
142         z2d(:,:) = e_s(:,:,1,jl)
143         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
144      END DO
145
146      DO jl = 1, jpl 
147         WRITE(zchar,'(I1)') jl
148         DO jk = 1, nlay_i 
149            WRITE(zchar1,'(I1)') jk
150            znam = 'tempt'//'_il'//zchar1//'_htc'//zchar
151            z2d(:,:) = e_i(:,:,jk,jl)
152            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
153         END DO
154      END DO
155
156      CALL iom_rstput( iter, nitrst, numriw, 'u_ice'     , u_ice      )
157      CALL iom_rstput( iter, nitrst, numriw, 'v_ice'     , v_ice      )
158      CALL iom_rstput( iter, nitrst, numriw, 'fsbbq'     , fsbbq      )
159      CALL iom_rstput( iter, nitrst, numriw, 'stress1_i' , stress1_i  )
160      CALL iom_rstput( iter, nitrst, numriw, 'stress2_i' , stress2_i  )
161      CALL iom_rstput( iter, nitrst, numriw, 'stress12_i', stress12_i )
162
163      DO jl = 1, jpl 
164         WRITE(zchar,'(I1)') jl
165         znam = 'sxice'//'_htc'//zchar
166         z2d(:,:) = sxice(:,:,jl)
167         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
168         znam = 'syice'//'_htc'//zchar
169         z2d(:,:) = syice(:,:,jl)
170         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
171         znam = 'sxxice'//'_htc'//zchar
172         z2d(:,:) = sxxice(:,:,jl)
173         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
174         znam = 'syyice'//'_htc'//zchar
175         z2d(:,:) = syyice(:,:,jl)
176         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
177         znam = 'sxyice'//'_htc'//zchar
178         z2d(:,:) = sxyice(:,:,jl)
179         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
180         znam = 'sxsn'//'_htc'//zchar
181         z2d(:,:) = sxsn(:,:,jl)
182         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
183         znam = 'sysn'//'_htc'//zchar
184         z2d(:,:) = sysn(:,:,jl)
185         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
186         znam = 'sxxsn'//'_htc'//zchar
187         z2d(:,:) = sxxsn(:,:,jl)
188         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
189         znam = 'syysn'//'_htc'//zchar
190         z2d(:,:) = syysn(:,:,jl)
191         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
192         znam = 'sxysn'//'_htc'//zchar
193         z2d(:,:) = sxysn(:,:,jl)
194         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
195         znam = 'sxa'//'_htc'//zchar
196         z2d(:,:) = sxa(:,:,jl)
197         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
198         znam = 'sya'//'_htc'//zchar
199         z2d(:,:) = sya(:,:,jl)
200         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
201         znam = 'sxxa'//'_htc'//zchar
202         z2d(:,:) = sxxa(:,:,jl)
203         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
204         znam = 'syya'//'_htc'//zchar
205         z2d(:,:) = syya(:,:,jl)
206         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
207         znam = 'sxya'//'_htc'//zchar
208         z2d(:,:) = sxya(:,:,jl)
209         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
210         znam = 'sxc0'//'_htc'//zchar
211         z2d(:,:) = sxc0(:,:,jl)
212         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
213         znam = 'syc0'//'_htc'//zchar
214         z2d(:,:) = syc0(:,:,jl)
215         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
216         znam = 'sxxc0'//'_htc'//zchar
217         z2d(:,:) = sxxc0(:,:,jl)
218         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
219         znam = 'syyc0'//'_htc'//zchar
220         z2d(:,:) = syyc0(:,:,jl)
221         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
222         znam = 'sxyc0'//'_htc'//zchar
223         z2d(:,:) = sxyc0(:,:,jl)
224         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
225         znam = 'sxsal'//'_htc'//zchar
226         z2d(:,:) = sxsal(:,:,jl)
227         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
228         znam = 'sysal'//'_htc'//zchar
229         z2d(:,:) = sysal(:,:,jl)
230         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
231         znam = 'sxxsal'//'_htc'//zchar
232         z2d(:,:) = sxxsal(:,:,jl)
233         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
234         znam = 'syysal'//'_htc'//zchar
235         z2d(:,:) = syysal(:,:,jl)
236         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
237         znam = 'sxysal'//'_htc'//zchar
238         z2d(:,:) = sxysal(:,:,jl)
239         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
240         znam = 'sxage'//'_htc'//zchar
241         z2d(:,:) = sxage(:,:,jl)
242         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
243         znam = 'syage'//'_htc'//zchar
244         z2d(:,:) = syage(:,:,jl)
245         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
246         znam = 'sxxage'//'_htc'//zchar
247         z2d(:,:) = sxxage(:,:,jl)
248         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
249         znam = 'syyage'//'_htc'//zchar
250         z2d(:,:) = syyage(:,:,jl)
251         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
252         znam = 'sxyage'//'_htc'//zchar
253         z2d(:,:) = sxyage(:,:,jl)
254         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
255      END DO
256
257      CALL iom_rstput( iter, nitrst, numriw, 'sxopw ' ,  sxopw  )
258      CALL iom_rstput( iter, nitrst, numriw, 'syopw ' ,  syopw  )
259      CALL iom_rstput( iter, nitrst, numriw, 'sxxopw' ,  sxxopw )
260      CALL iom_rstput( iter, nitrst, numriw, 'syyopw' ,  syyopw )
261      CALL iom_rstput( iter, nitrst, numriw, 'sxyopw' ,  sxyopw )
262
263      DO jl = 1, jpl 
264         WRITE(zchar,'(I1)') jl
265         DO jk = 1, nlay_i 
266            WRITE(zchar1,'(I1)') jk
267            znam = 'sxe'//'_il'//zchar1//'_htc'//zchar
268            z2d(:,:) = sxe(:,:,jk,jl)
269            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
270            znam = 'sye'//'_il'//zchar1//'_htc'//zchar
271            z2d(:,:) = sye(:,:,jk,jl)
272            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
273            znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar
274            z2d(:,:) = sxxe(:,:,jk,jl)
275            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
276            znam = 'syye'//'_il'//zchar1//'_htc'//zchar
277            z2d(:,:) = syye(:,:,jk,jl)
278            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
279            znam = 'sxye'//'_il'//zchar1//'_htc'//zchar
280            z2d(:,:) = sxye(:,:,jk,jl)
281            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
282         END DO
283      END DO
284
285      IF( iter == nitrst ) THEN
286         CALL iom_close( numriw )                         ! close the restart file
287         lrst_ice = .FALSE.
288      ENDIF
289      !
290
291      IF( ln_nicep) THEN
292         WRITE(numout,*)
293         WRITE(numout,*) ' lim_rst_write : CHUKCHI SEA POINT '
294         WRITE(numout,*) ' ~~~~~~~~~~'
295         WRITE(numout,*) ' ~~~ Arctic'
296
297         ji = jiindx
298         jj = jjindx
299
300         WRITE(numout,*) ' ji, jj ', ji, jj
301         WRITE(numout,*) ' ICE VARIABLES '
302         WRITE(numout,*) ' open water ', ato_i(ji,jj)
303         DO jl = 1, jpl
304            WRITE(numout,*) ' *** CATEGORY NUMBER *** ', jl
305            WRITE(numout,*) ' '
306            WRITE(numout,*) ' a_i        : ', a_i(ji,jj,jl)     
307            WRITE(numout,*) ' v_i        : ', v_i(ji,jj,jl) 
308            WRITE(numout,*) ' v_s        : ', v_s(ji,jj,jl)   
309            WRITE(numout,*) ' e_s        : ', e_s(ji,jj,1,jl)/1.0e9
310            WRITE(numout,*) ' e_i1       : ', e_i(ji,jj,1,jl)/1.0e9     
311            WRITE(numout,*) ' e_i2       : ', e_i(ji,jj,2,jl)/1.0e9     
312            WRITE(numout,*) ' smv_i      : ', smv_i(ji,jj,jl) 
313            WRITE(numout,*) ' oa_i       : ', oa_i(ji,jj,jl)
314            WRITE(numout,*) ' t_su       : ', t_su(ji,jj,jl)
315         END DO
316
317         WRITE(numout,*) ' MOMENTS OF ADVECTION '
318
319         WRITE(numout,*) ' open water '
320         WRITE(numout,*) ' sxopw  ', sxopw(ji,jj)
321         WRITE(numout,*) ' syopw  ', syopw(ji,jj)
322         WRITE(numout,*) ' sxxopw ', sxxopw(ji,jj)
323         WRITE(numout,*) ' syyopw ', syyopw(ji,jj)
324         WRITE(numout,*) ' sxyopw ', sxyopw(ji,jj)
325         DO jl = 1, jpl
326            WRITE(numout,*) ' jl, ice volume content ', jl
327            WRITE(numout,*) ' sxice  ', sxice(ji,jj,jl)
328            WRITE(numout,*) ' syice  ', syice(ji,jj,jl)
329            WRITE(numout,*) ' sxxice ', sxxice(ji,jj,jl)
330            WRITE(numout,*) ' syyice ', syyice(ji,jj,jl)
331            WRITE(numout,*) ' sxyice ', sxyice(ji,jj,jl)
332            WRITE(numout,*) ' jl, snow volume content ', jl
333            WRITE(numout,*) ' sxsn   ', sxsn(ji,jj,jl)
334            WRITE(numout,*) ' sysn   ', sysn(ji,jj,jl)
335            WRITE(numout,*) ' sxxsn  ', sxxsn(ji,jj,jl)
336            WRITE(numout,*) ' syysn  ', syysn(ji,jj,jl)
337            WRITE(numout,*) ' sxysn  ', sxysn(ji,jj,jl)
338            WRITE(numout,*) ' jl, ice area in category ', jl
339            WRITE(numout,*) ' sxa    ', sxa (ji,jj,jl)
340            WRITE(numout,*) ' sya    ', sya (ji,jj,jl)
341            WRITE(numout,*) ' sxxa   ', sxxa (ji,jj,jl)
342            WRITE(numout,*) ' syya   ', syya (ji,jj,jl)
343            WRITE(numout,*) ' sxya   ', sxya (ji,jj,jl)
344            WRITE(numout,*) ' jl, snow temp ', jl
345            WRITE(numout,*) ' sxc0   ', sxc0(ji,jj,jl)
346            WRITE(numout,*) ' syc0   ', syc0(ji,jj,jl)
347            WRITE(numout,*) ' sxxc0  ', sxxc0(ji,jj,jl)
348            WRITE(numout,*) ' syyc0  ', syyc0(ji,jj,jl)
349            WRITE(numout,*) ' sxyc0  ', sxyc0(ji,jj,jl)
350            WRITE(numout,*) ' jl, ice salinity ', jl
351            WRITE(numout,*) ' sxsal  ', sxsal(ji,jj,jl)
352            WRITE(numout,*) ' sysal  ', sysal(ji,jj,jl)
353            WRITE(numout,*) ' sxxsal ', sxxsal(ji,jj,jl)
354            WRITE(numout,*) ' syysal ', syysal(ji,jj,jl)
355            WRITE(numout,*) ' sxysal ', sxysal(ji,jj,jl)
356            WRITE(numout,*) ' jl, ice age      ', jl
357            WRITE(numout,*) ' sxage  ', sxage(ji,jj,jl)
358            WRITE(numout,*) ' syage  ', syage(ji,jj,jl)
359            WRITE(numout,*) ' sxxage ', sxxage(ji,jj,jl)
360            WRITE(numout,*) ' syyage ', syyage(ji,jj,jl)
361            WRITE(numout,*) ' sxyage ', sxyage(ji,jj,jl)
362         END DO
363         DO jl = 1, jpl
364            DO jk = 1, nlay_i
365               WRITE(numout,*) ' jk, jl, ice heat content', jk, jl
366               WRITE(numout,*) ' sxe    ', sxe(ji,jj,jk,jl)
367               WRITE(numout,*) ' sye    ', sye(ji,jj,jk,jl)
368               WRITE(numout,*) ' sxxe   ', sxxe(ji,jj,jk,jl)
369               WRITE(numout,*) ' syye   ', syye(ji,jj,jk,jl)
370               WRITE(numout,*) ' sxye   ', sxye(ji,jj,jk,jl)
371            END DO
372         END DO
373
374      ENDIF
375
376   END SUBROUTINE lim_rst_write
377
378   SUBROUTINE lim_rst_read
379      !!----------------------------------------------------------------------
380      !!                    ***  lim_rst_read  ***
381      !!
382      !! ** purpose  :   read of sea-ice variable restart in a netcdf file
383      !!----------------------------------------------------------------------
384      ! Local variables
385      INTEGER :: ji, jj, jk, jl, indx
386      REAL(wp) ::   zfice, ziter
387      REAL(wp) :: & !parameters for the salinity profile
388         zs_inf, z_slope_s, zsmax, zsmin, zalpha, zindb
389      REAL(wp), DIMENSION(nlay_i) :: zs_zero 
390      REAL(wp), DIMENSION(jpi,jpj) :: z2d
391      CHARACTER(len=15) :: znam
392      CHARACTER(len=1)  :: zchar, zchar1
393      INTEGER           :: jlibalt = jprstlib
394      LOGICAL           :: llok
395      !!----------------------------------------------------------------------
396
397      IF(lwp) THEN
398         WRITE(numout,*)
399         WRITE(numout,*) 'lim_rst_read : read ice NetCDF restart file'
400         WRITE(numout,*) '~~~~~~~~~~~~~~'
401      ENDIF
402
403      IF ( jprstlib == jprstdimg ) THEN
404        ! eventually read netcdf file (monobloc)  for restarting on different number of processors
405        ! if {cn_icerst_in}.nc exists, then set jlibalt to jpnf90
406        INQUIRE( FILE = TRIM(cn_icerst_in)//'.nc', EXIST = llok )
407        IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
408      ENDIF
409
410      CALL iom_open ( cn_icerst_in, numrir, kiolib = jprstlib )
411
412      CALL iom_get( numrir, 'nn_fsbc', zfice )
413      CALL iom_get( numrir, 'kt_ice' , ziter )   
414      IF(lwp) WRITE(numout,*) '   read ice restart file at time step    : ', ziter
415      IF(lwp) WRITE(numout,*) '   in any case we force it to nit000 - 1 : ', nit000 - 1
416
417      !Control of date
418
419      IF( ( nit000 - INT(ziter) ) /= 1 .AND. ABS( nrstdt ) == 1 )   &
420         &     CALL ctl_stop( 'lim_rst_read ===>>>> : problem with nit000 in ice restart',  &
421         &                   '   verify the file or rerun with the value 0 for the',        &
422         &                   '   control of time parameter  nrstdt' )
423      IF( INT(zfice) /= nn_fsbc          .AND. ABS( nrstdt ) == 1 )   &
424         &     CALL ctl_stop( 'lim_rst_read ===>>>> : problem with nn_fsbc in ice restart',  &
425         &                   '   verify the file or rerun with the value 0 for the',         &
426         &                   '   control of time parameter  nrstdt' )
427
428      DO jl = 1, jpl 
429         WRITE(zchar,'(I1)') jl
430         znam = 'v_i'//'_htc'//zchar
431         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
432         v_i(:,:,jl) = z2d(:,:)
433         znam = 'v_s'//'_htc'//zchar
434         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
435         v_s(:,:,jl) = z2d(:,:) 
436         znam = 'smv_i'//'_htc'//zchar
437         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
438         smv_i(:,:,jl) = z2d(:,:)
439         znam = 'oa_i'//'_htc'//zchar
440         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
441         oa_i(:,:,jl) = z2d(:,:)
442         znam = 'a_i'//'_htc'//zchar
443         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
444         a_i(:,:,jl) = z2d(:,:)
445         znam = 't_su'//'_htc'//zchar
446         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
447         t_su(:,:,jl) = z2d(:,:)
448      END DO
449
450      DO jl = 1, jpl 
451         CALL lbc_lnk( smv_i(:,:,jl) , 'T' ,  1. )
452         CALL lbc_lnk( v_i  (:,:,jl) , 'T' ,  1. )
453         CALL lbc_lnk( a_i  (:,:,jl) , 'T' ,  1. )
454      END DO
455
456      ! we first with bulk ice salinity
457      DO jl = 1, jpl
458         DO jj = 1, jpj
459            DO ji = 1, jpi
460               zindb          = MAX( 0.0 , SIGN( 1.0 , v_i(ji,jj,jl) - 1.0e-4 ) ) 
461               sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX(v_i(ji,jj,jl),1.0e-6) * zindb
462               ht_i(ji,jj,jl) = v_i(ji,jj,jl)   / MAX(a_i(ji,jj,jl),1.0e-6) * zindb
463            END DO
464         END DO
465      END DO
466
467      DO jk = 1, nlay_i
468         s_i(:,:,jk,:) = sm_i(:,:,:)
469      END DO
470
471      ! Salinity profile
472      !-----------------
473      WRITE(numout,*) ' num_sal - will restart understand salinity profile ', num_sal
474
475      num_sal = 2
476      IF(num_sal.eq.2) THEN
477         !     CALL lim_var_salprof
478         DO jl = 1, jpl
479            DO jk = 1, nlay_i
480               DO jj = 1, jpj
481                  DO ji = 1, jpi
482                     zs_inf        = sm_i(ji,jj,jl)
483                     z_slope_s     = 2.0*sm_i(ji,jj,jl)/MAX(0.01,ht_i(ji,jj,jl))
484                     !- slope of the salinity profile
485                     zs_zero(jk)   = z_slope_s * ( FLOAT(jk)-1.0/2.0 ) * &
486                        ht_i(ji,jj,jl) / FLOAT(nlay_i)
487                     zsmax = 4.5
488                     zsmin = 3.5
489                     IF( sm_i(ji,jj,jl) .LT. zsmin ) THEN
490                        zalpha = 1.0
491                     ELSEIF( sm_i(ji,jj,jl) .LT.zsmax ) THEN
492                        zalpha = sm_i(ji,jj,jl) / (zsmin-zsmax) + zsmax / (zsmax-zsmin)
493                     ELSE
494                        zalpha = 0.0
495                     ENDIF
496                     s_i(ji,jj,jk,jl) = zalpha*zs_zero(jk) + ( 1.0 - zalpha )*zs_inf
497                  END DO
498               END DO
499            END DO
500         END DO
501      ENDIF
502
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, 'fsbbq'     , fsbbq      )
523      CALL iom_get( numrir, jpdom_autoglo, 'stress1_i' , stress1_i  )
524      CALL iom_get( numrir, jpdom_autoglo, 'stress2_i' , stress2_i  )
525      CALL iom_get( numrir, jpdom_autoglo, 'stress12_i', stress12_i )
526
527      DO jl = 1, jpl 
528         WRITE(zchar,'(I1)') jl
529         znam = 'sxice'//'_htc'//zchar
530         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
531         sxice(:,:,jl) = z2d(:,:)
532         znam = 'syice'//'_htc'//zchar
533         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
534         syice(:,:,jl) = z2d(:,:)
535         znam = 'sxxice'//'_htc'//zchar
536         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
537         sxxice(:,:,jl) = z2d(:,:)
538         znam = 'syyice'//'_htc'//zchar
539         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
540         syyice(:,:,jl) = z2d(:,:)
541         znam = 'sxyice'//'_htc'//zchar
542         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
543         sxyice(:,:,jl) = z2d(:,:)
544         znam = 'sxsn'//'_htc'//zchar
545         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
546         sxsn(:,:,jl) = z2d(:,:)
547         znam = 'sysn'//'_htc'//zchar
548         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
549         sysn(:,:,jl) = z2d(:,:)
550         znam = 'sxxsn'//'_htc'//zchar
551         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
552         sxxsn(:,:,jl) = z2d(:,:)
553         znam = 'syysn'//'_htc'//zchar
554         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
555         syysn(:,:,jl) = z2d(:,:)
556         znam = 'sxysn'//'_htc'//zchar
557         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
558         sxysn(:,:,jl) = z2d(:,:)
559         znam = 'sxa'//'_htc'//zchar
560         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
561         sxa(:,:,jl) = z2d(:,:)
562         znam = 'sya'//'_htc'//zchar
563         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
564         sya(:,:,jl) = z2d(:,:)
565         znam = 'sxxa'//'_htc'//zchar
566         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
567         sxxa(:,:,jl) = z2d(:,:)
568         znam = 'syya'//'_htc'//zchar
569         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
570         syya(:,:,jl) = z2d(:,:)
571         znam = 'sxya'//'_htc'//zchar
572         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
573         sxya(:,:,jl) = z2d(:,:)
574         znam = 'sxc0'//'_htc'//zchar
575         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
576         sxc0(:,:,jl) = z2d(:,:)
577         znam = 'syc0'//'_htc'//zchar
578         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
579         syc0(:,:,jl) = z2d(:,:)
580         znam = 'sxxc0'//'_htc'//zchar
581         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
582         sxxc0(:,:,jl) = z2d(:,:)
583         znam = 'syyc0'//'_htc'//zchar
584         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
585         syyc0(:,:,jl) = z2d(:,:)
586         znam = 'sxyc0'//'_htc'//zchar
587         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
588         sxyc0(:,:,jl) = z2d(:,:)
589         znam = 'sxsal'//'_htc'//zchar
590         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
591         sxsal(:,:,jl) = z2d(:,:)
592         znam = 'sysal'//'_htc'//zchar
593         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
594         sysal(:,:,jl) = z2d(:,:)
595         znam = 'sxxsal'//'_htc'//zchar
596         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
597         sxxsal(:,:,jl) = z2d(:,:)
598         znam = 'syysal'//'_htc'//zchar
599         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
600         syysal(:,:,jl) = z2d(:,:)
601         znam = 'sxysal'//'_htc'//zchar
602         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
603         sxysal(:,:,jl) = z2d(:,:)
604         znam = 'sxage'//'_htc'//zchar
605         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
606         sxage(:,:,jl) = z2d(:,:)
607         znam = 'syage'//'_htc'//zchar
608         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
609         syage(:,:,jl) = z2d(:,:)
610         znam = 'sxxage'//'_htc'//zchar
611         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
612         sxxage(:,:,jl) = z2d(:,:)
613         znam = 'syyage'//'_htc'//zchar
614         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
615         syyage(:,:,jl) = z2d(:,:)
616         znam = 'sxyage'//'_htc'//zchar
617         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
618         sxyage(:,:,jl)= z2d(:,:)
619      END DO
620
621      CALL iom_get( numrir, jpdom_autoglo, 'sxopw ' ,  sxopw  )
622      CALL iom_get( numrir, jpdom_autoglo, 'syopw ' ,  syopw  )
623      CALL iom_get( numrir, jpdom_autoglo, 'sxxopw' ,  sxxopw )
624      CALL iom_get( numrir, jpdom_autoglo, 'syyopw' ,  syyopw )
625      CALL iom_get( numrir, jpdom_autoglo, 'sxyopw' ,  sxyopw )
626
627      DO jl = 1, jpl 
628         WRITE(zchar,'(I1)') jl
629         DO jk = 1, nlay_i 
630            WRITE(zchar1,'(I1)') jk
631            znam = 'sxe'//'_il'//zchar1//'_htc'//zchar
632            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
633            sxe(:,:,jk,jl) = z2d(:,:)
634            znam = 'sye'//'_il'//zchar1//'_htc'//zchar
635            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
636            sye(:,:,jk,jl) = z2d(:,:)
637            znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar
638            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
639            sxxe(:,:,jk,jl) = z2d(:,:)
640            znam = 'syye'//'_il'//zchar1//'_htc'//zchar
641            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
642            syye(:,:,jk,jl) = z2d(:,:)
643            znam = 'sxye'//'_il'//zchar1//'_htc'//zchar
644            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
645            sxye(:,:,jk,jl) = z2d(:,:)
646         END DO
647      END DO
648
649      CALL iom_close( numrir )
650
651      !+++++++++++ CHECK EVERYTHING ++++++++++
652
653      WRITE(numout,*)
654      WRITE(numout,*) ' lim_rst_read  : CHUKCHI SEA POINT '
655      WRITE(numout,*) ' ~~~~~~~~~~'
656      WRITE(numout,*) ' ~~~ Arctic'
657
658      indx = 1
659      ji = 24
660      jj = 24
661      WRITE(numout,*) ' ji, jj ', ji, jj
662      WRITE(numout,*) ' ICE VARIABLES '
663      WRITE(numout,*) ' open water ', ato_i(ji,jj)
664
665      DO jl = 1, jpl
666         WRITE(numout,*) ' *** CATEGORY NUMBER *** ', jl
667         WRITE(numout,*) ' '
668         WRITE(numout,*) ' a_i        : ', a_i(ji,jj,jl)     
669         WRITE(numout,*) ' v_i        : ', v_i(ji,jj,jl) 
670         WRITE(numout,*) ' v_s        : ', v_s(ji,jj,jl)   
671         WRITE(numout,*) ' e_i1       : ', e_i(ji,jj,1,jl)/1.0e9     
672         WRITE(numout,*) ' e_i2       : ', e_i(ji,jj,2,jl)/1.0e9     
673         WRITE(numout,*) ' e_s        : ', e_s(ji,jj,1,jl)     
674         WRITE(numout,*) ' smv_i      : ', smv_i(ji,jj,jl) 
675         WRITE(numout,*) ' oa_i       : ', oa_i(ji,jj,jl)
676         WRITE(numout,*) ' t_su       : ', t_su(ji,jj,jl)
677      END DO
678
679      WRITE(numout,*) ' open water '
680      WRITE(numout,*) ' sxopw  ', sxopw(ji,jj)
681      WRITE(numout,*) ' syopw  ', syopw(ji,jj)
682      WRITE(numout,*) ' sxxopw ', sxxopw(ji,jj)
683      WRITE(numout,*) ' syyopw ', syyopw(ji,jj)
684      WRITE(numout,*) ' sxyopw ', sxyopw(ji,jj)
685      DO jl = 1, jpl
686         WRITE(numout,*) ' jl, ice volume content ', jl
687         WRITE(numout,*) ' sxice  ', sxice(ji,jj,jl)
688         WRITE(numout,*) ' syice  ', syice(ji,jj,jl)
689         WRITE(numout,*) ' sxxice ', sxxice(ji,jj,jl)
690         WRITE(numout,*) ' syyice ', syyice(ji,jj,jl)
691         WRITE(numout,*) ' sxyice ', sxyice(ji,jj,jl)
692         WRITE(numout,*) ' jl, snow volume content ', jl
693         WRITE(numout,*) ' sxsn   ', sxsn(ji,jj,jl)
694         WRITE(numout,*) ' sysn   ', sysn(ji,jj,jl)
695         WRITE(numout,*) ' sxxsn  ', sxxsn(ji,jj,jl)
696         WRITE(numout,*) ' syysn  ', syysn(ji,jj,jl)
697         WRITE(numout,*) ' sxysn  ', sxysn(ji,jj,jl)
698         WRITE(numout,*) ' jl, ice area in category ', jl
699         WRITE(numout,*) ' sxa    ', sxa (ji,jj,jl)
700         WRITE(numout,*) ' sya    ', sya (ji,jj,jl)
701         WRITE(numout,*) ' sxxa   ', sxxa (ji,jj,jl)
702         WRITE(numout,*) ' syya   ', syya (ji,jj,jl)
703         WRITE(numout,*) ' sxya   ', sxya (ji,jj,jl)
704         WRITE(numout,*) ' jl, snow temp ', jl
705         WRITE(numout,*) ' sxc0   ', sxc0(ji,jj,jl)
706         WRITE(numout,*) ' syc0   ', syc0(ji,jj,jl)
707         WRITE(numout,*) ' sxxc0  ', sxxc0(ji,jj,jl)
708         WRITE(numout,*) ' syyc0  ', syyc0(ji,jj,jl)
709         WRITE(numout,*) ' sxyc0  ', sxyc0(ji,jj,jl)
710         WRITE(numout,*) ' jl, ice salinity ', jl
711         WRITE(numout,*) ' sxsal  ', sxsal(ji,jj,jl)
712         WRITE(numout,*) ' sysal  ', sysal(ji,jj,jl)
713         WRITE(numout,*) ' sxxsal ', sxxsal(ji,jj,jl)
714         WRITE(numout,*) ' syysal ', syysal(ji,jj,jl)
715         WRITE(numout,*) ' sxysal ', sxysal(ji,jj,jl)
716         WRITE(numout,*) ' jl, ice age      ', jl
717         WRITE(numout,*) ' sxage  ', sxage(ji,jj,jl)
718         WRITE(numout,*) ' syage  ', syage(ji,jj,jl)
719         WRITE(numout,*) ' sxxage ', sxxage(ji,jj,jl)
720         WRITE(numout,*) ' syyage ', syyage(ji,jj,jl)
721         WRITE(numout,*) ' sxyage ', sxyage(ji,jj,jl)
722      END DO
723      DO jl = 1, jpl
724         DO jk = 1, nlay_i
725            WRITE(numout,*) ' jk, jl, ice heat content', jk, jl
726            WRITE(numout,*) ' sxe    ', sxe(ji,jj,jk,jl)
727            WRITE(numout,*) ' sye    ', sye(ji,jj,jk,jl)
728            WRITE(numout,*) ' sxxe   ', sxxe(ji,jj,jk,jl)
729            WRITE(numout,*) ' syye   ', syye(ji,jj,jk,jl)
730            WRITE(numout,*) ' sxye   ', sxye(ji,jj,jk,jl)
731         END DO
732      END DO
733
734      !+++++++++++ END CHECK +++++++++++++++++
735
736   END SUBROUTINE lim_rst_read
737
738
739#else
740   !!----------------------------------------------------------------------
741   !!   Default option :       Empty module            NO LIM sea-ice model
742   !!----------------------------------------------------------------------
743CONTAINS
744   SUBROUTINE lim_rst_read             ! Empty routine
745   END SUBROUTINE lim_rst_read
746   SUBROUTINE lim_rst_write            ! Empty routine
747   END SUBROUTINE lim_rst_write
748#endif
749
750   !!======================================================================
751END MODULE limrst
Note: See TracBrowser for help on using the repository browser.