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.
trcini.F90 in branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC – NEMO

source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trcini.F90 @ 11101

Last change on this file since 11101 was 11101, checked in by frrh, 5 years ago

Merge changes from Met Office GMED ticket 450 to reduce unnecessary
text output from NEMO.
This output, which is typically not switchable, is rarely of interest
in normal (non-debugging) runs and simply redunantley consumes extra
file space.
Further, the presence of this text output has been shown to
significantly degrade performance of models which are run during
Met Office HPC RAID (disk) checks.
The new code introduces switches which are configurable via the
changes made in the associated Met Office MOCI ticket 399.
File size: 15.1 KB
Line 
1MODULE trcini
2   !!======================================================================
3   !!                         ***  MODULE trcini  ***
4   !! TOP :   Manage the passive tracer initialization
5   !!======================================================================
6   !! History :   -   ! 1991-03 (O. Marti)  original code
7   !!            1.0  ! 2005-03 (O. Aumont, A. El Moussaoui) F90
8   !!            2.0  ! 2005-10 (C. Ethe, G. Madec) revised architecture
9   !!            4.0  ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation
10   !!             -   ! 2014-06 (A. Yool, J. Palmieri) adding MEDUSA-2
11   !!----------------------------------------------------------------------
12#if defined key_top
13   !!----------------------------------------------------------------------
14   !!   'key_top'                                                TOP models
15   !!----------------------------------------------------------------------
16   !!   trc_init  :   Initialization for passive tracer
17   !!   top_alloc :   allocate the TOP arrays
18   !!----------------------------------------------------------------------
19   USE oce_trc         ! shared variables between ocean and passive tracers
20   USE trc             ! passive tracers common variables
21   USE trcrst          ! passive tracers restart
22   USE trcnam          ! Namelist read
23   USE trcini_cfc      ! CFC      initialisation
24   USE trcini_pisces   ! PISCES   initialisation
25   USE trcini_c14b     ! C14 bomb initialisation
26   USE trcini_age      ! AGE      initialisation
27   USE trcini_my_trc   ! MY_TRC   initialisation
28   USE trcini_idtra    ! idealize tracer initialisation
29   USE trcini_medusa   ! MEDUSA   initialisation
30   USE par_medusa      ! MEDUSA   parameters (needed for elemental cycles)
31   USE trcdta          ! initialisation from files
32   USE daymod          ! calendar manager
33   USE prtctl_trc      ! Print control passive tracers (prt_ctl_trc_init routine)
34   USE trcsub          ! variables to substep passive tracers
35   USE lib_mpp         ! distribued memory computing library
36   USE sbc_oce
37   USE trcice          ! tracers in sea ice
38# if defined key_medusa
39   USE sms_medusa      ! MEDUSA   initialisation
40# endif
41   IMPLICIT NONE
42   PRIVATE
43   
44   PUBLIC   trc_init   ! called by opa
45
46    !! * Substitutions
47#  include "domzgr_substitute.h90"
48   !!----------------------------------------------------------------------
49   !! NEMO/TOP 4.0 , NEMO Consortium (2011)
50   !! $Id$
51   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
52   !!----------------------------------------------------------------------
53CONTAINS
54   
55   SUBROUTINE trc_init
56      !!---------------------------------------------------------------------
57      !!                     ***  ROUTINE trc_init  ***
58      !!
59      !! ** Purpose :   Initialization of the passive tracer fields
60      !!
61      !! ** Method  : - read namelist
62      !!              - control the consistancy
63      !!              - compute specific initialisations
64      !!              - set initial tracer fields (either read restart
65      !!                or read data or analytical formulation
66      !!---------------------------------------------------------------------
67      INTEGER ::   ji, jj, jk, jn, jl    ! dummy loop indices
68# if defined key_medusa && defined key_roam
69      !! AXY (23/11/2017)
70      REAL(wp)                         :: zsum3d, zsum2d
71      REAL(wp)                         :: zq1, zq2, loc_vol, loc_area
72      REAL(wp), DIMENSION(6)           :: loc_cycletot3, loc_cycletot2
73      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztot3d
74      REAL(wp), DIMENSION(jpi,jpj)     :: ztot2d, carea
75# endif
76      CHARACTER (len=25) :: charout
77      !!---------------------------------------------------------------------
78      !
79      IF( nn_timing == 1 )   CALL timing_start('trc_init')
80      !
81      IF(lwp) WRITE(numout,*)
82      IF(lwp) WRITE(numout,*) 'trc_init : initial set up of the passive tracers'
83      IF(lwp) WRITE(numout,*) '~~~~~~~'
84
85      CALL top_alloc()              ! allocate TOP arrays
86
87      l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 )
88      l_trcdm2dc = l_trcdm2dc  .AND. .NOT. lk_offline
89      IF( l_trcdm2dc .AND. lwp ) &
90         &   CALL ctl_warn(' Coupling with passive tracers and used of diurnal cycle. &
91         & Computation of a daily mean shortwave for some biogeochemical models) ')
92
93      IF( nn_cla == 1 )   &
94         &  CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' )
95
96      CALL trc_nam      ! read passive tracers namelists
97      !
98      IF(lwp) WRITE(numout,*)
99      !
100      IF( ln_rsttr .AND. .NOT. lk_offline ) CALL trc_rst_cal( nit000, 'READ' )   ! calendar
101      !
102      IF(lwp) WRITE(numout,*)
103                                                              ! masked grid volume
104      !                                                              ! masked grid volume
105      DO jk = 1, jpk
106         cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk)
107      END DO
108      IF( lk_degrad ) cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)      ! degrad option: reduction by facvol
109      !                                                              ! total volume of the ocean
110      areatot = glob_sum( cvol(:,:,:) )
111# if defined key_medusa && defined key_roam
112      carea(:,:) = e1e2t(:,:) * tmask(:,:,1) 
113# endif
114
115      IF( lk_pisces  )       CALL trc_ini_pisces       ! PISCES  bio-model
116      IF( lk_cfc     )       CALL trc_ini_cfc          ! CFC     tracers
117      IF( lk_c14b    )       CALL trc_ini_c14b         ! C14 bomb  tracer
118      IF( lk_age     )       CALL trc_ini_age          ! AGE       tracer
119      IF( lk_my_trc  )       CALL trc_ini_my_trc       ! MY_TRC  tracers
120      IF( lk_idtra   )       CALL trc_ini_idtra        ! Idealize tracers
121      IF( lk_medusa  )       CALL trc_ini_medusa       ! MEDUSA  tracers
122
123      CALL trc_ice_ini                                 ! Tracers in sea ice
124
125      !
126      IF (lwm .AND. sn_cfctl%l_trcstat) THEN 
127         ! The tracer.stat file only contains global tracer sum values, if
128         ! it contains anything at all. Hence it only needs to be opened
129         ! and written to on the master PE, not on all PEs. 
130         CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE','FORMATTED',  & 
131                       'SEQUENTIAL', -1, numout, lwp , narea ) 
132      ENDIF 
133      !
134
135      IF( ln_trcdta ) THEN
136         CALL trc_dta_init(jptra)
137      ENDIF
138
139      IF( ln_rsttr ) THEN
140        !
141        CALL trc_rst_read              ! restart from a file
142        !
143      ELSE
144        !
145        IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN  ! Initialisation of tracer from a file that may also be used for damping
146            !
147            DO jn = 1, jptra
148               IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file
149                  jl = n_trc_index(jn) 
150                  CALL trc_dta( nit000, sf_trcdta(jl), rf_trfac(jl) )   ! read tracer data at nit000
151                  trn(:,:,:,jn) = sf_trcdta(jl)%fnow(:,:,:) 
152                  IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN      !== deallocate data structure   ==!
153                     !                                                    (data used only for initialisation)
154                     IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only used to initialize the run'
155                                                  DEALLOCATE( sf_trcdta(jl)%fnow )     !  arrays in the structure
156                     IF( sf_trcdta(jl)%ln_tint )  DEALLOCATE( sf_trcdta(jl)%fdta )
157                     !
158                  ENDIF
159               ENDIF
160            ENDDO
161            !
162        ENDIF
163        !
164        trb(:,:,:,:) = trn(:,:,:,:)
165        !
166      ENDIF
167 
168      tra(:,:,:,:) = 0._wp
169      !
170      IF( nn_dttrc /= 1 )        CALL trc_sub_ini      ! Initialize variables for substepping passive tracers
171      !
172
173      trai(:) = 0._wp                                                   ! initial content of all tracers
174      DO jn = 1, jptra
175         trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   )
176      END DO
177
178      IF(lwp) THEN               ! control print
179         WRITE(numout,*)
180         WRITE(numout,*)
181         WRITE(numout,*) '          *** Total number of passive tracer jptra = ', jptra
182         WRITE(numout,*) '          *** Total volume of ocean                = ', areatot
183         WRITE(numout,*) '          *** Total inital content of all tracers '
184         WRITE(numout,*)
185# if defined key_debug_medusa
186         CALL flush(numout)
187# endif
188         !
189# if defined key_debug_medusa
190         WRITE(numout,*) ' litle check :  ', ctrcnm(1)
191         CALL flush(numout)
192# endif
193         DO jn = 1, jptra
194            WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn)
195         ENDDO
196         WRITE(numout,*)
197      ENDIF
198      IF(lwp) WRITE(numout,*)
199      IF(ln_ctl) THEN            ! print mean trends (used for debugging)
200         CALL prt_ctl_trc_init
201         WRITE(charout, FMT="('ini ')")
202         CALL prt_ctl_trc_info( charout )
203         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )
204      ENDIF
205
206# if defined key_medusa && defined key_roam
207      ! AXY (17/11/2017): calculate initial totals of elemental cycles
208      !
209      ! This is done in a very hard-wired way here; in future, this could be
210      ! replaced with loops and using a 2D array; one dimension would cover
211      ! the tracers, the other would be for the elements; each tracer would
212      ! have a factor for each element to say how much of that element was
213      ! in that tracer; for example, PHN would be 1.0 for N, xrfn for Fe and
214      ! xthetapn for C, with the other elements 0.0; the array entry for PHN
215      ! would then be (1. 0. xrfn xthetapn 0. 0.) for (N, Si, Fe, C, A, O2);
216      ! saving this for the next iteration
217      !
218      cycletot(:) = 0._wp
219      ! report elemental totals at initialisation as we go along
220      IF ( lwp ) WRITE(numout,*)
221      IF ( lwp ) WRITE(numout,*)    ' Elemental cycle totals: '
222      ! nitrogen
223      ztot3d(:,:,:) = trn(:,:,:,jpphn) + trn(:,:,:,jpphd) + trn(:,:,:,jpzmi) + &
224                      trn(:,:,:,jpzme) + trn(:,:,:,jpdet) + trn(:,:,:,jpdin)
225      ztot2d(:,:)   = zn_sed_n(:,:)
226      zsum3d        = glob_sum( ztot3d(:,:,:) * cvol(:,:,:) )
227      zsum2d        = glob_sum( ztot2d(:,:) * carea(:,:) )
228      cycletot(1)   = zsum3d + zsum2d
229      IF ( lwp ) WRITE(numout,9010) 'nitrogen', zsum3d, zsum2d, cycletot(1)
230      ! silicon
231      ztot3d(:,:,:) = trn(:,:,:,jppds) + trn(:,:,:,jpsil)
232      ztot2d(:,:)   = zn_sed_si(:,:)
233      zsum3d        = glob_sum( ztot3d(:,:,:) * cvol(:,:,:) )
234      zsum2d        = glob_sum( ztot2d(:,:) * carea(:,:) )
235      cycletot(2)   = zsum3d + zsum2d
236      IF ( lwp ) WRITE(numout,9010) 'silicon', zsum3d, zsum2d, cycletot(2)
237      ! iron
238      ztot3d(:,:,:) = ((trn(:,:,:,jpphn) + trn(:,:,:,jpphd) + trn(:,:,:,jpzmi) + &
239                      trn(:,:,:,jpzme) + trn(:,:,:,jpdet)) * xrfn) + trn(:,:,:,jpfer)
240      ztot2d(:,:)   = zn_sed_fe(:,:)
241      zsum3d        = glob_sum( ztot3d(:,:,:) * cvol(:,:,:) )
242      zsum2d        = glob_sum( ztot2d(:,:) * carea(:,:) )
243      cycletot(3)   = zsum3d + zsum2d
244      IF ( lwp ) WRITE(numout,9010) 'iron', zsum3d, zsum2d, cycletot(3)
245      ! carbon (uses fixed C:N ratios on plankton tracers)
246      ztot3d(:,:,:) = (trn(:,:,:,jpphn) * xthetapn)  + (trn(:,:,:,jpphd) * xthetapd)  +  &
247                      (trn(:,:,:,jpzmi) * xthetazmi) + (trn(:,:,:,jpzme) * xthetazme) +  &
248                      trn(:,:,:,jpdtc) + trn(:,:,:,jpdic)
249      ztot2d(:,:)   = zn_sed_c(:,:) + zn_sed_ca(:,:)
250      zsum3d        = glob_sum( ztot3d(:,:,:) * cvol(:,:,:) )
251      zsum2d        = glob_sum( ztot2d(:,:) * carea(:,:) )
252      cycletot(4)   = zsum3d + zsum2d
253      IF ( lwp ) WRITE(numout,9010) 'carbon', zsum3d, zsum2d, cycletot(4)
254      ! alkalinity (note benthic correction)
255      ztot3d(:,:,:) = trn(:,:,:,jpalk)
256      ztot2d(:,:)   = zn_sed_ca(:,:) * 2._wp
257      zsum3d        = glob_sum( ztot3d(:,:,:) * cvol(:,:,:) )
258      zsum2d        = glob_sum( ztot2d(:,:) * carea(:,:) )
259      cycletot(5)   = zsum3d + zsum2d
260      IF ( lwp ) WRITE(numout,9010) 'alkalinity', zsum3d, zsum2d, cycletot(5)
261      ! oxygen (note no benthic)
262      ztot3d(:,:,:) = trn(:,:,:,jpoxy)
263      ztot2d(:,:)   = 0._wp
264      zsum3d        = glob_sum( ztot3d(:,:,:) * cvol(:,:,:) )
265      zsum2d        = glob_sum( ztot2d(:,:) * carea(:,:) )
266      cycletot(6)   = zsum3d + zsum2d
267      IF ( lwp ) WRITE(numout,9010) 'oxygen', zsum3d, zsum2d, cycletot(6)
268      ! Check
269      zsum3d        = glob_sum( cvol(:,:,:) )
270      zsum2d        = glob_sum( carea(:,:) )     
271      IF ( lwp ) THEN
272         WRITE(numout,*)
273         WRITE(numout,*) ' check : cvol    : ', zsum3d
274         WRITE(numout,*) ' check : carea   : ', zsum2d
275         WRITE(numout,*)
276      ENDIF
277      !
278# endif
279
280      IF(lwp) THEN
281          WRITE(numout,*)
282          WRITE(numout,*) 'trc_init : passive tracer set up completed'
283          WRITE(numout,*) '~~~~~~~'
284      ENDIF 
285# if defined key_debug_medusa
286         CALL trc_rst_stat
287         CALL flush(numout)
288# endif
289
2909000  FORMAT(' tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10)
2919010  FORMAT(' element:',a10,                     &
292             ' 3d sum:',e18.10,' 2d sum:',e18.10, &
293             ' total:',e18.10)
294      !
295      IF( nn_timing == 1 )   CALL timing_stop('trc_init')
296      !
297   END SUBROUTINE trc_init
298
299
300   SUBROUTINE top_alloc
301      !!----------------------------------------------------------------------
302      !!                     ***  ROUTINE top_alloc  ***
303      !!
304      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
305      !!----------------------------------------------------------------------
306      USE trcadv        , ONLY:   trc_adv_alloc          ! TOP-related alloc routines...
307      USE trc           , ONLY:   trc_alloc
308      USE trcnxt        , ONLY:   trc_nxt_alloc
309      USE trczdf        , ONLY:   trc_zdf_alloc
310      USE trdtrc_oce    , ONLY:   trd_trc_oce_alloc
311#if defined key_trdmxl_trc 
312      USE trdmxl_trc    , ONLY:   trd_mxl_trc_alloc
313#endif
314# if defined key_medusa
315      USE bio_medusa_mod, ONLY:   bio_medusa_alloc
316# endif
317
318      !
319      INTEGER :: ierr
320      !!----------------------------------------------------------------------
321      !
322      ierr =        trc_adv_alloc()          ! Start of TOP-related alloc routines...
323      ierr = ierr + trc_alloc    ()
324      ierr = ierr + trc_nxt_alloc()
325      ierr = ierr + trc_zdf_alloc()
326      ierr = ierr + trd_trc_oce_alloc()
327#if defined key_trdmxl_trc 
328      ierr = ierr + trd_mxl_trc_alloc()
329#endif
330#if defined key_medusa
331      ierr = ierr + bio_medusa_alloc()
332#endif
333      !
334      IF( lk_mpp    )   CALL mpp_sum( ierr )
335      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'top_alloc : unable to allocate standard ocean arrays' )
336      !
337   END SUBROUTINE top_alloc
338
339#else
340   !!----------------------------------------------------------------------
341   !!  Empty module :                                     No passive tracer
342   !!----------------------------------------------------------------------
343CONTAINS
344   SUBROUTINE trc_init                      ! Dummy routine   
345   END SUBROUTINE trc_init
346#endif
347
348   !!======================================================================
349END MODULE trcini
Note: See TracBrowser for help on using the repository browser.