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

Last change on this file since 729 was 719, checked in by ctlod, 17 years ago

get back to the nemo_v2_3 version for trunk
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 17.5 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$
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      CALL iom_get( numrtr, jpdom_local, 'SED'//ctrcnm(jppoc), sedpoc(:,:) ) 
209      CALL iom_get( numrtr, jpdom_local, 'SED'//ctrcnm(jpcal), sedcal(:,:) ) 
210      CALL iom_get( numrtr, jpdom_local, 'SED'//ctrcnm(jpsil), sedsil(:,:) ) 
211
212#elif defined key_cfc
213      DO jn = 1, jptra
214         CALL iom_get( numrtr, jpdom_local, 'qint'//ctrcnm(jn),qint(:,:,jn)) 
215      END DO
216      DO jn = 1, jptra
217         CALL iom_get( numrtr, jpdom_local, 'qtr'//ctrcnm(jn) ,qtr( :,:,jn)) 
218      END DO
219#endif
220
221
222#if defined key_trc_pisces 
223
224#if ! defined key_cfg_1d && ( defined key_orca_r4 || defined key_orca_r2 || defined key_orca_r05 || defined key_orca_r025 )
225
226      ztrasum = 0.
227      DO jk = 1, jpk
228         DO jj = 1, jpj
229            DO ji = 1, jpi
230               ztrasum = ztrasum + trn(ji,jj,jk,jptal) * tmask(ji,jj,jk) * tmask_i(ji,jj)  &
231#if defined key_off_degrad
232                  &              * facvol(ji,jj,jk)   &
233#endif
234
235                  &              * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
236            END DO
237         END DO
238      END DO
239
240      IF( lk_mpp ) THEN
241         CALL mpp_sum( ztrasum )     ! sum over the global domain 
242      END IF
243
244      WRITE(0,*) 'TALK moyen ', ztrasum/areatot*1E6
245      ztrasum = ztrasum/areatot*1E6
246      trn(:,:,:,jptal) = trn(:,:,:,jptal)*2391./ztrasum
247
248      ztrasum = 0.
249      DO jk = 1, jpk
250         DO jj = 1, jpj
251            DO ji = 1, jpi
252               ztrasum = ztrasum + trn(ji,jj,jk,jppo4) * tmask(ji,jj,jk) * tmask_i(ji,jj)  &
253#if defined key_off_degrad
254                  &              * facvol(ji,jj,jk)   &
255#endif
256
257                  &              * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
258            END DO
259         END DO
260      END DO
261
262      IF( lk_mpp ) THEN
263         CALL mpp_sum( ztrasum )     ! sum over the global domain 
264      END IF
265
266
267      WRITE(0,*) 'PO4 moyen ', ztrasum/areatot*1E6/122.
268      ztrasum = ztrasum/areatot*1E6/122.
269      trn(:,:,:,jppo4) = trn(:,:,:,jppo4)*2.165/ztrasum
270
271      ztrasum = 0.
272      DO jk = 1, jpk
273         DO jj = 1, jpj
274            DO ji = 1, jpi
275               ztrasum = ztrasum + trn(ji,jj,jk,jpno3) * tmask(ji,jj,jk) * tmask_i(ji,jj)  &
276#if defined key_off_degrad
277                  &              * facvol(ji,jj,jk)   &
278#endif
279
280                  &              * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
281            END DO
282         END DO
283      END DO
284
285      IF( lk_mpp ) THEN
286         CALL mpp_sum( ztrasum )     ! sum over the global domain 
287      END IF
288
289
290      WRITE(0,*) 'NO3 moyen ', ztrasum/areatot*1E6/7.6
291      ztrasum = ztrasum/areatot*1E6/7.6
292      trn(:,:,:,jpno3) = trn(:,:,:,jpno3)*30.9/ztrasum
293
294      ztrasum = 0.
295      DO jk = 1, jpk
296         DO jj = 1, jpj
297            DO ji = 1, jpi
298               ztrasum = ztrasum + trn(ji,jj,jk,jpsil) * tmask(ji,jj,jk) * tmask_i(ji,jj)   &
299#if defined key_off_degrad
300                  &              * facvol(ji,jj,jk)   &
301#endif
302
303                  &              * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
304            END DO
305         END DO
306      END DO
307
308      IF( lk_mpp ) THEN
309         CALL mpp_sum( ztrasum )     ! sum over the global domain 
310      END IF
311
312      WRITE(0,*) 'SiO3 moyen ', ztrasum/areatot*1E6
313      ztrasum = ztrasum/areatot*1E6
314      trn(:,:,:,jpsil) = MIN( 400E-6,trn(:,:,:,jpsil)*91.51/ztrasum) 
315
316#endif
317
318!#if defined key_trc_kriest
319!      !! Initialize number of particles from a standart restart file
320!      !! The name of big organic particles jpgoc has been only change
321!      !! and replace by jpnum but the values here are concentration
322!      trn(:,:,:,jppoc) = trn(:,:,:,jppoc) + trn(:,:,:,jpnum)
323!      trn(:,:,:,jpnum) = trn(:,:,:,jppoc) / ( 6. * xkr_massp )
324!#endif
325      !!  Initialization of chemical variables of the carbon cycle
326      !!  --------------------------------------------------------
327      DO jk = 1,jpk
328         DO jj = 1,jpj
329            DO ji = 1,jpi
330               caralk = trn(ji,jj,jk,jptal)-       &
331                  &        borat(ji,jj,jk)/(1.+1.E-8/(rtrn+akb3(ji,jj,jk)))
332               co3 = (caralk-trn(ji,jj,jk,jpdic))*tmask(ji,jj,jk)   &
333                  &        +(1.-tmask(ji,jj,jk))*.5e-3
334               bicarb = (2.*trn(ji,jj,jk,jpdic)-caralk)
335               hi(ji,jj,jk) = (ak23(ji,jj,jk)*bicarb/co3)     &
336                  &  *tmask(ji,jj,jk)+(1.-tmask(ji,jj,jk))*1.e-9
337            ENDDO
338         ENDDO
339      ENDDO
340#endif
341      trb(:,:,:,:) = trn(:,:,:,:)
342
343      CALL iom_close( numrtr )
344
345
346   END SUBROUTINE trc_rst_read
347
348   SUBROUTINE trc_rst_wri(kt)
349      !! ==================================================================================
350      !!
351      !!                       ROUTINE trc_rst_wri
352      !!                       ******************
353      !!
354      !!  PURPOSE :
355      !!  ---------
356      !!     WRITE restart fields in nutwrs
357      !!   METHOD :
358      !!   -------
359      !!
360      !!   nutwrs FILE:
361      !!   each nstock time step , SAVE fields which are necessary for
362      !!   passive tracer restart
363      !!
364      !!
365      !!   INPUT :
366      !!   -----
367      !!      argument
368      !!              kt              : time step
369      !!      COMMON
370      !!            /cottrc/          : passive tracers fields (before,now
371      !!                                  ,after)
372      !!
373      !!   OUTPUT :
374      !!   ------
375      !!      FILE
376      !!           nutwrs          : standard restart fields OUTPUT
377      !!
378      !!   WORKSPACE :
379      !!   ---------
380      !!      ji,jj,jk,jn
381      !!
382      !!   History:
383      !!   --------
384      !!      original : 96-12
385      !!      addition : 99-12 (M.-A. Foujols) NetCDF FORMAT with ioipsl
386      !!      additions : 00-05 (A. Estublier)
387      !!                  TVD Limiter Scheme : key_trc_tvd
388      !!      additions : 01-01 (M.A Foujols, E. Kestenare) bug fix: restclo
389      !!      additions : 01-01 (O. Aumont, E. Kestenare)
390      !!                  write restart file for sediments
391      !!      additions : 01-05 (O. Aumont, E. Kestenare)
392      !!                  write restart file for calcite and silicate sediments
393      !!   05-03 (O. Aumont and A. El Moussaoui) F90
394      !!========================================================================================!
395
396      !! * Arguments
397      !! -----------
398      INTEGER, INTENT( in ) :: kt
399
400      !! * local declarations
401      !! ====================
402
403      INTEGER  :: ji,jj,jk,jn
404      REAL(wp) :: zdiag_var, zdiag_varmin, zdiag_varmax, zdiag_tot
405      REAL(wp) :: zder
406
407
408      !! 1. OUTPUT of restart fields (nutwrs)
409      !! ---------------------------
410
411      IF( MOD(kt,nstock) == 0 .OR. kt == nitend ) THEN
412
413         !! 0. initialisations
414         !! ------------------
415
416         IF(lwp) WRITE(numout,*) ' '
417         IF(lwp) WRITE(numout,*) 'trc_wri : write the passive tracer restart file in NetCDF format ',   &
418            'at it= ',kt,' date= ',ndastp
419         IF(lwp) WRITE(numout,*) '~~~~~~~~~'
420
421
422         CALL iom_rstput( kt, nitrst, numrtw, 'kt'   ,  REAL( kt, wp )  )
423
424         IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN
425            CALL iom_rstput( kt, nitrst, numrtw, 'arak0', 1. )
426         ELSE
427            CALL iom_rstput( kt, nitrst, numrtw, 'arak0', 0. )
428         ENDIF
429
430
431         ! prognostic variables
432         ! --------------------
433
434         DO jn=1,jptra
435            CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )
436         ENDDO
437
438         DO jn=1,jptra
439            CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
440         END DO
441
442#if defined key_trc_lobster1
443         CALL iom_rstput( kt, nitrst, numrtw, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) )
444         CALL iom_rstput( kt, nitrst, numrtw, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) )
445#elif defined key_trc_pisces
446         CALL iom_rstput( kt, nitrst, numrtw, 'Silicalim', xksi(:,:) )
447
448         CALL iom_rstput( kt, nitrst, numrtw, 'SED'//ctrcnm(jppoc), sedpoc(:,:) )
449         CALL iom_rstput( kt, nitrst, numrtw, 'SED'//ctrcnm(jpcal), sedcal(:,:) )
450         CALL iom_rstput( kt, nitrst, numrtw, 'SED'//ctrcnm(jpsil), sedsil(:,:) )
451         
452#elif defined key_cfc
453         DO jn=1,jptra
454            CALL iom_rstput( kt, nitrst, numrtw, 'qint'//ctrcnm(jn), qint(:,:,jn) )
455         END DO
456         DO jn=1,jptra
457            CALL iom_rstput( kt, nitrst, numrtw, 'qtr'//ctrcnm(jn) , qtr( :,:,jn) )
458         END DO
459#endif
460
461         IF (lwp) WRITE(numout,*) '----TRACER STAT----'
462
463         zdiag_tot=0.
464         DO jn=1,jptra
465            zdiag_var=0.
466            zdiag_varmin=0.
467            zdiag_varmax=0.
468
469            DO ji=1, jpi
470               DO jj=1, jpj
471                  DO jk=1,jpk
472                     zdiag_var=zdiag_var+trn(ji,jj,jk,jn)*tmask(ji,jj,jk)*tmask_i(ji,jj)  &
473#if defined key_off_degrad
474                        &   * facvol(ji,jj,jk)   &
475#endif
476                        &   * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
477
478                  END DO
479               END DO
480            END DO
481
482            zdiag_varmin=MINVAL(trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)))
483            zdiag_varmax=MAXVAL(trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)))
484
485            IF( lk_mpp ) THEN
486               CALL mpp_min(zdiag_varmin)      ! min over the global domain
487               CALL mpp_max(zdiag_varmax)      ! max over the global domain
488               CALL mpp_sum(zdiag_var)         ! sum over the global domain
489            END IF
490
491            zdiag_tot=zdiag_tot+zdiag_var
492            zdiag_var=zdiag_var/areatot
493
494            IF (lwp) WRITE(numout,*) 'MEAN NO ',jn,ctrcnm(jn),' =',zdiag_var,'MIN= '  &
495               ,zdiag_varmin,'MAX= ',zdiag_varmax
496
497         END DO
498
499         zdiag_tot=zdiag_tot
500         zder=((zdiag_tot-trai)/trai)*100._wp
501         IF (lwp) WRITE(numout,*) 'Integral of all tracers over the full domain  =',zdiag_tot
502         IF (lwp) WRITE(numout,*) 'Drift of the sum of all tracers =',zder, '%'
503
504         CALL iom_close(numrtw)
505
506      ENDIF
507
508   END SUBROUTINE trc_rst_wri
509
510
511#else
512   !!======================================================================
513   !!  Empty module : No passive tracer
514   !!======================================================================
515CONTAINS
516
517   SUBROUTINE trc_rst_read
518      !! no passive tracers
519   END SUBROUTINE trc_rst_read
520
521   SUBROUTINE trc_rst_wri(kt)
522      !! no passive tracers
523      INTEGER, INTENT ( in ) :: kt
524      WRITE(*,*) 'trc_rst_wri: You should not have seen this print! error?', kt
525   END SUBROUTINE trc_rst_wri
526   
527#endif
528   
529END MODULE trcrst
Note: See TracBrowser for help on using the repository browser.