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

Last change on this file since 10425 was 10425, checked in by smasson, 5 years ago

trunk: merge back dev_r10164_HPC09_ESIWACE_PREP_MERGE@10424 into the trunk
  • Property svn:keywords set to Id
File size: 16.0 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, nn_dttrc
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      !!----------------------------------------------------------------------
45      !
46      IF( l_offline ) THEN
47         IF( kt == nittrc000 ) THEN
48            lrst_sed = .FALSE.
49            IF( ln_rst_list ) THEN
50               nrst_lst = 1
51               nitrst = nstocklist( nrst_lst )
52            ELSE
53               nitrst = nitend
54            ENDIF
55         ENDIF
56         IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN
57            ! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment
58            nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing
59            IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run
60         ENDIF
61      ELSE
62         IF( kt == nittrc000 ) lrst_sed = .FALSE.
63      ENDIF
64
65      ! to get better performances with NetCDF format:
66      ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*nn_dttrc + 1)
67      ! 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
68      IF( kt == nitrst - 2*nn_dtsed .OR. nstock == nn_dtsed .OR. ( kt == nitend - nn_dtsed .AND. .NOT. lrst_sed ) ) THEN
69         ! beware of the format used to write kt (default is i8.8, that should be large enough)
70         IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst
71         ELSE                        ;   WRITE(clkt,'(i8.8)') nitrst
72         ENDIF
73         ! create the file
74         IF(lwp) WRITE(numsed,*)
75         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_sedrst_out)
76         clpath = TRIM(cn_sedrst_outdir)
77         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
78         IF(lwp) WRITE(numsed,*) &
79             '             open sed restart.output NetCDF file: ',TRIM(clpath)//clname
80         CALL iom_open( TRIM(clpath)//TRIM(clname), numrsw, ldwrt = .TRUE., kdlev = jpksed )
81         lrst_sed = .TRUE.
82      ENDIF
83      !
84   END SUBROUTINE sed_rst_opn
85
86   SUBROUTINE sed_rst_read 
87      !!----------------------------------------------------------------------
88      !!                   ***  ROUTINE sed_rst_read  ***
89      !!
90      !! ** Purpose :  Initialization of sediment module
91      !!               - sets initial sediment composition
92      !!                 ( only clay or reading restart file )
93      !!
94      !!   History :
95      !!        !  06-07  (C. Ethe)  original
96      !!----------------------------------------------------------------------
97
98      !! * local declarations
99      INTEGER :: ji, jj, jk, jn 
100      REAL(wp), DIMENSION(jpi,jpj,jpksed,jptrased) :: zdta
101      REAL(wp), DIMENSION(jpi,jpj,jpksed,2)        :: zdta1 
102      REAL(wp), DIMENSION(jpi,jpj,jpksed)          :: zdta2
103      REAL(wp), DIMENSION(jpoce,jpksed)            :: zhipor
104      REAL(wp) :: zkt
105      CHARACTER(len = 20) ::   cltra
106      CHARACTER(LEN=20)   ::   name1
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      LOGICAL  ::  llok
340      REAL(wp) ::  zkt, zrdttrc1
341      REAL(wp) ::  zndastp
342
343      ! Time domain : restart
344      ! ---------------------
345
346      IF( TRIM(cdrw) == 'READ' ) THEN
347
348         IF(lwp) WRITE(numsed,*)
349         IF(lwp) WRITE(numsed,*) 'sed_rst_cal : read the SED restart file for calendar'
350         IF(lwp) WRITE(numsed,*) '~~~~~~~~~~~~'
351
352         IF( ln_rst_sed ) THEN
353            CALL iom_open( TRIM(cn_sedrst_indir)//'/'//cn_sedrst_in, numrsr )
354            CALL iom_get ( numrsr, 'kt', zkt )   ! last time-step of previous run
355
356            IF(lwp) THEN
357               WRITE(numsed,*) ' *** Info read in restart : '
358               WRITE(numsed,*) '   previous time-step                               : ', NINT( zkt )
359               WRITE(numsed,*) ' *** restart option'
360               SELECT CASE ( nn_rstsed )
361               CASE ( 0 )   ;   WRITE(numsed,*) ' nn_rstsed = 0 : no control of nittrc000'
362               CASE ( 1 )   ;   WRITE(numsed,*) ' nn_rstsed = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)'
363               CASE ( 2 )   ;   WRITE(numsed,*) ' nn_rstsed = 2 : calendar parameters read in restart'
364               END SELECT
365               WRITE(numsed,*)
366            ENDIF
367            ! Control of date
368            IF( nittrc000  - NINT( zkt ) /= nn_dtsed .AND.  nn_rstsed /= 0 )                                  &
369               &   CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart',                 &
370               &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' )
371         ENDIF
372         !
373         IF( l_offline ) THEN
374            !                                          ! set the date in offline mode
375            IF( ln_rst_sed .AND. nn_rstsed == 2 ) THEN
376               CALL iom_get( numrsr, 'ndastp', zndastp )
377               ndastp = NINT( zndastp )
378               CALL iom_get( numrsr, 'adatrj', adatrj  )
379             ELSE
380               ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam
381               adatrj = ( REAL( nittrc000-1, wp ) * rdt ) / rday
382               ! note this is wrong if time step has changed during run
383            ENDIF
384            !
385            IF(lwp) THEN
386              WRITE(numsed,*) ' *** Info used values : '
387              WRITE(numsed,*) '   date ndastp                                      : ', ndastp
388              WRITE(numsed,*) '   number of elapsed days since the begining of run : ', adatrj
389              WRITE(numsed,*)
390            ENDIF
391            !
392            CALL day_init          ! compute calendar
393            !
394         ENDIF
395         !
396      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
397         !
398         IF(  kt == nitrst ) THEN
399            IF(lwp) WRITE(numsed,*)
400            IF(lwp) WRITE(numsed,*) 'trc_wri : write the TOP restart file (NetCDF) at it= ', kt, ' date= ', ndastp
401            IF(lwp) WRITE(numsed,*) '~~~~~~~'
402         ENDIF
403         CALL iom_rstput( kt, nitrst, numrsw, 'kt'     , REAL( kt    , wp) )   ! time-step
404         CALL iom_rstput( kt, nitrst, numrsw, 'ndastp' , REAL( ndastp, wp) )   ! date
405         CALL iom_rstput( kt, nitrst, numrsw, 'adatrj' , adatrj            )   ! number of elapsed days since
406         !                                                                     ! the begining of the run [s]
407      ENDIF
408
409   END SUBROUTINE sed_rst_cal
410
411END MODULE sedrst
Note: See TracBrowser for help on using the repository browser.