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/NEMOGCM/NEMO/TOP_SRC – NEMO

source: trunk/NEMOGCM/NEMO/TOP_SRC/trcrst.F90 @ 2761

Last change on this file since 2761 was 2715, checked in by rblod, 13 years ago

First attempt to put dynamic allocation on the trunk

  • Property svn:keywords set to Id
File size: 15.4 KB
RevLine 
[268]1MODULE trcrst
[335]2   !!======================================================================
[1801]3   !!                         ***  MODULE trcrst  ***
4   !! TOP :   Manage the passive tracer restart
[335]5   !!======================================================================
[1801]6   !! History :    -   !  1991-03  ()  original code
7   !!             1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90
8   !!              -   !  2005-10 (C. Ethe) print control
9   !!             2.0  !  2005-10 (C. Ethe, G. Madec) revised architecture
[274]10   !!----------------------------------------------------------------------
[945]11#if defined key_top
[335]12   !!----------------------------------------------------------------------
[945]13   !!   'key_top'                                                TOP models
14   !!----------------------------------------------------------------------
[1801]15   !!----------------------------------------------------------------------
16   !!   trc_rst :   Restart for passive tracer
17   !!----------------------------------------------------------------------
18   !!----------------------------------------------------------------------
19   !!   'key_top'                                                TOP models
20   !!----------------------------------------------------------------------
[945]21   !!   trc_rst_opn    : open  restart file
22   !!   trc_rst_read   : read  restart file
23   !!   trc_rst_wri    : write restart file
24   !!----------------------------------------------------------------------
[335]25   USE oce_trc
26   USE trc
[2528]27   USE trcnam_trp
[616]28   USE iom
[1801]29   USE trcrst_cfc      ! CFC     
30   USE trcrst_lobster  ! LOBSTER  restart
31   USE trcrst_pisces   ! PISCES   restart
32   USE trcrst_c14b     ! C14 bomb restart
33   USE trcrst_my_trc   ! MY_TRC   restart
[2528]34   USE daymod
[335]35   IMPLICIT NONE
36   PRIVATE
[1801]37
[945]38   PUBLIC   trc_rst_opn       ! called by ???
39   PUBLIC   trc_rst_read      ! called by ???
40   PUBLIC   trc_rst_wri       ! called by ???
[1801]41
[616]42   INTEGER, PUBLIC ::   numrtr, numrtw   !: logical unit for trc restart (read and write)
[350]43
44   !! * Substitutions
[945]45#  include "top_substitute.h90"
[335]46   
[268]47CONTAINS
[335]48   
[616]49   SUBROUTINE trc_rst_opn( kt )
50      !!----------------------------------------------------------------------
51      !!                    ***  trc_rst_opn  ***
52      !!
53      !! ** purpose  :   output of sea-trc variable in a netcdf file
54      !!----------------------------------------------------------------------
55      INTEGER, INTENT(in) ::   kt       ! number of iteration
56      !
57      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character
58      CHARACTER(LEN=50)   ::   clname   ! trc output restart file name
59      !!----------------------------------------------------------------------
60      !
[2528]61      IF( lk_offline ) THEN
62         IF( kt == nit000 ) THEN
63            lrst_trc = .FALSE.
64            nitrst = nitend
65         ENDIF
66
67         IF( MOD( kt - 1, nstock ) == 0 ) THEN
68            ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment
69            nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing
70            IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run
71         ENDIF
72      ELSE
73         IF( kt == nit000 ) lrst_trc = .FALSE.
[1655]74      ENDIF
75
[2528]76      ! to get better performances with NetCDF format:
77      ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*nn_dttrc + 1)
78      ! 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
79      IF( kt == nitrst - 2*nn_dttrc + 1 .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc + 1 .AND. .NOT. lrst_trc ) ) THEN
[616]80         ! beware of the format used to write kt (default is i8.8, that should be large enough)
[945]81         IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst
82         ELSE                        ;   WRITE(clkt,'(i8.8)') nitrst
[616]83         ENDIF
84         ! create the file
85         IF(lwp) WRITE(numout,*)
[1254]86         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trcrst_out)
[616]87         IF(lwp) WRITE(numout,*) '             open trc restart.output NetCDF file: '//clname
88         CALL iom_open( clname, numrtw, ldwrt = .TRUE., kiolib = jprstlib )
89         lrst_trc = .TRUE.
90      ENDIF
91      !
92   END SUBROUTINE trc_rst_opn
93
[1801]94   SUBROUTINE trc_rst_read
[945]95      !!----------------------------------------------------------------------
96      !!                    ***  trc_rst_opn  ***
[335]97      !!
[945]98      !! ** purpose  :   read passive tracer fields in restart files
99      !!----------------------------------------------------------------------
[1801]100      INTEGER  ::  jn     
[1473]101      INTEGER  ::  jlibalt = jprstlib
102      LOGICAL  ::  llok
[1287]103
[945]104      !!----------------------------------------------------------------------
[268]105
[945]106      IF(lwp) WRITE(numout,*)
107      IF(lwp) WRITE(numout,*) 'trc_rst_read : read the TOP restart file'
108      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
[350]109
[1473]110      IF ( jprstlib == jprstdimg ) THEN
111        ! eventually read netcdf file (monobloc)  for restarting on different number of processors
[1801]112        ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90
[1473]113        INQUIRE( FILE = TRIM(cn_trcrst_in)//'.nc', EXIST = llok )
[1801]114        IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
[1473]115      ENDIF
[1287]116
[1801]117      CALL iom_open( cn_trcrst_in, numrtr, kiolib = jlibalt ) 
118
[1287]119      ! Time domain : restart
120      ! ---------------------
[2528]121      CALL trc_rst_cal( nit000, 'READ' )   ! calendar
[1287]122
[945]123      ! READ prognostic variables and computes diagnostic variable
[494]124      DO jn = 1, jptra
[1801]125         CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )
[335]126      END DO
[1077]127
[1287]128      DO jn = 1, jptra
[1801]129         CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
[1077]130      END DO
131
[1801]132      IF( lk_lobster )   CALL trc_rst_read_lobster( numrtr )      ! LOBSTER bio-model
133      IF( lk_pisces  )   CALL trc_rst_read_pisces ( numrtr )      ! PISCES  bio-model
134      IF( lk_cfc     )   CALL trc_rst_read_cfc    ( numrtr )      ! CFC     tracers
135      IF( lk_c14b    )   CALL trc_rst_read_c14b   ( numrtr )      ! C14 bomb  tracer
136      IF( lk_my_trc  )   CALL trc_rst_read_my_trc ( numrtr )      ! MY_TRC  tracers
137
[616]138      CALL iom_close( numrtr )
[945]139      !
140   END SUBROUTINE trc_rst_read
[494]141
[945]142   SUBROUTINE trc_rst_wri( kt )
143      !!----------------------------------------------------------------------
144      !!                    ***  trc_rst_wri  ***
[335]145      !!
[945]146      !! ** purpose  :   write passive tracer fields in restart files
147      !!----------------------------------------------------------------------
148      INTEGER, INTENT( in ) ::   kt    ! ocean time-step index
[335]149      !!
[1287]150      INTEGER  :: jn
151      REAL(wp) :: zarak0
[945]152      !!----------------------------------------------------------------------
[268]153
154
[1287]155      CALL trc_rst_cal( kt, 'WRITE' )   ! calendar
[2528]156      CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rdttrc(1) )   ! surface passive tracer time step
[1801]157      ! prognostic variables
158      ! --------------------
[1100]159      DO jn = 1, jptra
160         CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )
161      END DO
[1077]162
[1100]163      DO jn = 1, jptra
164         CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
165      END DO
[268]166
[1801]167      IF( lk_lobster )   CALL trc_rst_wri_lobster( kt, nitrst, numrtw )      ! LOBSTER bio-model
168      IF( lk_pisces  )   CALL trc_rst_wri_pisces ( kt, nitrst, numrtw )      ! PISCES  bio-model
169      IF( lk_cfc     )   CALL trc_rst_wri_cfc    ( kt, nitrst, numrtw )      ! CFC     tracers
170      IF( lk_c14b    )   CALL trc_rst_wri_c14b   ( kt, nitrst, numrtw )      ! C14 bomb  tracer
171      IF( lk_my_trc  )   CALL trc_rst_wri_my_trc ( kt, nitrst, numrtw )      ! MY_TRC  tracers
172
[1287]173      IF( kt == nitrst ) THEN
[1119]174          CALL trc_rst_stat            ! statistics
[1100]175          CALL iom_close( numrtw )     ! close the restart file (only at last time step)
[1177]176#if ! defined key_trdmld_trc
[1100]177          lrst_trc = .FALSE.
[1177]178#endif
[1287]179      ENDIF
[945]180      !
[1801]181   END SUBROUTINE trc_rst_wri 
[268]182
[1801]183
[1287]184   SUBROUTINE trc_rst_cal( kt, cdrw )
185      !!---------------------------------------------------------------------
186      !!                   ***  ROUTINE trc_rst_cal  ***
187      !!
188      !!  ** Purpose : Read or write calendar in restart file:
189      !!
190      !!  WRITE(READ) mode:
191      !!       kt        : number of time step since the begining of the experiment at the
192      !!                   end of the current(previous) run
193      !!       adatrj(0) : number of elapsed days since the begining of the experiment at the
194      !!                   end of the current(previous) run (REAL -> keep fractions of day)
195      !!       ndastp    : date at the end of the current(previous) run (coded as yyyymmdd integer)
196      !!
197      !!   According to namelist parameter nrstdt,
[2528]198      !!       nn_rsttr = 0  no control on the date (nit000 is  arbitrary).
199      !!       nn_rsttr = 1  we verify that nit000 is equal to the last
[1287]200      !!                   time step of previous run + 1.
201      !!       In both those options, the  exact duration of the experiment
202      !!       since the beginning (cumulated duration of all previous restart runs)
203      !!       is not stored in the restart and is assumed to be (nit000-1)*rdt.
204      !!       This is valid is the time step has remained constant.
205      !!
[2528]206      !!       nn_rsttr = 2  the duration of the experiment in days (adatrj)
[1287]207      !!                    has been stored in the restart file.
208      !!----------------------------------------------------------------------
209      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
210      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
211      !
[2528]212      REAL(wp) ::  zkt, zrdttrc1
[1287]213      REAL(wp) ::  zndastp
214
215      ! Time domain : restart
216      ! ---------------------
217
218      IF( TRIM(cdrw) == 'READ' ) THEN
219         CALL iom_get ( numrtr, 'kt', zkt )   ! last time-step of previous run
220         IF(lwp) THEN
221            WRITE(numout,*) ' *** Info read in restart : '
222            WRITE(numout,*) '   previous time-step                               : ', NINT( zkt )
223            WRITE(numout,*) ' *** restart option'
[2528]224            SELECT CASE ( nn_rsttr )
225            CASE ( 0 )   ;   WRITE(numout,*) ' nn_rsttr = 0 : no control of nit000'
226            CASE ( 1 )   ;   WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nit000 (use ndate0 read in the namelist)'
227            CASE ( 2 )   ;   WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart'
[1287]228            END SELECT
229            WRITE(numout,*)
230         ENDIF
231         ! Control of date
[2528]232         IF( nit000  - NINT( zkt ) /= 1 .AND.  nn_rsttr /= 0 )                                  &
[1287]233            &   CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart',                 &
[2528]234            &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' )
235         IF( lk_offline ) THEN      ! set the date in offline mode
236            ! Check dynamics and tracer time-step consistency and force Euler restart if changed
237            IF( iom_varid( numrtr, 'rdttrc1', ldstop = .FALSE. ) > 0 )   THEN
238               CALL iom_get( numrtr, 'rdttrc1', zrdttrc1 )
239               IF( zrdttrc1 /= rdttrc(1) )   neuler = 0
240            ENDIF
241            !                          ! define ndastp and adatrj
242            IF ( nn_rsttr == 2 ) THEN
243               CALL iom_get( numrtr, 'ndastp', zndastp ) 
244               ndastp = NINT( zndastp )
245               CALL iom_get( numrtr, 'adatrj', adatrj  )
246            ELSE
247               ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam
248               adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
249               ! note this is wrong if time step has changed during run
250            ENDIF
251            !
252            IF(lwp) THEN
253              WRITE(numout,*) ' *** Info used values : '
254              WRITE(numout,*) '   date ndastp                                      : ', ndastp
255              WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj
256              WRITE(numout,*)
257            ENDIF
258            !
259            CALL day_init          ! compute calendar
260            !
[1287]261         ENDIF
262         !
263      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
264         !
265         IF(  kt == nitrst ) THEN
266            IF(lwp) WRITE(numout,*)
267            IF(lwp) WRITE(numout,*) 'trc_wri : write the TOP restart file (NetCDF) at it= ', kt, ' date= ', ndastp
268            IF(lwp) WRITE(numout,*) '~~~~~~~'
269         ENDIF
270         CALL iom_rstput( kt, nitrst, numrtw, 'kt'     , REAL( kt    , wp) )   ! time-step
271         CALL iom_rstput( kt, nitrst, numrtw, 'ndastp' , REAL( ndastp, wp) )   ! date
272         CALL iom_rstput( kt, nitrst, numrtw, 'adatrj' , adatrj            )   ! number of elapsed days since
273         !                                                                     ! the begining of the run [s]
274      ENDIF
275
276   END SUBROUTINE trc_rst_cal
277
[1119]278
279   SUBROUTINE trc_rst_stat
280      !!----------------------------------------------------------------------
281      !!                    ***  trc_rst_stat  ***
282      !!
283      !! ** purpose  :   Compute tracers statistics
284      !!----------------------------------------------------------------------
285
[2528]286      INTEGER  :: jn
[1119]287      REAL(wp) :: zdiag_var, zdiag_varmin, zdiag_varmax, zdiag_tot
[2528]288      REAL(wp) :: zder
[1119]289      !!----------------------------------------------------------------------
290
291
292      IF( lwp ) THEN
293         WRITE(numout,*) 
294         WRITE(numout,*) '           ----TRACER STAT----             '
295         WRITE(numout,*) 
296      ENDIF
297     
298      zdiag_tot = 0.e0
299      DO jn = 1, jptra
[2528]300#  if defined key_degrad
301         zdiag_var = glob_sum( trn(:,:,:,jn) * cvol(:,:,:) * facvol(:,:,:) )
302#  else
303         zdiag_var = glob_sum( trn(:,:,:,jn) * cvol(:,:,:)  )
[1254]304#  endif
[1119]305         zdiag_varmin = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
306         zdiag_varmax = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
307         IF( lk_mpp ) THEN
308            CALL mpp_min( zdiag_varmin )      ! min over the global domain
309            CALL mpp_max( zdiag_varmax )      ! max over the global domain
310         END IF
311         zdiag_tot = zdiag_tot + zdiag_var
312         zdiag_var = zdiag_var / areatot
313         IF(lwp) WRITE(numout,*) '   MEAN NO ', jn, ctrcnm(jn), ' = ', zdiag_var,   &
314            &                    ' MIN = ', zdiag_varmin, ' MAX = ', zdiag_varmax
315      END DO
316     
317      zder = ( ( zdiag_tot - trai ) / ( trai + 1.e-12 )  ) * 100._wp
318      IF(lwp) WRITE(numout,*) '   Integral of all tracers over the full domain  = ', zdiag_tot
319      IF(lwp) WRITE(numout,*) '   Drift of the sum of all tracers =', zder, ' %'
320     
321   END SUBROUTINE trc_rst_stat
322
[268]323#else
[945]324   !!----------------------------------------------------------------------
325   !!  Dummy module :                                     No passive tracer
326   !!----------------------------------------------------------------------
[335]327CONTAINS
[945]328   SUBROUTINE trc_rst_read                      ! Empty routines
[616]329   END SUBROUTINE trc_rst_read
[945]330   SUBROUTINE trc_rst_wri( kt )
[335]331      INTEGER, INTENT ( in ) :: kt
[616]332      WRITE(*,*) 'trc_rst_wri: You should not have seen this print! error?', kt
[945]333   END SUBROUTINE trc_rst_wri   
[268]334#endif
[945]335
[2528]336   !!----------------------------------------------------------------------
337   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
338   !! $Id$
339   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[945]340   !!======================================================================
[335]341END MODULE trcrst
Note: See TracBrowser for help on using the repository browser.