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

source: branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/TOP_SRC/trcrst.F90 @ 10162

Last change on this file since 10162 was 10162, checked in by dford, 5 years ago

Add NEMO-FABM coupling code, essentially identical to commit 4bc68d33 of the PML NEMO-FABM GitLab?.

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