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/trunk/src/TOP/PISCES/SED – NEMO

source: NEMO/trunk/src/TOP/PISCES/SED/sedrst.F90 @ 14039

Last change on this file since 14039 was 14039, checked in by smasson, 3 years ago

trunk: bugfix to compile without key_iomput

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