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

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

Ticket #2462: Fixes after merge
  • Property svn:keywords set to Id
File size: 18.4 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, fname = TRIM(clpath)//TRIM(clpname), ld_closedef = .FALSE. )
94            CALL iom_swap(      cxios_context          )
95#else
96               clinfo = 'Can not use XIOS in trc_rst_opn'
97               CALL ctl_stop(TRIM(clinfo))
98#endif
99            ENDIF
100
101         lrst_sed = .TRUE.
102      ENDIF
103      !
104   END SUBROUTINE sed_rst_opn
105
106   SUBROUTINE sed_rst_read 
107      !!----------------------------------------------------------------------
108      !!                   ***  ROUTINE sed_rst_read  ***
109      !!
110      !! ** Purpose :  Initialization of sediment module
111      !!               - sets initial sediment composition
112      !!                 ( only clay or reading restart file )
113      !!
114      !!   History :
115      !!        !  06-07  (C. Ethe)  original
116      !!----------------------------------------------------------------------
117
118      !! * local declarations
119      INTEGER :: ji, jj, jk, jn 
120      REAL(wp), DIMENSION(jpi,jpj,jpksed,jptrased) :: zdta
121      REAL(wp), DIMENSION(jpi,jpj,jpksed,2)        :: zdta1 
122      REAL(wp), DIMENSION(jpi,jpj,jpksed)          :: zdta2
123      REAL(wp), DIMENSION(jpoce,jpksed)            :: zhipor
124      REAL(wp) :: zkt
125      CHARACTER(len = 20) ::   cltra
126      CHARACTER(LEN=20)   ::   name1
127      LOGICAL             ::   llok
128      !--------------------------------------------------------------------
129
130      IF( ln_timing )  CALL timing_start('sed_rst_read')
131
132      IF (lwp) WRITE(numsed,*) ' '     
133      IF (lwp) WRITE(numsed,*) ' Initilization of Sediment components from restart'
134      IF (lwp) WRITE(numsed,*) ' '
135
136      zdta  = 1.
137      zdta1 = 1.
138      zdta2 = 0.
139
140      IF(lrsxios) CALL iom_swap(crsxios_context)
141      DO jn = 1, jptrased
142         cltra = TRIM(sedtrcd(jn))
143         IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN
144            CALL iom_get( numrsr, jpdom_auto, TRIM(cltra), zdta(:,:,:,jn), ldxios = lrsxios )
145         ELSE
146            zdta(:,:,:,jn) = 0.0
147         ENDIF
148      ENDDO
149
150      DO jn = 1, jpsol
151         CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jn), &
152         &              zdta(1:jpi,1:jpj,1:jpksed,jn), iarroce(1:jpoce) )
153      END DO
154
155      DO jn = 1, jpwat
156         CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jn), &
157         &              zdta(1:jpi,1:jpj,1:jpksed,jpsol+jn), iarroce(1:jpoce) )
158      END DO
159
160      DO jn = 1, 2
161         cltra = TRIM(seddia3d(jn))
162         IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN
163            CALL iom_get( numrsr, jpdom_auto, TRIM(cltra), zdta1(:,:,:,jn), ldxios = lrsxios )
164         ELSE
165            zdta1(:,:,:,jn) = 0.0
166         ENDIF
167      ENDDO
168
169      zhipor(:,:) = 0.
170      CALL pack_arr( jpoce, zhipor(1:jpoce,1:jpksed), &
171         &             zdta1(1:jpi,1:jpj,1:jpksed,1), iarroce(1:jpoce) )
172
173      ! Initialization of [h+] in mol/kg
174      DO jk = 1, jpksed
175         DO ji = 1, jpoce
176            hipor (ji,jk) = 10.**( -1. * zhipor(ji,jk) )
177         ENDDO
178      ENDDO
179
180      CALL pack_arr( jpoce, co3por(1:jpoce,1:jpksed), &
181         &             zdta1(1:jpi,1:jpj,1:jpksed,2), iarroce(1:jpoce) )
182
183      ! Initialization of sediment composant only ie jk=2 to jk=jpksed
184      ! ( nothing in jk=1)
185      solcp(1:jpoce,1,:) = 0.
186      pwcp (1:jpoce,1,:) = 0.
187
188      cltra = "dbioturb"
189      IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN
190         CALL iom_get( numrsr, jpdom_auto, TRIM(cltra), zdta2(:,:,:), ldxios = lrsxios )
191      ELSE
192         zdta2(:,:,:) = 0.0
193      ENDIF
194
195      CALL pack_arr( jpoce, db(1:jpoce,1:jpksed), &
196         &             zdta2(1:jpi,1:jpj,1:jpksed), iarroce(1:jpoce) )
197
198      cltra = "irrig"
199      IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN
200         CALL iom_get( numrsr, jpdom_auto, TRIM(cltra), zdta2(:,:,:), ldxios = lrsxios )
201      ELSE
202         zdta2(:,:,:) = 0.0
203      ENDIF
204
205      CALL pack_arr( jpoce, irrig(1:jpoce,1:jpksed), &
206         &             zdta2(1:jpi,1:jpj,1:jpksed), iarroce(1:jpoce) )
207
208      cltra = "sedligand"
209      IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN
210         CALL iom_get( numrsr, jpdom_auto, TRIM(cltra), zdta2(:,:,:), ldxios = lrsxios )
211      ELSE
212         zdta2(:,:,:) = 0.0
213      ENDIF
214
215      CALL pack_arr( jpoce, sedligand(1:jpoce,1:jpksed), &
216         &             zdta2(1:jpi,1:jpj,1:jpksed), iarroce(1:jpoce) )
217      IF(lrsxios) CALL iom_swap(cxios_context)
218      IF( ln_timing )  CALL timing_stop('sed_rst_read')
219     
220   END SUBROUTINE sed_rst_read
221
222   SUBROUTINE sed_rst_wri( kt )
223      !!----------------------------------------------------------------------
224      !!                   ***  ROUTINE sed_rst_wri  ***
225      !!
226      !! ** Purpose :  save field which are necessary for sediment restart
227      !!
228      !!   History :
229      !!        !  06-07  (C. Ethe)  original
230      !!----------------------------------------------------------------------
231      !!* Modules used
232      INTEGER, INTENT(in) ::   kt       ! number of iteration
233      !! * local declarations
234      INTEGER  :: ji, jj, jk, jn
235      REAL(wp), DIMENSION(1) ::  zinfo
236      CHARACTER(len=50) :: clname
237      CHARACTER(len=20) :: cltra, name1 
238      REAL(wp), DIMENSION(jpoce,jpksed)   :: zdta   
239      REAL(wp), DIMENSION(jpi,jpj,jpksed) :: zdta2
240      !! -----------------------------------------------------------------------
241
242      IF( ln_timing )  CALL timing_start('sed_rst_wri')
243
244         !! 0. initialisations
245         !! ------------------
246         
247      IF(lwp) WRITE(numsed,*) ' '
248      IF(lwp) WRITE(numsed,*) 'sed_rst_write : write the sediment restart file in NetCDF format ',   &
249            'at it= ',kt
250      IF(lwp) WRITE(numsed,*) '~~~~~~~~~'
251
252
253      trcsedi(:,:,:,:)   = 0.0
254      flxsedi3d(:,:,:,:) = 0.0
255      zdta(:,:)          = 1.0
256      zdta2(:,:,:)       = 0.0
257
258         
259      !! 1. WRITE in nutwrs
260      !! ------------------
261      IF( lwxios ) CALL iom_swap(      cwsxios_context         )
262!     zinfo(1) = REAL( kt)
263      CALL iom_rstput( kt, nitrst, numrsw, 'kt', REAL( kt    , wp), ldxios = lwxios )
264
265      ! Back to 2D geometry
266      DO jn = 1, jpsol
267         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,jn) , iarroce(1:jpoce), &
268         &                       solcp(1:jpoce,1:jpksed,jn ) )
269      END DO
270
271      DO jn = 1, jpwat
272         CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,jpsol+jn) , iarroce(1:jpoce), &
273         &                       pwcp(1:jpoce,1:jpksed,jn  )  )
274      END DO
275      ! pH
276      DO jk = 1, jpksed
277         DO ji = 1, jpoce
278            zdta(ji,jk) = -LOG10( hipor(ji,jk) / ( densSW(ji) + rtrn ) + rtrn )
279         ENDDO
280      ENDDO
281
282      CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,1)  , iarroce(1:jpoce), &
283      &                   zdta(1:jpoce,1:jpksed)  )
284         
285      CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,2)  , iarroce(1:jpoce), &
286      &                   co3por(1:jpoce,1:jpksed)  )
287
288      ! prognostic variables
289      ! --------------------
290
291      DO jn = 1, jptrased
292         cltra = TRIM(sedtrcd(jn))
293         CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), trcsedi(:,:,:,jn), ldxios = lwxios )
294      ENDDO
295
296      DO jn = 1, 2
297         cltra = TRIM(seddia3d(jn))
298         CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), flxsedi3d(:,:,:,jn), ldxios = lwxios )
299      ENDDO
300
301      CALL unpack_arr( jpoce, zdta2(1:jpi,1:jpj,1:jpksed)  , iarroce(1:jpoce), &
302      &                   db(1:jpoce,1:jpksed)  )
303
304      cltra = "dbioturb"
305      CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), zdta2(:,:,:), ldxios = lwxios )
306
307      CALL unpack_arr( jpoce, zdta2(1:jpi,1:jpj,1:jpksed)  , iarroce(1:jpoce), &
308      &                   irrig(1:jpoce,1:jpksed)  )
309
310      cltra = "irrig"
311      CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), zdta2(:,:,:), ldxios = lwxios )
312
313      CALL unpack_arr( jpoce, zdta2(1:jpi,1:jpj,1:jpksed)  , iarroce(1:jpoce), &
314      &                   sedligand(1:jpoce,1:jpksed)  )
315
316      cltra = "sedligand"
317      CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), zdta2(:,:,:), ldxios = lwxios )
318      IF( lwxios ) CALL iom_swap(      cxios_context         )
319
320      IF( kt == nitrst ) THEN
321          IF(.NOT.lwxios) THEN
322             CALL iom_close( numrsw )     ! close the restart file (only at last time step)
323          ELSE
324             CALL iom_context_finalize( cwsxios_context ) 
325          ENDIF
326          IF( l_offline .AND. ln_rst_list ) THEN
327             nrst_lst = nrst_lst + 1
328             nitrst = nn_stocklist( nrst_lst )
329          ENDIF
330      ENDIF
331
332      IF( ln_timing )  CALL timing_stop('sed_rst_wri')
333         
334   END SUBROUTINE sed_rst_wri
335
336
337   SUBROUTINE sed_rst_cal( kt, cdrw )
338      !!---------------------------------------------------------------------
339      !!                   ***  ROUTINE sed_rst_cal  ***
340      !!
341      !!  ** Purpose : Read or write calendar in restart file:
342      !!
343      !!  WRITE(READ) mode:
344      !!       kt        : number of time step since the begining of the experiment at the
345      !!                   end of the current(previous) run
346      !!       adatrj(0) : number of elapsed days since the begining of the experiment at the
347      !!                   end of the current(previous) run (REAL -> keep fractions of day)
348      !!       ndastp    : date at the end of the current(previous) run (coded as yyyymmdd integer)
349      !!
350      !!   According to namelist parameter nrstdt,
351      !!       nn_rsttr = 0  no control on the date (nittrc000 is  arbitrary).
352      !!       nn_rsttr = 1  we verify that nittrc000 is equal to the last
353      !!                   time step of previous run + 1.
354      !!       In both those options, the  exact duration of the experiment
355      !!       since the beginning (cumulated duration of all previous restart runs)
356      !!       is not stored in the restart and is assumed to be (nittrc000-1)*rn_Dt.
357      !!       This is valid is the time step has remained constant.
358      !!
359      !!       nn_rsttr = 2  the duration of the experiment in days (adatrj)
360      !!                    has been stored in the restart file.
361      !!----------------------------------------------------------------------
362      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
363      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
364      !
365      LOGICAL  ::  llok
366      REAL(wp) ::  zkt, zrdttrc1
367      REAL(wp) ::  zndastp
368      CHARACTER(len = 82) :: clpname
369
370      ! Time domain : restart
371      ! ---------------------
372
373      IF( TRIM(cdrw) == 'READ' ) THEN
374
375         IF(lwp) WRITE(numsed,*)
376         IF(lwp) WRITE(numsed,*) 'sed_rst_cal : read the SED restart file for calendar'
377         IF(lwp) WRITE(numsed,*) '~~~~~~~~~~~~'
378
379         IF( ln_rst_sed ) THEN
380            lxios_sini = .FALSE.
381            CALL iom_open( TRIM(cn_sedrst_indir)//'/'//cn_sedrst_in, numrsr )
382
383            lrsxios = lrxios.AND.lxios_sini
384            IF( lrsxios) THEN
385                crsxios_context = 'sed_rst'
386                IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS for SED'
387                IF( TRIM(Agrif_CFixed()) == '0' ) THEN
388                   clpname = cn_sedrst_in
389                ELSE
390                   clpname = TRIM(Agrif_CFixed())//"_"//cn_sedrst_in   
391                ENDIF
392                CALL iom_init( crsxios_context, fname = TRIM(cn_sedrst_indir)//'/'//TRIM(clpname), &
393                                                idfp = iom_file(numrsr)%nfid, ld_closedef = .TRUE. )
394            ENDIF
395            IF(lrsxios) CALL iom_swap(crsxios_context)
396            CALL iom_get ( numrsr, 'kt', zkt, ldxios = lrsxios )   ! last time-step of previous run
397            IF(lrsxios) CALL iom_swap(cxios_context)
398            IF(lwp) THEN
399               WRITE(numsed,*) ' *** Info read in restart : '
400               WRITE(numsed,*) '   previous time-step                               : ', NINT( zkt )
401               WRITE(numsed,*) ' *** restart option'
402               SELECT CASE ( nn_rstsed )
403               CASE ( 0 )   ;   WRITE(numsed,*) ' nn_rstsed = 0 : no control of nittrc000'
404               CASE ( 1 )   ;   WRITE(numsed,*) ' nn_rstsed = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)'
405               CASE ( 2 )   ;   WRITE(numsed,*) ' nn_rstsed = 2 : calendar parameters read in restart'
406               END SELECT
407               WRITE(numsed,*)
408            ENDIF
409            ! Control of date
410            IF( nittrc000  - NINT( zkt ) /= nn_dtsed .AND.  nn_rstsed /= 0 )                                  &
411               &   CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart',                 &
412               &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' )
413         ENDIF
414         !
415         IF( l_offline ) THEN
416            !                                          ! set the date in offline mode
417            IF( ln_rst_sed .AND. nn_rstsed == 2 ) THEN
418               IF(lrsxios) CALL iom_swap(crsxios_context)
419               CALL iom_get( numrsr, 'ndastp', zndastp, ldxios = lrsxios )
420               ndastp = NINT( zndastp )
421               CALL iom_get( numrsr, 'adatrj', adatrj, ldxios = lrsxios  )
422               IF(lrsxios) CALL iom_swap(crxios_context)
423             ELSE
424               ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam
425               adatrj = ( REAL( nittrc000-1, wp ) * rn_Dt ) / rday
426               ! note this is wrong if time step has changed during run
427            ENDIF
428            !
429            IF(lwp) THEN
430              WRITE(numsed,*) ' *** Info used values : '
431              WRITE(numsed,*) '   date ndastp                                      : ', ndastp
432              WRITE(numsed,*) '   number of elapsed days since the begining of run : ', adatrj
433              WRITE(numsed,*)
434            ENDIF
435            !
436            CALL day_init          ! compute calendar
437            !
438         ENDIF
439         !
440      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
441         !
442         IF(  kt == nitrst ) THEN
443            IF(lwp) WRITE(numsed,*)
444            IF(lwp) WRITE(numsed,*) 'trc_wri : write the TOP restart file (NetCDF) at it= ', kt, ' date= ', ndastp
445            IF(lwp) WRITE(numsed,*) '~~~~~~~'
446            IF( lwxios ) CALL iom_init_closedef(cwsxios_context)
447         ENDIF
448         IF( lwxios ) CALL iom_swap(      cwsxios_context         )
449         CALL iom_rstput( kt, nitrst, numrsw, 'kt'     , REAL( kt    , wp), ldxios = lwxios )   ! time-step
450         CALL iom_rstput( kt, nitrst, numrsw, 'ndastp' , REAL( ndastp, wp), ldxios = lwxios )   ! date
451         CALL iom_rstput( kt, nitrst, numrsw, 'adatrj' , adatrj,            ldxios = lwxios )   ! number of elapsed days since
452         !                                                                                      ! the begining of the run [s]
453         IF( lwxios ) CALL iom_swap(      cxios_context         )
454      ENDIF
455
456   END SUBROUTINE sed_rst_cal
457
458END MODULE sedrst
Note: See TracBrowser for help on using the repository browser.