source: branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM/NEMO/TOP_SRC/trcini.F90 @ 7701

Last change on this file since 7701 was 7701, checked in by frrh, 4 years ago

Improve control of numstr unit.

In addition to only producing output, and doing the
related global sums when we really need them, we
need to restrict it to one instance on the master PE
in all circumstances and to explicitly close it at the
end of the run. (Currently if lwp = true you get a separate
file for every PE containing identical information and none
of the tracer.stat files are explicitly closed.)

File size: 13.7 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_my_trc   ! MY_TRC   initialisation
27   USE trcini_medusa   ! MEDUSA   initialisation
28   USE trcini_idtra    ! idealize tracer initialisation
29   USE trcini_age      ! AGE      initialisation
30   USE trcdta          ! initialisation from files
31   USE daymod          ! calendar manager
32   USE zpshde          ! partial step: hor. derivative   (zps_hde routine)
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 
39   IMPLICIT NONE
40   PRIVATE
41   
42   PUBLIC   trc_init   ! called by opa
43
44    !! * Substitutions
45#  include "domzgr_substitute.h90"
46   !!----------------------------------------------------------------------
47   !! NEMO/TOP 4.0 , NEMO Consortium (2011)
48   !! $Id$
49   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
50   !!----------------------------------------------------------------------
51CONTAINS
52   
53   SUBROUTINE trc_init
54      !!---------------------------------------------------------------------
55      !!                     ***  ROUTINE trc_init  ***
56      !!
57      !! ** Purpose :   Initialization of the passive tracer fields
58      !!
59      !! ** Method  : - read namelist
60      !!              - control the consistancy
61      !!              - compute specific initialisations
62      !!              - set initial tracer fields (either read restart
63      !!                or read data or analytical formulation
64      !!---------------------------------------------------------------------
65      INTEGER ::   jk, jn, jl    ! dummy loop indices
66      CHARACTER (len=25) :: charout
67      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta   ! 4D  workspace
68      !!---------------------------------------------------------------------
69      !
70      IF( nn_timing == 1 )   CALL timing_start('trc_init')
71      !
72      IF(lwp) WRITE(numout,*)
73      IF(lwp) WRITE(numout,*) 'trc_init : initial set up of the passive tracers'
74      IF(lwp) WRITE(numout,*) '~~~~~~~'
75
76      CALL top_alloc()              ! allocate TOP arrays
77
78      l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 )
79      l_trcdm2dc = l_trcdm2dc  .AND. .NOT. lk_offline
80      IF( l_trcdm2dc .AND. lwp ) &
81         &   CALL ctl_warn(' Coupling with passive tracers and used of diurnal cycle. &
82         & Computation of a daily mean shortwave for some biogeochemical models) ')
83          !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
84          !!!!! CHECK For MEDUSA
85          !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
86      IF( nn_cla == 1 )   &
87         &  CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' )
88
89      CALL trc_nam      ! read passive tracers namelists
90      !
91      IF(lwp) WRITE(numout,*)
92      !
93      IF( ln_rsttr .AND. .NOT. lk_offline ) CALL trc_rst_cal( nit000, 'READ' )   ! calendar
94      !
95      IF(lwp) WRITE(numout,*)
96                                                              ! masked grid volume
97      !                                                              ! masked grid volume
98      DO jk = 1, jpk
99         cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk)
100      END DO
101      IF( lk_degrad ) cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)      ! degrad option: reduction by facvol
102      !                                                              ! total volume of the ocean
103      areatot = glob_sum( cvol(:,:,:) )
104
105      IF( lk_pisces  )       CALL trc_ini_pisces       ! PISCES  bio-model
106      IF( lk_medusa  )       CALL trc_ini_medusa       ! MEDUSA  tracers
107      IF( lk_idtra   )       CALL trc_ini_idtra        ! Idealize tracers
108      IF( lk_cfc     )       CALL trc_ini_cfc          ! CFC     tracers
109      IF( lk_c14b    )       CALL trc_ini_c14b         ! C14 bomb  tracer
110      IF( lk_age     )       CALL trc_ini_age          ! AGE       tracer
111      IF( lk_my_trc  )       CALL trc_ini_my_trc       ! MY_TRC  tracers
112
113      CALL trc_ice_ini                                 ! Tracers in sea ice
114
115# if defined key_debug_medusa
116         IF (lwp) write (numout,*) '------------------------------'
117         IF (lwp) write (numout,*) 'Jpalm - debug'
118         IF (lwp) write (numout,*) ' in trc_init'
119         IF (lwp) write (numout,*) ' sms init OK'
120         IF (lwp) write (numout,*) ' next: open tracer.stat'
121         IF (lwp) write (numout,*) ' '
122         CALL flush(numout)
123# endif
124
125      IF( ln_ctl ) THEN
126         !
127         IF (narea == 1) THEN 
128            ! The tracer.stat file only contains global tracer sum values, if
129            ! it contains anything at all. Hence it only needs to be opened
130            ! and written to on the master PE, not on all PEs.
131            CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED',  &
132                          'SEQUENTIAL', -1, numout, lwp , narea )
133         ENDIF 
134         !
135      ENDIF
136
137# if defined key_debug_medusa
138         IF (lwp) write (numout,*) '------------------------------'
139         IF (lwp) write (numout,*) 'Jpalm - debug'
140         IF (lwp) write (numout,*) ' in trc_init'
141         IF (lwp) write (numout,*) 'open tracer.stat -- OK'
142         IF (lwp) write (numout,*) ' '
143         CALL flush(numout)
144# endif
145
146
147      IF( ln_trcdta ) THEN
148#if defined key_medusa
149         IF(lwp) WRITE(numout,*) 'AXY: calling trc_dta_init'
150         IF(lwp) CALL flush(numout)
151#endif
152         CALL trc_dta_init(jptra)
153      ENDIF
154
155      IF( ln_rsttr ) THEN
156        !
157#if defined key_medusa
158        IF(lwp) WRITE(numout,*) 'AXY: calling trc_rst_read'
159        IF(lwp) CALL flush(numout)
160#endif
161        CALL trc_rst_read              ! restart from a file
162        !
163      ELSE
164        !
165        IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN  ! Initialisation of tracer from a file that may also be used for damping
166            !
167            CALL wrk_alloc( jpi, jpj, jpk, ztrcdta )    ! Memory allocation
168            !
169            DO jn = 1, jptra
170               IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file
171                  jl = n_trc_index(jn) 
172                  CALL trc_dta( nit000, sf_trcdta(jl),rf_trfac(jl) )   ! read tracer data at nit000
173                  ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:)
174                  trn(:,:,:,jn) = ztrcdta(:,:,:) * tmask(:,:,:) 
175                  IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN      !== deallocate data structure   ==!
176                     !                                                    (data used only for initialisation)
177                     IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only used to initialize the run'
178                                                  DEALLOCATE( sf_trcdta(jl)%fnow )     !  arrays in the structure
179                     IF( sf_trcdta(jl)%ln_tint )  DEALLOCATE( sf_trcdta(jl)%fdta )
180                     !
181                  ENDIF
182               ENDIF
183            ENDDO
184            CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta )
185        ENDIF
186        !
187# if defined key_debug_medusa
188         IF (lwp) write (numout,*) '------------------------------'
189         IF (lwp) write (numout,*) 'Jpalm - debug'
190         IF (lwp) write (numout,*) ' in trc_init'
191         IF (lwp) write (numout,*) ' before trb = trn'
192         IF (lwp) write (numout,*) ' '
193         CALL flush(numout)
194# endif
195        !
196        trb(:,:,:,:) = trn(:,:,:,:)
197        !
198# if defined key_debug_medusa
199         IF (lwp) write (numout,*) '------------------------------'
200         IF (lwp) write (numout,*) 'Jpalm - debug'
201         IF (lwp) write (numout,*) ' in trc_init'
202         IF (lwp) write (numout,*) ' trb = trn -- OK'
203         IF (lwp) write (numout,*) ' '
204         CALL flush(numout)
205# endif
206        !
207      ENDIF
208 
209      tra(:,:,:,:) = 0._wp
210      IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav )   &              ! Partial steps: before horizontal gradient of passive
211        &    CALL zps_hde    ( nit000, jptra, trn, gtru, gtrv  )  ! Partial steps: before horizontal gradient
212      IF( ln_zps .AND. .NOT. lk_c1d .AND.       ln_isfcav )   &
213        &    CALL zps_hde_isf( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi )       ! tracers at the bottom ocean level
214      !
215# if defined key_debug_medusa
216         IF (lwp) write (numout,*) '------------------------------'
217         IF (lwp) write (numout,*) 'Jpalm - debug'
218         IF (lwp) write (numout,*) ' in trc_init'
219         IF (lwp) write (numout,*) ' partial step -- OK'
220         IF (lwp) write (numout,*) ' '
221         CALL flush(numout)
222# endif
223      !
224      IF( nn_dttrc /= 1 )        CALL trc_sub_ini      ! Initialize variables for substepping passive tracers
225      !
226# if defined key_debug_medusa
227         IF (lwp) write (numout,*) '------------------------------'
228         IF (lwp) write (numout,*) 'Jpalm - debug'
229         IF (lwp) write (numout,*) ' in trc_init'
230         IF (lwp) write (numout,*) ' before initiate tracer contents'
231         IF (lwp) write (numout,*) ' '
232         CALL flush(numout)
233# endif
234      !
235      trai(:) = 0._wp                                                   ! initial content of all tracers
236      DO jn = 1, jptra
237         trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   )
238      END DO
239
240      IF(lwp) THEN               ! control print
241         WRITE(numout,*)
242         WRITE(numout,*)
243         WRITE(numout,*) '          *** Total number of passive tracer jptra = ', jptra
244         WRITE(numout,*) '          *** Total volume of ocean                = ', areatot
245         WRITE(numout,*) '          *** Total inital content of all tracers '
246         WRITE(numout,*)
247# if defined key_debug_medusa
248         CALL flush(numout)
249# endif
250         !
251# if defined key_debug_medusa
252         WRITE(numout,*) ' litle check :  ', ctrcnm(1)
253         CALL flush(numout)
254# endif
255         DO jn = 1, jptra
256            WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn)
257         ENDDO
258         WRITE(numout,*)
259      ENDIF
260      IF(lwp) WRITE(numout,*)
261      IF(ln_ctl) THEN            ! print mean trends (used for debugging)
262         CALL prt_ctl_trc_init
263         WRITE(charout, FMT="('ini ')")
264         CALL prt_ctl_trc_info( charout )
265         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )
266      ENDIF
267
268      IF(lwp) WRITE(numout,*)
269      IF(lwp) WRITE(numout,*) 'trc_init : passive tracer set up completed'
270      IF(lwp) WRITE(numout,*) '~~~~~~~'
271      IF(lwp) CALL flush(numout)
272# if defined key_debug_medusa
273         CALL trc_rst_stat
274         CALL flush(numout)
275# endif
276
2779000  FORMAT(' tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10)
278      !
279      IF( nn_timing == 1 )   CALL timing_stop('trc_init')
280      !
281   END SUBROUTINE trc_init
282
283
284   SUBROUTINE top_alloc
285      !!----------------------------------------------------------------------
286      !!                     ***  ROUTINE top_alloc  ***
287      !!
288      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
289      !!----------------------------------------------------------------------
290      USE trcadv        , ONLY:   trc_adv_alloc          ! TOP-related alloc routines...
291      USE trc           , ONLY:   trc_alloc
292      USE trcnxt        , ONLY:   trc_nxt_alloc
293      USE trczdf        , ONLY:   trc_zdf_alloc
294      USE trdtrc_oce    , ONLY:   trd_trc_oce_alloc
295#if defined key_trdmxl_trc 
296      USE trdmxl_trc    , ONLY:   trd_mxl_trc_alloc
297#endif
298      !
299      INTEGER :: ierr
300      !!----------------------------------------------------------------------
301      !
302      ierr =        trc_adv_alloc()          ! Start of TOP-related alloc routines...
303      ierr = ierr + trc_alloc    ()
304      ierr = ierr + trc_nxt_alloc()
305      ierr = ierr + trc_zdf_alloc()
306      ierr = ierr + trd_trc_oce_alloc()
307#if defined key_trdmxl_trc 
308      ierr = ierr + trd_mxl_trc_alloc()
309#endif
310      !
311      IF( lk_mpp    )   CALL mpp_sum( ierr )
312      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'top_alloc : unable to allocate standard ocean arrays' )
313      !
314   END SUBROUTINE top_alloc
315
316#else
317   !!----------------------------------------------------------------------
318   !!  Empty module :                                     No passive tracer
319   !!----------------------------------------------------------------------
320CONTAINS
321   SUBROUTINE trc_init                      ! Dummy routine   
322   END SUBROUTINE trc_init
323#endif
324
325   !!======================================================================
326END MODULE trcini
Note: See TracBrowser for help on using the repository browser.