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

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, 7 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
RevLine 
[268]1MODULE trcini
[945]2   !!======================================================================
3   !!                         ***  MODULE trcini  ***
4   !! TOP :   Manage the passive tracer initialization
5   !!======================================================================
[2715]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
[7693]10   !!             -   ! 2014-06 (A. Yool, J. Palmieri) adding MEDUSA-2
[274]11   !!----------------------------------------------------------------------
[1011]12#if defined key_top
13   !!----------------------------------------------------------------------
14   !!   'key_top'                                                TOP models
15   !!----------------------------------------------------------------------
[2715]16   !!   trc_init  :   Initialization for passive tracer
17   !!   top_alloc :   allocate the TOP arrays
[1011]18   !!----------------------------------------------------------------------
[3294]19   USE oce_trc         ! shared variables between ocean and passive tracers
20   USE trc             ! passive tracers common variables
21   USE trcrst          ! passive tracers restart
[2528]22   USE trcnam          ! Namelist read
[1254]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
[7693]27   USE trcini_medusa   ! MEDUSA   initialisation
28   USE trcini_idtra    ! idealize tracer initialisation
29   USE trcini_age      ! AGE      initialisation
[4230]30   USE trcdta          ! initialisation from files
[3294]31   USE daymod          ! calendar manager
[2528]32   USE zpshde          ! partial step: hor. derivative   (zps_hde routine)
[1011]33   USE prtctl_trc      ! Print control passive tracers (prt_ctl_trc_init routine)
[4306]34   USE trcsub          ! variables to substep passive tracers
35   USE lib_mpp         ! distribued memory computing library
36   USE sbc_oce
[5385]37   USE trcice          ! tracers in sea ice
[4306]38 
[335]39   IMPLICIT NONE
40   PRIVATE
[1011]41   
[2528]42   PUBLIC   trc_init   ! called by opa
[268]43
[1011]44    !! * Substitutions
45#  include "domzgr_substitute.h90"
[2715]46   !!----------------------------------------------------------------------
47   !! NEMO/TOP 4.0 , NEMO Consortium (2011)
[7692]48   !! $Id$
[2715]49   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
50   !!----------------------------------------------------------------------
[335]51CONTAINS
[1011]52   
[2528]53   SUBROUTINE trc_init
[1011]54      !!---------------------------------------------------------------------
[2528]55      !!                     ***  ROUTINE trc_init  ***
[335]56      !!
[1011]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      !!---------------------------------------------------------------------
[3294]65      INTEGER ::   jk, jn, jl    ! dummy loop indices
[1011]66      CHARACTER (len=25) :: charout
[4230]67      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta   ! 4D  workspace
[1011]68      !!---------------------------------------------------------------------
[3294]69      !
70      IF( nn_timing == 1 )   CALL timing_start('trc_init')
71      !
[945]72      IF(lwp) WRITE(numout,*)
[2528]73      IF(lwp) WRITE(numout,*) 'trc_init : initial set up of the passive tracers'
[945]74      IF(lwp) WRITE(numout,*) '~~~~~~~'
[1011]75
[2715]76      CALL top_alloc()              ! allocate TOP arrays
77
[5407]78      l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 )
[5385]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) ')
[7693]83          !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
84          !!!!! CHECK For MEDUSA
85          !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[3294]86      IF( nn_cla == 1 )   &
87         &  CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' )
[1011]88
[4152]89      CALL trc_nam      ! read passive tracers namelists
[3294]90      !
91      IF(lwp) WRITE(numout,*)
[4152]92      !
93      IF( ln_rsttr .AND. .NOT. lk_offline ) CALL trc_rst_cal( nit000, 'READ' )   ! calendar
94      !
[3294]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(:,:,:) )
[1011]104
[3294]105      IF( lk_pisces  )       CALL trc_ini_pisces       ! PISCES  bio-model
[7693]106      IF( lk_medusa  )       CALL trc_ini_medusa       ! MEDUSA  tracers
107      IF( lk_idtra   )       CALL trc_ini_idtra        ! Idealize tracers
[3294]108      IF( lk_cfc     )       CALL trc_ini_cfc          ! CFC     tracers
109      IF( lk_c14b    )       CALL trc_ini_c14b         ! C14 bomb  tracer
[7693]110      IF( lk_age     )       CALL trc_ini_age          ! AGE       tracer
[3294]111      IF( lk_my_trc  )       CALL trc_ini_my_trc       ! MY_TRC  tracers
[2528]112
[5385]113      CALL trc_ice_ini                                 ! Tracers in sea ice
114
[7693]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
[7701]125      IF( ln_ctl ) THEN
[3294]126         !
[7701]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 
[3294]134         !
[945]135      ENDIF
[1254]136
[7693]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
[1011]145
[3294]146
[7693]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
[2528]155      IF( ln_rsttr ) THEN
156        !
[7693]157#if defined key_medusa
158        IF(lwp) WRITE(numout,*) 'AXY: calling trc_rst_read'
159        IF(lwp) CALL flush(numout)
160#endif
[2528]161        CALL trc_rst_read              ! restart from a file
162        !
[1011]163      ELSE
[3294]164        !
165        IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN  ! Initialisation of tracer from a file that may also be used for damping
166            !
[4230]167            CALL wrk_alloc( jpi, jpj, jpk, ztrcdta )    ! Memory allocation
[3294]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) 
[4230]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
[3294]182               ENDIF
183            ENDDO
[4230]184            CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta )
[2528]185        ENDIF
[3294]186        !
[7693]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        !
[2528]196        trb(:,:,:,:) = trn(:,:,:,:)
197        !
[7693]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        !
[1011]207      ENDIF
[2528]208 
[2715]209      tra(:,:,:,:) = 0._wp
[5120]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
[3294]214      !
[7693]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      !
[3294]224      IF( nn_dttrc /= 1 )        CALL trc_sub_ini      ! Initialize variables for substepping passive tracers
225      !
[7693]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      !
[3294]235      trai(:) = 0._wp                                                   ! initial content of all tracers
[1011]236      DO jn = 1, jptra
[3294]237         trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   )
238      END DO
[1011]239
[2715]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
[3294]245         WRITE(numout,*) '          *** Total inital content of all tracers '
[2715]246         WRITE(numout,*)
[7693]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
[3294]255         DO jn = 1, jptra
256            WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn)
257         ENDDO
258         WRITE(numout,*)
[2715]259      ENDIF
[3294]260      IF(lwp) WRITE(numout,*)
[2715]261      IF(ln_ctl) THEN            ! print mean trends (used for debugging)
262         CALL prt_ctl_trc_init
[1011]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
[7693]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
[3294]2779000  FORMAT(' tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10)
[2715]278      !
[3294]279      IF( nn_timing == 1 )   CALL timing_stop('trc_init')
280      !
[2528]281   END SUBROUTINE trc_init
[268]282
[2715]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
[4990]294      USE trdtrc_oce    , ONLY:   trd_trc_oce_alloc
295#if defined key_trdmxl_trc 
296      USE trdmxl_trc    , ONLY:   trd_mxl_trc_alloc
[2715]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()
[4990]306      ierr = ierr + trd_trc_oce_alloc()
307#if defined key_trdmxl_trc 
308      ierr = ierr + trd_mxl_trc_alloc()
[2715]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
[1011]316#else
317   !!----------------------------------------------------------------------
318   !!  Empty module :                                     No passive tracer
319   !!----------------------------------------------------------------------
320CONTAINS
[2528]321   SUBROUTINE trc_init                      ! Dummy routine   
322   END SUBROUTINE trc_init
[1011]323#endif
324
[335]325   !!======================================================================
[268]326END MODULE trcini
Note: See TracBrowser for help on using the repository browser.