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

source: NEMO/branches/UKMO/dev_r10037_GPU/src/TOP/PISCES/SED/sedrst.F90 @ 10843

Last change on this file since 10843 was 10843, checked in by andmirek, 5 years ago

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