source: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/TOP/PISCES/SED/sedrst.F90 @ 13159

Last change on this file since 13159 was 13159, checked in by gsamson, 7 weeks ago

merge trunk@r13136 into ASINTER-06 branch; pass all SETTE tests; results identical to trunk@r13136; ticket #2419

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