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, 3 months 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
RevLine 
[3443]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
[12377]12   USE trc_oce, ONLY : l_offline
[10333]13   USE phycst , ONLY : rday
[10222]14   USE iom
15   USE daymod
16   USE lib_mpp         ! distribued memory computing library
[3443]17
18
19   !! * Accessibility
20   IMPLICIT NONE
21   PRIVATE
22
23   !! * Accessibility
[10222]24   PUBLIC sed_rst_opn       ! called by ???
[3443]25   PUBLIC sed_rst_read
26   PUBLIC sed_rst_wri
[10222]27   PUBLIC sed_rst_cal
[3443]28
[5215]29   !! $Id$
[3443]30CONTAINS
31
32
[10222]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
[11536]51               nitrst = nn_stocklist( nrst_lst )
[10222]52            ELSE
53               nitrst = nitend
54            ENDIF
55         ENDIF
[11536]56         IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nn_stock ) == 0 ) THEN
[10222]57            ! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment
[11536]58            nitrst = kt + nn_stock - 1                  ! define the next value of nitrst for restart writing
[10222]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
[11536]65      IF( .NOT. ln_rst_list .AND. nn_stock == -1 )   RETURN   ! we will never do any restart
66
[10222]67      ! to get better performances with NetCDF format:
[12377]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
[11536]70      IF( kt == nitrst - 2*nn_dtsed .OR. nn_stock == nn_dtsed .OR. ( kt == nitend - nn_dtsed .AND. .NOT. lrst_sed ) ) THEN
[10222]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
[13159]82         CALL iom_open( TRIM(clpath)//TRIM(clname), numrsw, ldwrt = .TRUE., kdlev = jpksed, cdcomp = 'SED' )
[10222]83         lrst_sed = .TRUE.
84      ENDIF
85      !
86   END SUBROUTINE sed_rst_opn
87
[3443]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
[10222]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
[3443]106      REAL(wp) :: zkt
107      CHARACTER(len = 20) ::   cltra
[10222]108      CHARACTER(LEN=20)   ::   name1
[3443]109      LOGICAL             ::   llok
110      !--------------------------------------------------------------------
111
[10222]112      IF( ln_timing )  CALL timing_start('sed_rst_read')
[3443]113
[10222]114      IF (lwp) WRITE(numsed,*) ' '     
115      IF (lwp) WRITE(numsed,*) ' Initilization of Sediment components from restart'
116      IF (lwp) WRITE(numsed,*) ' '
[3443]117
[10222]118      zdta  = 1.
119      zdta1 = 1.
120      zdta2 = 0.
121
[3443]122      DO jn = 1, jptrased
[10222]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
[3443]129      ENDDO
130
[10222]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
[3443]135
[10222]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
[3443]140
141      DO jn = 1, 2
[10222]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
[3443]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
[10222]160
[3443]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
[10222]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')
[3443]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
[10222]215      INTEGER  :: ji, jj, jk, jn
[3443]216      REAL(wp), DIMENSION(1) ::  zinfo
[10222]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
[3443]221      !! -----------------------------------------------------------------------
222
[10222]223      IF( ln_timing )  CALL timing_start('sed_rst_wri')
[3443]224
225         !! 0. initialisations
226         !! ------------------
227         
[10222]228      IF(lwp) WRITE(numsed,*) ' '
229      IF(lwp) WRITE(numsed,*) 'sed_rst_write : write the sediment restart file in NetCDF format ',   &
[3443]230            'at it= ',kt
[10222]231      IF(lwp) WRITE(numsed,*) '~~~~~~~~~'
232
233
234      trcsedi(:,:,:,:)   = 0.0
235      flxsedi3d(:,:,:,:) = 0.0
236      zdta(:,:)          = 1.0
237      zdta2(:,:,:)       = 0.0
238
[3443]239         
[10222]240      !! 1. WRITE in nutwrs
241      !! ------------------
[3443]242
[10222]243      zinfo(1) = REAL( kt)
244      CALL iom_rstput( kt, nitrst, numrsw, 'kt', zinfo  )
[3443]245
[10222]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
[3443]251
[10222]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
[3443]262
[10222]263      CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,1)  , iarroce(1:jpoce), &
264      &                   zdta(1:jpoce,1:jpksed)  )
[3443]265         
[10222]266      CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,2)  , iarroce(1:jpoce), &
267      &                   co3por(1:jpoce,1:jpksed)  )
[3443]268
[10222]269      ! prognostic variables
270      ! --------------------
[3443]271
[10222]272      DO jn = 1, jptrased
273         cltra = TRIM(sedtrcd(jn))
274         CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), trcsedi(:,:,:,jn) )
275      ENDDO
[3443]276
[10222]277      DO jn = 1, 2
278         cltra = TRIM(seddia3d(jn))
279         CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), flxsedi3d(:,:,:,jn) )
280      ENDDO
[3443]281
[10222]282      CALL unpack_arr( jpoce, zdta2(1:jpi,1:jpj,1:jpksed)  , iarroce(1:jpoce), &
283      &                   db(1:jpoce,1:jpksed)  )
[3443]284
[10222]285      cltra = "dbioturb"
286      CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), zdta2(:,:,:) )
[3443]287
[10222]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
[11536]304             nitrst = nn_stocklist( nrst_lst )
[10222]305          ENDIF
[3443]306      ENDIF
307
[10222]308      IF( ln_timing )  CALL timing_stop('sed_rst_wri')
[3443]309         
310   END SUBROUTINE sed_rst_wri
311
[10222]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)
[12489]332      !!       is not stored in the restart and is assumed to be (nittrc000-1)*rn_Dt.
[10222]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
[10425]355            CALL iom_open( TRIM(cn_sedrst_indir)//'/'//cn_sedrst_in, numrsr )
[10222]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
[12489]383               adatrj = ( REAL( nittrc000-1, wp ) * rn_Dt ) / rday
[10222]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
[3443]413END MODULE sedrst
Note: See TracBrowser for help on using the repository browser.