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.
trcrst.F90 in trunk/NEMO/TOP_SRC – NEMO

source: trunk/NEMO/TOP_SRC/trcrst.F90 @ 730

Last change on this file since 730 was 730, checked in by cetlod, 17 years ago

remove unused variables, see ticket:19

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 17.1 KB
Line 
1MODULE trcrst
2   !!======================================================================
3   !!
4   !!                       *** MODULE trcrst ***
5   !!
6   !!   Read the restart files for passive tracers
7   !!
8   !!======================================================================
9   !!  TOP 1.0,  LOCEAN-IPSL (2005)
10   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/trcrst.F90,v 1.11 2007/10/17 14:48:56 opalod Exp $
11   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
12   !!----------------------------------------------------------------------
13#if defined key_passivetrc   
14   !!----------------------------------------------------------------------
15   !! * Modules used
16   !! ==============
17   USE oce_trc
18   USE trc
19   USE sms
20   USE trctrp_lec   
21   USE lib_mpp
22   USE iom
23   
24   IMPLICIT NONE
25   PRIVATE
26   
27   !! * Accessibility
28   PUBLIC trc_rst_opn
29   PUBLIC trc_rst_read
30   PUBLIC trc_rst_wri
31   
32   !! * Module variables
33   LOGICAL, PUBLIC ::   lrst_trc         !: logical to control the trc restart write
34   INTEGER, PUBLIC ::   numrtr, numrtw   !: logical unit for trc restart (read and write)
35
36
37   !! * Substitutions
38#  include "passivetrc_substitute.h90"
39   
40CONTAINS
41   
42   SUBROUTINE trc_rst_opn( kt )
43      !!----------------------------------------------------------------------
44      !!                    ***  trc_rst_opn  ***
45      !!
46      !! ** purpose  :   output of sea-trc variable in a netcdf file
47      !!----------------------------------------------------------------------
48      INTEGER, INTENT(in) ::   kt       ! number of iteration
49      !
50      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character
51      CHARACTER(LEN=50)   ::   clname   ! trc output restart file name
52      !!----------------------------------------------------------------------
53      !
54
55      IF( kt == nit000 )  THEN
56         lrst_trc = .FALSE.
57#if defined key_off_tra
58         nitrst = nitend  ! in online version, already done in rst_opn routine defined in restart.F90 module
59#endif
60      ENDIF
61     
62      IF( kt == nitrst - ndttrc .OR. nitend - nit000 + 1 < 2 * ndttrc ) THEN
63         ! beware if model runs less than 2*ndttrc time step
64         ! beware of the format used to write kt (default is i8.8, that should be large enough)
65         IF( nitrst > 1.0e9 ) THEN   
66            WRITE(clkt,*) nitrst
67         ELSE
68            WRITE(clkt,'(i8.8)') nitrst
69         ENDIF
70         ! create the file
71         IF(lwp) WRITE(numout,*)
72         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_restart_trc"
73         IF(lwp) WRITE(numout,*) '             open trc restart.output NetCDF file: '//clname
74         CALL iom_open( clname, numrtw, ldwrt = .TRUE., kiolib = jprstlib )
75         lrst_trc = .TRUE.
76      ENDIF
77      !
78   END SUBROUTINE trc_rst_opn
79
80
81   SUBROUTINE trc_rst_read 
82      !!===========================================================================================
83      !!
84      !!                       ROUTINE trc_rst_read
85      !!                       *******************
86      !!
87      !!  PURPOSE :
88      !!  ---------
89      !!     READ files for restart for passive tracer
90      !!
91      !!   METHOD :
92      !!   -------
93      !!      READ the previous fields on the FILE nutrst
94      !!      the first record indicates previous characterics
95      !!      after control with the present run, we READ :
96      !!      - prognostic variables on the second and more record
97      !!
98      !!   History:
99      !!   --------
100      !!  original  : 96-11
101      !!  00-05 (A. Estublier) TVD Limiter Scheme key_trc_tvd
102      !!  00-12 (O. Aumont, E. Kestenare) read restart file for sediments
103      !!  01-05 (O. Aumont, E. Kestenare) read restart file for calcite and silicate sediments
104      !!  05-03 (O. Aumont and A. El Moussaoui) F90           
105      !!------------------------------------------------------------------------
106      INTEGER ::  ji, jj, jk, jn 
107      INTEGER ::  iarak0   
108      REAL(wp) :: zkt, zarak0
109      REAL(wp) :: caralk, bicarb, co3
110
111#if defined key_trc_pisces 
112#   if ! defined key_cfg_1d && ( defined key_orca_r4 || defined key_orca_r2 || defined key_orca_r05 || defined key_orca_r025 )
113      REAL(wp) ::  ztrasum
114#   endif
115#endif
116
117      !!---------------------------------------------------------------------
118      !!  OPA.9 03-2005 
119      !!---------------------------------------------------------------------
120      !! 0. initialisations
121      !!------------------
122
123
124      IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN
125         iarak0 = 1
126      ELSE
127         iarak0 = 0
128      ENDIF
129
130
131      IF(lwp) WRITE(numout,*) ' '
132      IF(lwp) WRITE(numout,*) ' *** trc_rst beginning of restart for'
133      IF(lwp) WRITE(numout,*) ' passive tracer'
134      IF(lwp) WRITE(numout,*) ' the present run :'
135      IF(lwp) WRITE(numout,*) '   with the time nit000 : ',nit000
136      IF(lwp) THEN
137         IF( iarak0 == 1 ) THEN
138            WRITE(numout,*) '   and before fields for Arakawa sheme '
139         ENDIF
140         WRITE(numout,*) ' '
141      ENDIF
142
143      ! Time domain : restart
144      ! -------------------------
145
146      IF(lwp) WRITE(numout,*)
147      IF(lwp) WRITE(numout,*)
148      IF(lwp) WRITE(numout,*) ' *** passive tracer restart option'
149      SELECT CASE ( nrsttr )
150      CASE ( 0 )
151         IF(lwp) WRITE(numout,*) ' nrsttr = 0 no control of nit000'
152      CASE ( 1 )
153         IF(lwp) WRITE(numout,*) ' nrsttr = 1 we control the date of nit000'
154      CASE ( 2 )
155         IF(lwp) WRITE(numout,*) ' nrsttr = 2 the date adatrj is read in restart file'
156      CASE DEFAULT
157         IF(lwp) WRITE(numout,*) '  ===>>>> nrsttr not equal 0, 1 or 2 : no control of the date'
158         IF(lwp) WRITE(numout,*) ' =======                   ========='
159      END SELECT
160
161      CALL iom_open ( 'restart.trc', numrtr, kiolib = jprstlib )
162
163      CALL iom_get( numrtr, 'kt'   , zkt    )
164      CALL iom_get( numrtr, 'arak0', zarak0 )
165
166      IF(lwp) WRITE(numout,*)
167      IF(lwp) WRITE(numout,*) ' Info on the restart file read : '
168      IF(lwp) WRITE(numout,*) '   time-step           : ', NINT( zkt    )
169      IF(lwp) WRITE(numout,*) '   arakawa option      : ', NINT( zarak0 )
170      IF(lwp) WRITE(numout,*)
171
172
173      !! control of date
174      !! -------------------
175
176      IF( nittrc000 - NINT( zkt ) /= 1 .AND. nrsttr /= 0 )  &
177           & CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart', &
178           & ' verify the restart file or rerun with nrstdt = 0 (namelist)' )
179
180      !! Control of the scheme
181      !! ------------------------
182
183      IF( iarak0 /= NINT( zarak0 ) ) &
184           & CALL ctl_stop( ' ===>>>> : problem with advection scheme', &
185           & ' it must be the same type for both restart and previous run', &
186           & ' centered or euler '  )
187
188
189      !! ... READ prognostic variables and computes diagnostic variable
190      !! ---------------------------------------------------------------
191
192      DO jn = 1, jptra
193         CALL iom_get( numrtr, jpdom_local, 'TRN'//ctrcnm(jn), trn(:,:,:,jn)   ) 
194      END DO
195
196      DO jn = 1, jptra
197         CALL iom_get( numrtr, jpdom_local, 'TRB'//ctrcnm(jn), trb(:,:,:,jn)   ) 
198      END DO
199
200#if defined key_trc_lobster1
201      CALL iom_get( numrtr, jpdom_local, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) ) 
202      CALL iom_get( numrtr, jpdom_local, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) ) 
203
204#elif defined key_trc_pisces
205      CALL iom_get( numrtr, jpdom_local, 'Silicalim', xksi(:,:) ) 
206      xksimax = xksi
207
208#elif defined key_cfc
209      DO jn = 1, jptra
210         CALL iom_get( numrtr, jpdom_local, 'qint'//ctrcnm(jn),qint(:,:,jn)) 
211      END DO
212      DO jn = 1, jptra
213         CALL iom_get( numrtr, jpdom_local, 'qtr'//ctrcnm(jn) ,qtr( :,:,jn)) 
214      END DO
215#endif
216
217
218#if defined key_trc_pisces 
219
220#if ! defined key_cfg_1d && ( defined key_orca_r4 || defined key_orca_r2 || defined key_orca_r05 || defined key_orca_r025 )
221
222      ztrasum = 0.
223      DO jk = 1, jpk
224         DO jj = 1, jpj
225            DO ji = 1, jpi
226               ztrasum = ztrasum + trn(ji,jj,jk,jptal) * tmask(ji,jj,jk) * tmask_i(ji,jj)  &
227#if defined key_off_degrad
228                  &              * facvol(ji,jj,jk)   &
229#endif
230
231                  &              * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
232            END DO
233         END DO
234      END DO
235
236      IF( lk_mpp ) THEN
237         CALL mpp_sum( ztrasum )     ! sum over the global domain 
238      END IF
239
240      WRITE(0,*) 'TALK moyen ', ztrasum/areatot*1E6
241      ztrasum = ztrasum/areatot*1E6
242      trn(:,:,:,jptal) = trn(:,:,:,jptal)*2391./ztrasum
243
244      ztrasum = 0.
245      DO jk = 1, jpk
246         DO jj = 1, jpj
247            DO ji = 1, jpi
248               ztrasum = ztrasum + trn(ji,jj,jk,jppo4) * tmask(ji,jj,jk) * tmask_i(ji,jj)  &
249#if defined key_off_degrad
250                  &              * facvol(ji,jj,jk)   &
251#endif
252
253                  &              * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
254            END DO
255         END DO
256      END DO
257
258      IF( lk_mpp ) THEN
259         CALL mpp_sum( ztrasum )     ! sum over the global domain 
260      END IF
261
262
263      WRITE(0,*) 'PO4 moyen ', ztrasum/areatot*1E6/122.
264      ztrasum = ztrasum/areatot*1E6/122.
265      trn(:,:,:,jppo4) = trn(:,:,:,jppo4)*2.165/ztrasum
266
267      ztrasum = 0.
268      DO jk = 1, jpk
269         DO jj = 1, jpj
270            DO ji = 1, jpi
271               ztrasum = ztrasum + trn(ji,jj,jk,jpno3) * tmask(ji,jj,jk) * tmask_i(ji,jj)  &
272#if defined key_off_degrad
273                  &              * facvol(ji,jj,jk)   &
274#endif
275
276                  &              * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
277            END DO
278         END DO
279      END DO
280
281      IF( lk_mpp ) THEN
282         CALL mpp_sum( ztrasum )     ! sum over the global domain 
283      END IF
284
285
286      WRITE(0,*) 'NO3 moyen ', ztrasum/areatot*1E6/7.6
287      ztrasum = ztrasum/areatot*1E6/7.6
288      trn(:,:,:,jpno3) = trn(:,:,:,jpno3)*30.9/ztrasum
289
290      ztrasum = 0.
291      DO jk = 1, jpk
292         DO jj = 1, jpj
293            DO ji = 1, jpi
294               ztrasum = ztrasum + trn(ji,jj,jk,jpsil) * tmask(ji,jj,jk) * tmask_i(ji,jj)   &
295#if defined key_off_degrad
296                  &              * facvol(ji,jj,jk)   &
297#endif
298
299                  &              * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
300            END DO
301         END DO
302      END DO
303
304      IF( lk_mpp ) THEN
305         CALL mpp_sum( ztrasum )     ! sum over the global domain 
306      END IF
307
308      WRITE(0,*) 'SiO3 moyen ', ztrasum/areatot*1E6
309      ztrasum = ztrasum/areatot*1E6
310      trn(:,:,:,jpsil) = MIN( 400E-6,trn(:,:,:,jpsil)*91.51/ztrasum) 
311
312#endif
313
314!#if defined key_trc_kriest
315!      !! Initialize number of particles from a standart restart file
316!      !! The name of big organic particles jpgoc has been only change
317!      !! and replace by jpnum but the values here are concentration
318!      trn(:,:,:,jppoc) = trn(:,:,:,jppoc) + trn(:,:,:,jpnum)
319!      trn(:,:,:,jpnum) = trn(:,:,:,jppoc) / ( 6. * xkr_massp )
320!#endif
321      !!  Initialization of chemical variables of the carbon cycle
322      !!  --------------------------------------------------------
323      DO jk = 1,jpk
324         DO jj = 1,jpj
325            DO ji = 1,jpi
326               caralk = trn(ji,jj,jk,jptal)-       &
327                  &        borat(ji,jj,jk)/(1.+1.E-8/(rtrn+akb3(ji,jj,jk)))
328               co3 = (caralk-trn(ji,jj,jk,jpdic))*tmask(ji,jj,jk)   &
329                  &        +(1.-tmask(ji,jj,jk))*.5e-3
330               bicarb = (2.*trn(ji,jj,jk,jpdic)-caralk)
331               hi(ji,jj,jk) = (ak23(ji,jj,jk)*bicarb/co3)     &
332                  &  *tmask(ji,jj,jk)+(1.-tmask(ji,jj,jk))*1.e-9
333            ENDDO
334         ENDDO
335      ENDDO
336#endif
337      trb(:,:,:,:) = trn(:,:,:,:)
338
339      CALL iom_close( numrtr )
340
341
342   END SUBROUTINE trc_rst_read
343
344   SUBROUTINE trc_rst_wri(kt)
345      !! ==================================================================================
346      !!
347      !!                       ROUTINE trc_rst_wri
348      !!                       ******************
349      !!
350      !!  PURPOSE :
351      !!  ---------
352      !!     WRITE restart fields in nutwrs
353      !!   METHOD :
354      !!   -------
355      !!
356      !!   nutwrs FILE:
357      !!   each nstock time step , SAVE fields which are necessary for
358      !!   passive tracer restart
359      !!
360      !!
361      !!   INPUT :
362      !!   -----
363      !!      argument
364      !!              kt              : time step
365      !!      COMMON
366      !!            /cottrc/          : passive tracers fields (before,now
367      !!                                  ,after)
368      !!
369      !!   OUTPUT :
370      !!   ------
371      !!      FILE
372      !!           nutwrs          : standard restart fields OUTPUT
373      !!
374      !!   WORKSPACE :
375      !!   ---------
376      !!      ji,jj,jk,jn
377      !!
378      !!   History:
379      !!   --------
380      !!      original : 96-12
381      !!      addition : 99-12 (M.-A. Foujols) NetCDF FORMAT with ioipsl
382      !!      additions : 00-05 (A. Estublier)
383      !!                  TVD Limiter Scheme : key_trc_tvd
384      !!      additions : 01-01 (M.A Foujols, E. Kestenare) bug fix: restclo
385      !!      additions : 01-01 (O. Aumont, E. Kestenare)
386      !!                  write restart file for sediments
387      !!      additions : 01-05 (O. Aumont, E. Kestenare)
388      !!                  write restart file for calcite and silicate sediments
389      !!   05-03 (O. Aumont and A. El Moussaoui) F90
390      !!========================================================================================!
391
392      !! * Arguments
393      !! -----------
394      INTEGER, INTENT( in ) :: kt
395
396      !! * local declarations
397      !! ====================
398
399      INTEGER  :: ji,jj,jk,jn
400      REAL(wp) :: zdiag_var, zdiag_varmin, zdiag_varmax, zdiag_tot
401      REAL(wp) :: zder
402
403
404      !! 1. OUTPUT of restart fields (nutwrs)
405      !! ---------------------------
406
407      IF( MOD(kt,nstock) == 0 .OR. kt == nitend ) THEN
408
409         !! 0. initialisations
410         !! ------------------
411
412         IF(lwp) WRITE(numout,*) ' '
413         IF(lwp) WRITE(numout,*) 'trc_wri : write the passive tracer restart file in NetCDF format ',   &
414            'at it= ',kt,' date= ',ndastp
415         IF(lwp) WRITE(numout,*) '~~~~~~~~~'
416
417
418         CALL iom_rstput( kt, nitrst, numrtw, 'kt'   ,  REAL( kt, wp )  )
419
420         IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN
421            CALL iom_rstput( kt, nitrst, numrtw, 'arak0', 1. )
422         ELSE
423            CALL iom_rstput( kt, nitrst, numrtw, 'arak0', 0. )
424         ENDIF
425
426
427         ! prognostic variables
428         ! --------------------
429
430         DO jn=1,jptra
431            CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )
432         ENDDO
433
434         DO jn=1,jptra
435            CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
436         END DO
437
438#if defined key_trc_lobster1
439         CALL iom_rstput( kt, nitrst, numrtw, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) )
440         CALL iom_rstput( kt, nitrst, numrtw, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) )
441#elif defined key_trc_pisces
442         CALL iom_rstput( kt, nitrst, numrtw, 'Silicalim', xksi(:,:) )
443
444#elif defined key_cfc
445         DO jn=1,jptra
446            CALL iom_rstput( kt, nitrst, numrtw, 'qint'//ctrcnm(jn), qint(:,:,jn) )
447         END DO
448         DO jn=1,jptra
449            CALL iom_rstput( kt, nitrst, numrtw, 'qtr'//ctrcnm(jn) , qtr( :,:,jn) )
450         END DO
451#endif
452
453         IF (lwp) WRITE(numout,*) '----TRACER STAT----'
454
455         zdiag_tot=0.
456         DO jn=1,jptra
457            zdiag_var=0.
458            zdiag_varmin=0.
459            zdiag_varmax=0.
460
461            DO ji=1, jpi
462               DO jj=1, jpj
463                  DO jk=1,jpk
464                     zdiag_var=zdiag_var+trn(ji,jj,jk,jn)*tmask(ji,jj,jk)*tmask_i(ji,jj)  &
465#if defined key_off_degrad
466                        &   * facvol(ji,jj,jk)   &
467#endif
468                        &   * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
469
470                  END DO
471               END DO
472            END DO
473
474            zdiag_varmin=MINVAL(trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)))
475            zdiag_varmax=MAXVAL(trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)))
476
477            IF( lk_mpp ) THEN
478               CALL mpp_min(zdiag_varmin)      ! min over the global domain
479               CALL mpp_max(zdiag_varmax)      ! max over the global domain
480               CALL mpp_sum(zdiag_var)         ! sum over the global domain
481            END IF
482
483            zdiag_tot=zdiag_tot+zdiag_var
484            zdiag_var=zdiag_var/areatot
485
486            IF (lwp) WRITE(numout,*) 'MEAN NO ',jn,ctrcnm(jn),' =',zdiag_var,'MIN= '  &
487               ,zdiag_varmin,'MAX= ',zdiag_varmax
488
489         END DO
490
491         zdiag_tot=zdiag_tot
492         zder=((zdiag_tot-trai)/trai)*100._wp
493         IF (lwp) WRITE(numout,*) 'Integral of all tracers over the full domain  =',zdiag_tot
494         IF (lwp) WRITE(numout,*) 'Drift of the sum of all tracers =',zder, '%'
495
496         CALL iom_close(numrtw)
497
498      ENDIF
499
500   END SUBROUTINE trc_rst_wri
501
502
503#else
504   !!======================================================================
505   !!  Empty module : No passive tracer
506   !!======================================================================
507CONTAINS
508
509   SUBROUTINE trc_rst_read
510      !! no passive tracers
511   END SUBROUTINE trc_rst_read
512
513   SUBROUTINE trc_rst_wri(kt)
514      !! no passive tracers
515      INTEGER, INTENT ( in ) :: kt
516      WRITE(*,*) 'trc_rst_wri: You should not have seen this print! error?', kt
517   END SUBROUTINE trc_rst_wri
518   
519#endif
520   
521END MODULE trcrst
Note: See TracBrowser for help on using the repository browser.