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

source: branches/UKMO/AMM15_v3_6_STABLE_package_collate_spectral_optics/NEMOGCM/NEMO/TOP_SRC/trcrst.F90 @ 12448

Last change on this file since 12448 was 12448, checked in by dford, 4 years ago

Update to head of AMM15_v3_6_STABLE_package_collate (12437).
File size: 15.5 KB
Line 
1MODULE trcrst
2   !!======================================================================
3   !!                         ***  MODULE trcrst  ***
4   !! TOP :   Manage the passive tracer restart
5   !!======================================================================
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
10   !!----------------------------------------------------------------------
11#if defined key_top
12   !!----------------------------------------------------------------------
13   !!   'key_top'                                                TOP models
14   !!----------------------------------------------------------------------
15   !!----------------------------------------------------------------------
16   !!   trc_rst :   Restart for passive tracer
17   !!----------------------------------------------------------------------
18   !!----------------------------------------------------------------------
19   !!   'key_top'                                                TOP models
20   !!----------------------------------------------------------------------
21   !!   trc_rst_opn    : open  restart file
22   !!   trc_rst_read   : read  restart file
23   !!   trc_rst_wri    : write restart file
24   !!----------------------------------------------------------------------
25   USE oce_trc
26   USE dom_oce, ONLY: fjulday
27   USE phycst, ONLY: rday
28   USE in_out_manager, ONLY: ln_rstdate
29   USE trc
30   USE trcnam_trp
31   USE iom
32   USE ioipsl, ONLY: ju2ymds
33   USE daymod
34   ! +++>>> FABM
35   USE trcrst_fabm
36   ! FABM <<<+++
37   IMPLICIT NONE
38   PRIVATE
39
40   PUBLIC   trc_rst_opn       ! called by ???
41   PUBLIC   trc_rst_read      ! called by ???
42   PUBLIC   trc_rst_wri       ! called by ???
43   PUBLIC   trc_rst_cal
44
45   !! * Substitutions
46#  include "top_substitute.h90"
47   
48CONTAINS
49   
50   SUBROUTINE trc_rst_opn( kt )
51      !!----------------------------------------------------------------------
52      !!                    ***  trc_rst_opn  ***
53      !!
54      !! ** purpose  :   output of sea-trc variable in a netcdf file
55      !!----------------------------------------------------------------------
56      INTEGER, INTENT(in) ::   kt       ! number of iteration
57      INTEGER             ::   iyear, imonth, iday
58      REAL (wp)           ::   zsec
59      REAL (wp)           ::   zfjulday
60      !
61      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character
62      CHARACTER(LEN=50)   ::   clname   ! trc output restart file name
63      CHARACTER(LEN=256)  ::   clpath   ! full path to ocean output restart file
64      !!----------------------------------------------------------------------
65      !
66      IF( lk_offline ) THEN
67         IF( kt == nittrc000 ) THEN
68            lrst_trc = .FALSE.
69            IF( ln_rst_list ) THEN
70               nrst_lst = 1
71               nitrst = nstocklist( nrst_lst )
72            ELSE
73               nitrst = nitend
74            ENDIF
75         ENDIF
76
77         IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN
78            ! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment
79            nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing
80            IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run
81         ENDIF
82      ELSE
83         IF( kt == nittrc000 ) lrst_trc = .FALSE.
84      ENDIF
85
86      ! to get better performances with NetCDF format:
87      ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*nn_dttrc + 1)
88      ! 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
89      IF( kt == nitrst - 2*nn_dttrc + 1 .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc .AND. .NOT. lrst_trc ) ) THEN
90         if ( ln_rstdate ) THEN
91            zfjulday = fjulday + rdttrc(1) / rday
92            IF( ABS(zfjulday - REAL(NINT(zfjulday),wp)) < 0.1 / rday )   zfjulday = REAL(NINT(zfjulday),wp)   ! avoid truncation error
93            CALL ju2ymds( zfjulday, iyear, imonth, iday, zsec )
94            WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday
95         ELSE
96            ! beware of the format used to write kt (default is i8.8, that should be large enough)
97            IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst
98            ELSE                        ;   WRITE(clkt,'(i8.8)') nitrst
99            ENDIF
100         ENDIF
101         ! create the file
102         IF(lwp) WRITE(numout,*)
103         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trcrst_out)
104         clpath = TRIM(cn_trcrst_outdir)
105         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
106         IF(lwp) WRITE(numout,*) &
107             '             open trc restart.output NetCDF file: ',TRIM(clpath)//clname
108         CALL iom_open( TRIM(clpath)//TRIM(clname), numrtw, ldwrt = .TRUE., kiolib = jprstlib )
109         lrst_trc = .TRUE.
110      ENDIF
111      !
112   END SUBROUTINE trc_rst_opn
113
114   SUBROUTINE trc_rst_read
115      !!----------------------------------------------------------------------
116      !!                    ***  trc_rst_opn  ***
117      !!
118      !! ** purpose  :   read passive tracer fields in restart files
119      !!----------------------------------------------------------------------
120      INTEGER  ::  jn     
121
122      !!----------------------------------------------------------------------
123      !
124      IF(lwp) WRITE(numout,*)
125      IF(lwp) WRITE(numout,*) 'trc_rst_read : read data in the TOP restart file'
126      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
127
128      ! READ prognostic variables and computes diagnostic variable
129      DO jn = 1, jptra
130         CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )
131      END DO
132
133      DO jn = 1, jptra
134         CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
135      END DO
136      ! +++>>> FABM
137
138      IF (lk_fabm) CALL trc_rst_read_fabm
139      ! FABM <<<+++
140      !
141   END SUBROUTINE trc_rst_read
142
143   SUBROUTINE trc_rst_wri( kt )
144      !!----------------------------------------------------------------------
145      !!                    ***  trc_rst_wri  ***
146      !!
147      !! ** purpose  :   write passive tracer fields in restart files
148      !!----------------------------------------------------------------------
149      INTEGER, INTENT( in ) ::   kt    ! ocean time-step index
150      !!
151      INTEGER  :: jn
152      REAL(wp) :: zarak0
153      !!----------------------------------------------------------------------
154      !
155      CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rdttrc(1) )   ! surface passive tracer time step
156      ! prognostic variables
157      ! --------------------
158      DO jn = 1, jptra
159         CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )
160      END DO
161
162      DO jn = 1, jptra
163         CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )
164      END DO
165      ! +++>>> FABM
166      IF (lk_fabm) CALL trc_rst_wri_fabm(kt)
167      ! FABM <<<+++
168      !
169      IF( kt == nitrst ) THEN
170          CALL trc_rst_stat            ! statistics
171          CALL iom_close( numrtw )     ! close the restart file (only at last time step)
172#if ! defined key_trdmxl_trc
173          lrst_trc = .FALSE.
174#endif
175          IF( lk_offline .AND. ln_rst_list ) THEN
176             nrst_lst = nrst_lst + 1
177             nitrst = nstocklist( nrst_lst )
178          ENDIF
179      ENDIF
180      !
181   END SUBROUTINE trc_rst_wri 
182
183
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,
198      !!       nn_rsttr = 0  no control on the date (nittrc000 is  arbitrary).
199      !!       nn_rsttr = 1  we verify that nittrc000 is equal to the last
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 (nittrc000-1)*rdt.
204      !!       This is valid is the time step has remained constant.
205      !!
206      !!       nn_rsttr = 2  the duration of the experiment in days (adatrj)
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      !
212      INTEGER  ::  jlibalt = jprstlib
213      LOGICAL  ::  llok
214      REAL(wp) ::  zkt, zrdttrc1
215      REAL(wp) ::  zndastp
216
217      ! Time domain : restart
218      ! ---------------------
219
220      IF( TRIM(cdrw) == 'READ' ) THEN
221
222         IF(lwp) WRITE(numout,*)
223         IF(lwp) WRITE(numout,*) 'trc_rst_cal : read the TOP restart file for calendar'
224         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
225
226         IF ( jprstlib == jprstdimg ) THEN
227           ! eventually read netcdf file (monobloc)  for restarting on different number of processors
228           ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90
229           INQUIRE( FILE = TRIM(cn_trcrst_indir)//'/'//TRIM(cn_trcrst_in)//'.nc', EXIST = llok )
230           IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
231         ENDIF
232
233         IF( ln_rsttr ) THEN
234            CALL iom_open( TRIM(cn_trcrst_indir)//'/'//cn_trcrst_in, numrtr, kiolib = jlibalt )
235            CALL iom_get ( numrtr, 'kt', zkt )   ! last time-step of previous run
236
237            IF(lwp) THEN
238               WRITE(numout,*) ' *** Info read in restart : '
239               WRITE(numout,*) '   previous time-step                               : ', NINT( zkt )
240               WRITE(numout,*) ' *** restart option'
241               SELECT CASE ( nn_rsttr )
242               CASE ( 0 )   ;   WRITE(numout,*) ' nn_rsttr = 0 : no control of nittrc000'
243               CASE ( 1 )   ;   WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)'
244               CASE ( 2 )   ;   WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart'
245               END SELECT
246               WRITE(numout,*)
247            ENDIF
248            ! Control of date
249            IF( nittrc000  - NINT( zkt ) /= nn_dttrc .AND.  nn_rsttr /= 0 )                                  &
250               &   CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart',                 &
251               &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' )
252         ENDIF
253         !
254         IF( lk_offline ) THEN   
255            !                                          ! set the date in offline mode
256            IF( ln_rsttr .AND. nn_rsttr == 2 ) THEN
257               CALL iom_get( numrtr, 'ndastp', zndastp ) 
258               ndastp = NINT( zndastp )
259               CALL iom_get( numrtr, 'adatrj', adatrj  )
260             ELSE
261               ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam
262               adatrj = ( REAL( nittrc000-1, wp ) * rdttra(1) ) / rday
263               ! note this is wrong if time step has changed during run
264            ENDIF
265            !
266            IF(lwp) THEN
267              WRITE(numout,*) ' *** Info used values : '
268              WRITE(numout,*) '   date ndastp                                      : ', ndastp
269              WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj
270              WRITE(numout,*)
271            ENDIF
272            !
273            IF( ln_rsttr )  THEN   ;    neuler = 1
274            ELSE                   ;    neuler = 0
275            ENDIF
276            !
277            CALL day_init          ! compute calendar
278            !
279         ENDIF
280         !
281      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
282         !
283         IF(  kt == nitrst ) THEN
284            IF(lwp) WRITE(numout,*)
285            IF(lwp) WRITE(numout,*) 'trc_wri : write the TOP restart file (NetCDF) at it= ', kt, ' date= ', ndastp
286            IF(lwp) WRITE(numout,*) '~~~~~~~'
287         ENDIF
288         CALL iom_rstput( kt, nitrst, numrtw, 'kt'     , REAL( kt    , wp) )   ! time-step
289         CALL iom_rstput( kt, nitrst, numrtw, 'ndastp' , REAL( ndastp, wp) )   ! date
290         CALL iom_rstput( kt, nitrst, numrtw, 'adatrj' , adatrj            )   ! number of elapsed days since
291         !                                                                     ! the begining of the run [s]
292      ENDIF
293
294   END SUBROUTINE trc_rst_cal
295
296
297   SUBROUTINE trc_rst_stat
298      !!----------------------------------------------------------------------
299      !!                    ***  trc_rst_stat  ***
300      !!
301      !! ** purpose  :   Compute tracers statistics
302      !!----------------------------------------------------------------------
303      INTEGER  :: jk, jn
304      REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift
305      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol
306      !!----------------------------------------------------------------------
307
308      IF( lwp ) THEN
309         WRITE(numout,*) 
310         WRITE(numout,*) '           ----TRACER STAT----             '
311         WRITE(numout,*) 
312      ENDIF
313      !
314      DO jk = 1, jpk
315         zvol(:,:,jk) = e1e2t(:,:) * fse3t_a(:,:,jk) * tmask(:,:,jk)
316      END DO
317      !
318      DO jn = 1, jptra
319         ztraf = glob_sum( trn(:,:,:,jn) * zvol(:,:,:) )
320         zmin  = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
321         zmax  = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
322         IF( lk_mpp ) THEN
323            CALL mpp_min( zmin )      ! min over the global domain
324            CALL mpp_max( zmax )      ! max over the global domain
325         END IF
326         zmean  = ztraf / areatot
327         zdrift = ( ( ztraf - trai(jn) ) / ( trai(jn) + 1.e-12 )  ) * 100._wp
328         IF(lwp) WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax, zdrift
329      END DO
330      WRITE(numout,*) 
3319000  FORMAT(' tracer nb :',i2,'    name :',a10,'    mean :',e18.10,'    min :',e18.10, &
332      &      '    max :',e18.10,'    drift :',e18.10, ' %')
333      !
334   END SUBROUTINE trc_rst_stat
335
336#else
337   !!----------------------------------------------------------------------
338   !!  Dummy module :                                     No passive tracer
339   !!----------------------------------------------------------------------
340CONTAINS
341   SUBROUTINE trc_rst_read                      ! Empty routines
342   END SUBROUTINE trc_rst_read
343   SUBROUTINE trc_rst_wri( kt )
344      INTEGER, INTENT ( in ) :: kt
345      WRITE(*,*) 'trc_rst_wri: You should not have seen this print! error?', kt
346   END SUBROUTINE trc_rst_wri   
347#endif
348
349   !!----------------------------------------------------------------------
350   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
351   !! $Id$
352   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
353   !!======================================================================
354END MODULE trcrst
Note: See TracBrowser for help on using the repository browser.