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.
sedrst.F90 in NEMO/branches/2020/dev_12905_xios_restart/src/TOP/PISCES/SED – NEMO

source: NEMO/branches/2020/dev_12905_xios_restart/src/TOP/PISCES/SED/sedrst.F90 @ 12969

Last change on this file since 12969 was 12969, checked in by andmirek, 4 years ago

ticket #2462: read restart with XIOS independently for each component
  • Property svn:keywords set to Id
File size: 18.5 KB
Line 
1MODULE sedrst
2   !!======================================================================
3   !!                       *** MODULE sedrst ***
4   !!   Read and write the restart files for sediment
5   !!======================================================================
6
7   !!----------------------------------------------------------------------
8   !! * Modules used
9   !! ==============
10   USE sed
11   USE sedarr
12   USE trc_oce, ONLY : l_offline
13   USE phycst , ONLY : rday
14   USE iom
15   USE daymod
16   USE lib_mpp         ! distribued memory computing library
17
18
19   !! * Accessibility
20   IMPLICIT NONE
21   PRIVATE
22
23   !! * Accessibility
24   PUBLIC sed_rst_opn       ! called by ???
25   PUBLIC sed_rst_read
26   PUBLIC sed_rst_wri
27   PUBLIC sed_rst_cal
28
29   !! $Id$
30CONTAINS
31
32
33   SUBROUTINE sed_rst_opn( kt )
34      !!----------------------------------------------------------------------
35      !!                    ***  sed_rst_opn  ***
36      !!
37      !! ** purpose  :   output of sed-trc variable in a netcdf file
38      !!----------------------------------------------------------------------
39      INTEGER, INTENT(in) ::   kt       ! number of iteration
40      !
41      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character
42      CHARACTER(LEN=50)   ::   clname   ! trc output restart file name
43      CHARACTER(LEN=256)  ::   clpath   ! full path to ocean output restart file
44      CHARACTER(LEN=52)   ::   clpname   ! trc output restart file name including AGRIF
45      !!----------------------------------------------------------------------
46      !
47      IF( l_offline ) THEN
48         IF( kt == nittrc000 ) THEN
49            lrst_sed = .FALSE.
50            IF( ln_rst_list ) THEN
51               nrst_lst = 1
52               nitrst = nn_stocklist( nrst_lst )
53            ELSE
54               nitrst = nitend
55            ENDIF
56         ENDIF
57         IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nn_stock ) == 0 ) THEN
58            ! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment
59            nitrst = kt + nn_stock - 1                  ! define the next value of nitrst for restart writing
60            IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run
61         ENDIF
62      ELSE
63         IF( kt == nittrc000 ) lrst_sed = .FALSE.
64      ENDIF
65
66      IF( .NOT. ln_rst_list .AND. nn_stock == -1 )   RETURN   ! we will never do any restart
67
68      ! to get better performances with NetCDF format:
69      ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 1)
70      ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 1
71      IF( kt == nitrst - 2*nn_dtsed .OR. nn_stock == nn_dtsed .OR. ( kt == nitend - nn_dtsed .AND. .NOT. lrst_sed ) ) THEN
72         ! beware of the format used to write kt (default is i8.8, that should be large enough)
73         IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst
74         ELSE                        ;   WRITE(clkt,'(i8.8)') nitrst
75         ENDIF
76         ! create the file
77         IF(lwp) WRITE(numsed,*)
78         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_sedrst_out)
79         clpath = TRIM(cn_sedrst_outdir)
80         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
81         IF(lwp) WRITE(numsed,*) &
82             '             open sed restart.output NetCDF file: ',TRIM(clpath)//clname
83         IF(.NOT.lwxios) THEN
84            CALL iom_open( TRIM(clpath)//TRIM(clname), numrsw, ldwrt = .TRUE., kdlev = jpksed, cdcomp = 'SED' )
85         ELSE
86#if defined key_iomput
87            cwsxios_context = "rstws_"//TRIM(ADJUSTL(clkt))
88            IF( TRIM(Agrif_CFixed()) == '0' ) THEN
89               clpname = clname
90            ELSE
91               clpname = TRIM(Agrif_CFixed())//"_"//clname
92            ENDIF
93            CALL iom_init( cwsxios_context, TRIM(clpath)//TRIM(clpname), ld_tmppatch = .false.,&
94                                                                         ld_closedef = .FALSE. )
95            CALL iom_swap(      cxios_context          )
96#else
97               clinfo = 'Can not use XIOS in trc_rst_opn'
98               CALL ctl_stop(TRIM(clinfo))
99#endif
100            ENDIF
101
102         lrst_sed = .TRUE.
103      ENDIF
104      !
105   END SUBROUTINE sed_rst_opn
106
107   SUBROUTINE sed_rst_read 
108      !!----------------------------------------------------------------------
109      !!                   ***  ROUTINE sed_rst_read  ***
110      !!
111      !! ** Purpose :  Initialization of sediment module
112      !!               - sets initial sediment composition
113      !!                 ( only clay or reading restart file )
114      !!
115      !!   History :
116      !!        !  06-07  (C. Ethe)  original
117      !!----------------------------------------------------------------------
118
119      !! * local declarations
120      INTEGER :: ji, jj, jk, jn 
121      REAL(wp), DIMENSION(jpi,jpj,jpksed,jptrased) :: zdta
122      REAL(wp), DIMENSION(jpi,jpj,jpksed,2)        :: zdta1 
123      REAL(wp), DIMENSION(jpi,jpj,jpksed)          :: zdta2
124      REAL(wp), DIMENSION(jpoce,jpksed)            :: zhipor
125      REAL(wp) :: zkt
126      CHARACTER(len = 20) ::   cltra
127      CHARACTER(LEN=20)   ::   name1
128      LOGICAL             ::   llok
129      !--------------------------------------------------------------------
130
131      IF( ln_timing )  CALL timing_start('sed_rst_read')
132
133      IF (lwp) WRITE(numsed,*) ' '     
134      IF (lwp) WRITE(numsed,*) ' Initilization of Sediment components from restart'
135      IF (lwp) WRITE(numsed,*) ' '
136
137      zdta  = 1.
138      zdta1 = 1.
139      zdta2 = 0.
140
141      IF(lrsxios) CALL iom_swap(crsxios_context)
142      DO jn = 1, jptrased
143         cltra = TRIM(sedtrcd(jn))
144         IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN
145            CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta(:,:,:,jn), ldxios = lrsxios )
146         ELSE
147            zdta(:,:,:,jn) = 0.0
148         ENDIF
149      ENDDO
150
151      DO jn = 1, jpsol
152         CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jn), &
153         &              zdta(1:jpi,1:jpj,1:jpksed,jn), iarroce(1:jpoce) )
154      END DO
155
156      DO jn = 1, jpwat
157         CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jn), &
158         &              zdta(1:jpi,1:jpj,1:jpksed,jpsol+jn), iarroce(1:jpoce) )
159      END DO
160
161      DO jn = 1, 2
162         cltra = TRIM(seddia3d(jn))
163         IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN
164            CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta1(:,:,:,jn), ldxios = lrsxios )
165         ELSE
166            zdta1(:,:,:,jn) = 0.0
167         ENDIF
168      ENDDO
169
170      zhipor(:,:) = 0.
171      CALL pack_arr( jpoce, zhipor(1:jpoce,1:jpksed), &
172         &             zdta1(1:jpi,1:jpj,1:jpksed,1), iarroce(1:jpoce) )
173
174      ! Initialization of [h+] in mol/kg
175      DO jk = 1, jpksed
176         DO ji = 1, jpoce
177            hipor (ji,jk) = 10.**( -1. * zhipor(ji,jk) )
178         ENDDO
179      ENDDO
180
181      CALL pack_arr( jpoce, co3por(1:jpoce,1:jpksed), &
182         &             zdta1(1:jpi,1:jpj,1:jpksed,2), iarroce(1:jpoce) )
183
184      ! Initialization of sediment composant only ie jk=2 to jk=jpksed
185      ! ( nothing in jk=1)
186      solcp(1:jpoce,1,:) = 0.
187      pwcp (1:jpoce,1,:) = 0.
188
189      cltra = "dbioturb"
190      IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN
191         CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta2(:,:,:), ldxios = lrsxios )
192      ELSE
193         zdta2(:,:,:) = 0.0
194      ENDIF
195
196      CALL pack_arr( jpoce, db(1:jpoce,1:jpksed), &
197         &             zdta2(1:jpi,1:jpj,1:jpksed), iarroce(1:jpoce) )
198
199      cltra = "irrig"
200      IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN
201         CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta2(:,:,:), ldxios = lrsxios )
202      ELSE
203         zdta2(:,:,:) = 0.0
204      ENDIF
205
206      CALL pack_arr( jpoce, irrig(1:jpoce,1:jpksed), &
207         &             zdta2(1:jpi,1:jpj,1:jpksed), iarroce(1:jpoce) )
208
209      cltra = "sedligand"
210      IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN
211         CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta2(:,:,:), ldxios = lrsxios )
212      ELSE
213         zdta2(:,:,:) = 0.0
214      ENDIF
215
216      CALL pack_arr( jpoce, sedligand(1:jpoce,1:jpksed), &
217         &             zdta2(1:jpi,1:jpj,1:jpksed), iarroce(1:jpoce) )
218      IF(lrsxios) CALL iom_swap(cxios_context)
219      IF( ln_timing )  CALL timing_stop('sed_rst_read')
220     
221   END SUBROUTINE sed_rst_read
222
223   SUBROUTINE sed_rst_wri( kt )
224      !!----------------------------------------------------------------------
225      !!                   ***  ROUTINE sed_rst_wri  ***
226      !!
227      !! ** Purpose :  save field which are necessary for sediment restart
228      !!
229      !!   History :
230      !!        !  06-07  (C. Ethe)  original
231      !!----------------------------------------------------------------------
232      !!* Modules used
233      INTEGER, INTENT(in) ::   kt       ! number of iteration
234      !! * local declarations
235      INTEGER  :: ji, jj, jk, jn
236      REAL(wp), DIMENSION(1) ::  zinfo
237      CHARACTER(len=50) :: clname
238      CHARACTER(len=20) :: cltra, name1 
239      REAL(wp), DIMENSION(jpoce,jpksed)   :: zdta   
240      REAL(wp), DIMENSION(jpi,jpj,jpksed) :: zdta2
241      !! -----------------------------------------------------------------------
242
243      IF( ln_timing )  CALL timing_start('sed_rst_wri')
244
245         !! 0. initialisations
246         !! ------------------
247         
248      IF(lwp) WRITE(numsed,*) ' '
249      IF(lwp) WRITE(numsed,*) 'sed_rst_write : write the sediment restart file in NetCDF format ',   &
250            'at it= ',kt
251      IF(lwp) WRITE(numsed,*) '~~~~~~~~~'
252
253
254      trcsedi(:,:,:,:)   = 0.0
255      flxsedi3d(:,:,:,:) = 0.0
256      zdta(:,:)          = 1.0
257      zdta2(:,:,:)       = 0.0
258
259         
260      !! 1. WRITE in nutwrs
261      !! ------------------
262      IF( lwxios ) CALL iom_swap(      cwsxios_context         )
263!     zinfo(1) = REAL( kt)
264      CALL iom_rstput( kt, nitrst, numrsw, 'kt', REAL( kt    , wp), ldxios = lwxios )
265
266      ! Back to 2D geometry
267      DO jn = 1, jpsol
268         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,jn) , iarroce(1:jpoce), &
269         &                       solcp(1:jpoce,1:jpksed,jn ) )
270      END DO
271
272      DO jn = 1, jpwat
273         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,jpsol+jn) , iarroce(1:jpoce), &
274         &                       pwcp(1:jpoce,1:jpksed,jn  )  )
275      END DO
276      ! pH
277      DO jk = 1, jpksed
278         DO ji = 1, jpoce
279            zdta(ji,jk) = -LOG10( hipor(ji,jk) / ( densSW(ji) + rtrn ) + rtrn )
280         ENDDO
281      ENDDO
282
283      CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,1)  , iarroce(1:jpoce), &
284      &                   zdta(1:jpoce,1:jpksed)  )
285         
286      CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,2)  , iarroce(1:jpoce), &
287      &                   co3por(1:jpoce,1:jpksed)  )
288
289      ! prognostic variables
290      ! --------------------
291
292      DO jn = 1, jptrased
293         cltra = TRIM(sedtrcd(jn))
294         CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), trcsedi(:,:,:,jn), ldxios = lwxios )
295      ENDDO
296
297      DO jn = 1, 2
298         cltra = TRIM(seddia3d(jn))
299         CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), flxsedi3d(:,:,:,jn), ldxios = lwxios )
300      ENDDO
301
302      CALL unpack_arr( jpoce, zdta2(1:jpi,1:jpj,1:jpksed)  , iarroce(1:jpoce), &
303      &                   db(1:jpoce,1:jpksed)  )
304
305      cltra = "dbioturb"
306      CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), zdta2(:,:,:), ldxios = lwxios )
307
308      CALL unpack_arr( jpoce, zdta2(1:jpi,1:jpj,1:jpksed)  , iarroce(1:jpoce), &
309      &                   irrig(1:jpoce,1:jpksed)  )
310
311      cltra = "irrig"
312      CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), zdta2(:,:,:), ldxios = lwxios )
313
314      CALL unpack_arr( jpoce, zdta2(1:jpi,1:jpj,1:jpksed)  , iarroce(1:jpoce), &
315      &                   sedligand(1:jpoce,1:jpksed)  )
316
317      cltra = "sedligand"
318      CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), zdta2(:,:,:), ldxios = lwxios )
319      IF( lwxios ) CALL iom_swap(      cxios_context         )
320
321      IF( kt == nitrst ) THEN
322          IF(.NOT.lwxios) THEN
323             CALL iom_close( numrsw )     ! close the restart file (only at last time step)
324          ELSE
325             CALL iom_context_finalize( cwsxios_context ) 
326          ENDIF
327          IF( l_offline .AND. ln_rst_list ) THEN
328             nrst_lst = nrst_lst + 1
329             nitrst = nn_stocklist( nrst_lst )
330          ENDIF
331      ENDIF
332
333      IF( ln_timing )  CALL timing_stop('sed_rst_wri')
334         
335   END SUBROUTINE sed_rst_wri
336
337
338   SUBROUTINE sed_rst_cal( kt, cdrw )
339      !!---------------------------------------------------------------------
340      !!                   ***  ROUTINE sed_rst_cal  ***
341      !!
342      !!  ** Purpose : Read or write calendar in restart file:
343      !!
344      !!  WRITE(READ) mode:
345      !!       kt        : number of time step since the begining of the experiment at the
346      !!                   end of the current(previous) run
347      !!       adatrj(0) : number of elapsed days since the begining of the experiment at the
348      !!                   end of the current(previous) run (REAL -> keep fractions of day)
349      !!       ndastp    : date at the end of the current(previous) run (coded as yyyymmdd integer)
350      !!
351      !!   According to namelist parameter nrstdt,
352      !!       nn_rsttr = 0  no control on the date (nittrc000 is  arbitrary).
353      !!       nn_rsttr = 1  we verify that nittrc000 is equal to the last
354      !!                   time step of previous run + 1.
355      !!       In both those options, the  exact duration of the experiment
356      !!       since the beginning (cumulated duration of all previous restart runs)
357      !!       is not stored in the restart and is assumed to be (nittrc000-1)*rn_Dt.
358      !!       This is valid is the time step has remained constant.
359      !!
360      !!       nn_rsttr = 2  the duration of the experiment in days (adatrj)
361      !!                    has been stored in the restart file.
362      !!----------------------------------------------------------------------
363      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
364      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
365      !
366      LOGICAL  ::  llok
367      REAL(wp) ::  zkt, zrdttrc1
368      REAL(wp) ::  zndastp
369      CHARACTER(len = 82) :: clpname
370
371      ! Time domain : restart
372      ! ---------------------
373
374      IF( TRIM(cdrw) == 'READ' ) THEN
375
376         IF(lwp) WRITE(numsed,*)
377         IF(lwp) WRITE(numsed,*) 'sed_rst_cal : read the SED restart file for calendar'
378         IF(lwp) WRITE(numsed,*) '~~~~~~~~~~~~'
379
380         IF( ln_rst_sed ) THEN
381            lxios_sini = .FALSE.
382            CALL iom_open( TRIM(cn_sedrst_indir)//'/'//cn_sedrst_in, numrsr )
383
384            lrsxios = lrxios.AND.lxios_sini
385            IF( lrsxios) THEN
386                crsxios_context = 'sed_rst'
387                IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS for SED'
388                IF( TRIM(Agrif_CFixed()) == '0' ) THEN
389                   clpname = cn_sedrst_in
390                ELSE
391                   clpname = TRIM(Agrif_CFixed())//"_"//cn_sedrst_in   
392                ENDIF
393                CALL iom_init( crsxios_context, fname = TRIM(cn_sedrst_indir)//'/'//TRIM(clpname), &
394                                                idfp = iom_file(numrsr)%nfid, ld_tmppatch = .TRUE. )
395            ENDIF
396            IF(lrsxios) CALL iom_swap(crsxios_context)
397            CALL iom_get ( numrsr, 'kt', zkt, ldxios = lrsxios )   ! last time-step of previous run
398            IF(lrsxios) CALL iom_swap(cxios_context)
399            IF(lwp) THEN
400               WRITE(numsed,*) ' *** Info read in restart : '
401               WRITE(numsed,*) '   previous time-step                               : ', NINT( zkt )
402               WRITE(numsed,*) ' *** restart option'
403               SELECT CASE ( nn_rstsed )
404               CASE ( 0 )   ;   WRITE(numsed,*) ' nn_rstsed = 0 : no control of nittrc000'
405               CASE ( 1 )   ;   WRITE(numsed,*) ' nn_rstsed = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)'
406               CASE ( 2 )   ;   WRITE(numsed,*) ' nn_rstsed = 2 : calendar parameters read in restart'
407               END SELECT
408               WRITE(numsed,*)
409            ENDIF
410            ! Control of date
411            IF( nittrc000  - NINT( zkt ) /= nn_dtsed .AND.  nn_rstsed /= 0 )                                  &
412               &   CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart',                 &
413               &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' )
414         ENDIF
415         !
416         IF( l_offline ) THEN
417            !                                          ! set the date in offline mode
418            IF( ln_rst_sed .AND. nn_rstsed == 2 ) THEN
419               IF(lrsxios) CALL iom_swap(crsxios_context)
420               CALL iom_get( numrsr, 'ndastp', zndastp, ldxios = lrsxios )
421               ndastp = NINT( zndastp )
422               CALL iom_get( numrsr, 'adatrj', adatrj, ldxios = lrsxios  )
423               IF(lrsxios) CALL iom_swap(crxios_context)
424             ELSE
425               ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam
426               adatrj = ( REAL( nittrc000-1, wp ) * rn_Dt ) / rday
427               ! note this is wrong if time step has changed during run
428            ENDIF
429            !
430            IF(lwp) THEN
431              WRITE(numsed,*) ' *** Info used values : '
432              WRITE(numsed,*) '   date ndastp                                      : ', ndastp
433              WRITE(numsed,*) '   number of elapsed days since the begining of run : ', adatrj
434              WRITE(numsed,*)
435            ENDIF
436            !
437            CALL day_init          ! compute calendar
438            !
439         ENDIF
440         !
441      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
442         !
443         IF(  kt == nitrst ) THEN
444            IF(lwp) WRITE(numsed,*)
445            IF(lwp) WRITE(numsed,*) 'trc_wri : write the TOP restart file (NetCDF) at it= ', kt, ' date= ', ndastp
446            IF(lwp) WRITE(numsed,*) '~~~~~~~'
447            IF( lwxios ) CALL iom_init_closedef(cwsxios_context)
448         ENDIF
449         IF( lwxios ) CALL iom_swap(      cwsxios_context         )
450         CALL iom_rstput( kt, nitrst, numrsw, 'kt'     , REAL( kt    , wp), ldxios = lwxios )   ! time-step
451         CALL iom_rstput( kt, nitrst, numrsw, 'ndastp' , REAL( ndastp, wp), ldxios = lwxios )   ! date
452         CALL iom_rstput( kt, nitrst, numrsw, 'adatrj' , adatrj,            ldxios = lwxios )   ! number of elapsed days since
453         !                                                                                      ! the begining of the run [s]
454         IF( lwxios ) CALL iom_swap(      cxios_context         )
455      ENDIF
456
457   END SUBROUTINE sed_rst_cal
458
459END MODULE sedrst
Note: See TracBrowser for help on using the repository browser.