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

source: branches/NERC/dev_r5107_NOC_MEDUSA/NEMOGCM/NEMO/TOP_SRC/trcini.F90 @ 5715

Last change on this file since 5715 was 5715, checked in by acc, 9 years ago

Branch NERC/dev_r5107_NOC_MEDUSA. Complete reset of svn keyword properties in a desperate attempt to make fcm_make behave.

File size: 14.4 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 trcdta          ! initialisation from files
30   USE daymod          ! calendar manager
31   USE zpshde          ! partial step: hor. derivative   (zps_hde routine)
32   USE prtctl_trc      ! Print control passive tracers (prt_ctl_trc_init routine)
33   USE trcsub          ! variables to substep passive tracers
34   USE lib_mpp         ! distribued memory computing library
35   USE sbc_oce
36   USE lib_fortran     ! glob_sum
37
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# if defined key_debug_medusa
69      !!INTEGER  ::  globmask                             ! glob_sum tests for debug
70      REAL(wp) ::  globtr, globvl, globtrvol, globmask  ! glob_sum tests for debug
71# endif
72
73
74      !!---------------------------------------------------------------------
75      !
76      IF( nn_timing == 1 )   CALL timing_start('trc_init')
77      !
78      IF(lwp) WRITE(numout,*)
79      IF(lwp) WRITE(numout,*) 'trc_init : initial set up of the passive tracers'
80      IF(lwp) WRITE(numout,*) '~~~~~~~'
81
82      CALL top_alloc()              ! allocate TOP arrays
83
84#if defined key_offline
85      ltrcdm2dc = .FALSE.
86#endif
87
88    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
89    !!!!! CHECK For MEDUSA
90    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
91      IF( ltrcdm2dc )CALL ctl_warn( ' Diurnal cycle on physics but not in PISCES or LOBSTER ' )
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
112      IF( lk_pisces  )       CALL trc_ini_pisces       ! PISCES  bio-model
113      IF( lk_cfc     )       CALL trc_ini_cfc          ! CFC     tracers
114      IF( lk_c14b    )       CALL trc_ini_c14b         ! C14 bomb  tracer
115      IF( lk_my_trc  )       CALL trc_ini_my_trc       ! MY_TRC  tracers
116      IF( lk_medusa  )       CALL trc_ini_medusa       ! MEDUSA  tracers
117      IF( lk_idtra   )       CALL trc_ini_idtra        ! Idealize tracers
118
119# if defined key_debug_medusa
120         IF (lwp) write (numout,*) '------------------------------'
121         IF (lwp) write (numout,*) 'Jpalm - debug'
122         IF (lwp) write (numout,*) ' in trc_init'
123         IF (lwp) write (numout,*) ' sms init OK'
124         IF (lwp) write (numout,*) ' next: open tracer.stat'
125         IF (lwp) write (numout,*) ' '
126         CALL flush(numout)
127# endif
128
129      IF( lwp ) THEN
130         !
131         CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp , narea )
132         !
133      ENDIF
134
135# if defined key_debug_medusa
136         IF (lwp) write (numout,*) '------------------------------'
137         IF (lwp) write (numout,*) 'Jpalm - debug'
138         IF (lwp) write (numout,*) ' in trc_init'
139         IF (lwp) write (numout,*) 'open tracer.stat -- OK'
140         IF (lwp) write (numout,*) ' '
141         CALL flush(numout)
142# endif
143
144
145      IF( ln_trcdta ) THEN
146#if defined key_medusa
147         IF(lwp) WRITE(numout,*) 'AXY: calling trc_dta_init'
148         IF(lwp) CALL flush(numout)
149#endif
150         CALL trc_dta_init(jptra)
151      ENDIF
152
153      IF( ln_rsttr ) THEN
154        !
155#if defined key_medusa
156        IF(lwp) WRITE(numout,*) 'AXY: calling trc_rst_read'
157        IF(lwp) CALL flush(numout)
158#endif
159        CALL trc_rst_read              ! restart from a file
160        !
161      ELSE
162        !
163        IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN  ! Initialisation of tracer from a file that may also be used for damping
164            !
165#if defined key_medusa
166            IF(lwp) WRITE(numout,*) 'AXY: calling wrk_alloc'
167            IF(lwp) CALL flush(numout)
168#endif
169            CALL wrk_alloc( jpi, jpj, jpk, ztrcdta )    ! Memory allocation
170            !
171#if defined key_medusa
172            IF(lwp) WRITE(numout,*) 'AXY: calling trc_dta'
173            IF(lwp) CALL flush(numout)
174#endif
175            DO jn = 1, jptra
176               IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file
177                  jl = n_trc_index(jn) 
178                  CALL trc_dta( nit000, sf_trcdta(jl),rf_trfac(jl) )   ! read tracer data at nit000
179                  ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:)
180                  trn(:,:,:,jn) = ztrcdta(:,:,:) * tmask(:,:,:) 
181                  IF( .NOT.ln_trcdmp .AND. .NOT. ln_trcdmp_clo ) THEN      !== deallocate data structure   ==!
182                     !                                                    (data used only for initialisation)
183                     IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only used to initialize the run'
184                                                  DEALLOCATE( sf_trcdta(jl)%fnow )     !  arrays in the structure
185                     IF( sf_trcdta(jl)%ln_tint )  DEALLOCATE( sf_trcdta(jl)%fdta )
186                     !
187                  ENDIF
188               ENDIF
189            ENDDO
190#if defined key_medusa
191            IF(lwp) WRITE(numout,*) 'AXY: calling wrk_dealloc'
192            IF(lwp) CALL flush(numout)
193#endif
194            CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta )
195        ENDIF
196        !
197# if defined key_debug_medusa
198         IF (lwp) write (numout,*) '------------------------------'
199         IF (lwp) write (numout,*) 'Jpalm - debug'
200         IF (lwp) write (numout,*) ' in trc_init'
201         IF (lwp) write (numout,*) ' before trb = trn'
202         IF (lwp) write (numout,*) ' '
203         CALL flush(numout)
204# endif
205        !
206        trb(:,:,:,:) = trn(:,:,:,:)
207        !
208# if defined key_debug_medusa
209         IF (lwp) write (numout,*) '------------------------------'
210         IF (lwp) write (numout,*) 'Jpalm - debug'
211         IF (lwp) write (numout,*) ' in trc_init'
212         IF (lwp) write (numout,*) ' trb = trn -- OK'
213         IF (lwp) write (numout,*) ' '
214         CALL flush(numout)
215# endif
216        !
217      ENDIF
218 
219      tra(:,:,:,:) = 0._wp
220      IF( ln_zps .AND. .NOT. lk_c1d )   &              ! Partial steps: before horizontal gradient of passive
221        &    CALL zps_hde( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, sgtu=gtrui, sgtv=gtrvi )       ! tracers at the bottom ocean level
222      !
223# if defined key_debug_medusa
224         IF (lwp) write (numout,*) '------------------------------'
225         IF (lwp) write (numout,*) 'Jpalm - debug'
226         IF (lwp) write (numout,*) ' in trc_init'
227         IF (lwp) write (numout,*) ' partial step -- OK'
228         IF (lwp) write (numout,*) ' '
229         CALL flush(numout)
230# endif
231      !
232      IF( nn_dttrc /= 1 )        CALL trc_sub_ini      ! Initialize variables for substepping passive tracers
233      !
234# if defined key_debug_medusa
235         IF (lwp) write (numout,*) '------------------------------'
236         IF (lwp) write (numout,*) 'Jpalm - debug'
237         IF (lwp) write (numout,*) ' in trc_init'
238         IF (lwp) write (numout,*) ' before initiate tracer contents'
239         IF (lwp) write (numout,*) ' '
240         CALL flush(numout)
241# endif
242      !
243# if defined key_debug_medusa
244         write (*,*) narea,' TRCINI ','Jpalm - debug'
245         write (*,*) narea,' TRCINI ','LN_CTL = TRUE '
246         write (*,*) narea,' TRCINI ','---------------------------------'
247      CALL flush(numout)
248      globmask  = glob_sum( tmask(:,:,:))
249      IF (lwp) write (numout,*) 'glob_sum test, sum tmask : ',globmask 
250# endif
251      !
252      trai(:) = 0._wp                                                   ! initial content of all tracers
253      DO jn = 1, jptra
254# if defined key_debug_medusa
255         globtr    = glob_sum( trn(:,:,:,jn))
256         globvl    = glob_sum( cvol(:,:,:))
257         globtrvol = glob_sum( trn(:,:,:,jn) * cvol(:,:,:)) 
258         !
259         IF (lwp) write (numout,*) 'var number : ',jn
260         CALL flush(numout)
261         IF (lwp) write (numout,*) 'trai(jn) before - should be 0 - ',trai(jn)
262         CALL flush(numout)
263         IF (lwp) write (numout,*) 'global Ocean volume  :          ',globvl
264         CALL flush(numout)
265         IF (lwp) write (numout,*) 'global sum of tracer :          ',globtr
266         CALL flush(numout)
267         IF (lwp) write (numout,*) 'global weighted tracer  :       ',globtrvol
268         CALL flush(numout)
269# endif
270         trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   )
271      END DO
272
273      IF(lwp) THEN               ! control print
274         WRITE(numout,*)
275         WRITE(numout,*)
276         WRITE(numout,*) '          *** Total number of passive tracer jptra = ', jptra
277         WRITE(numout,*) '          *** Total volume of ocean                = ', areatot
278         WRITE(numout,*) '          *** Total inital content of all tracers '
279         WRITE(numout,*)
280# if defined key_debug_medusa
281         CALL flush(numout)
282# endif
283         !
284# if defined key_debug_medusa
285         WRITE(numout,*) ' litle check :  ', ctrcnm(1)
286         CALL flush(numout)
287# endif
288         DO jn = 1, jptra
289            WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn)
290         ENDDO
291         WRITE(numout,*)
292      ENDIF
293      IF(lwp) WRITE(numout,*)
294      IF(ln_ctl) THEN            ! print mean trends (used for debugging)
295         CALL prt_ctl_trc_init
296         WRITE(charout, FMT="('ini ')")
297         CALL prt_ctl_trc_info( charout )
298         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )
299      ENDIF
300
301      IF(lwp) WRITE(numout,*)
302      IF(lwp) WRITE(numout,*) 'trc_init : passive tracer set up completed'
303      IF(lwp) WRITE(numout,*) '~~~~~~~'
304      IF(lwp) CALL flush(numout)
305
3069000  FORMAT(' tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10)
307      !
308      IF( nn_timing == 1 )   CALL timing_stop('trc_init')
309      !
310   END SUBROUTINE trc_init
311
312
313   SUBROUTINE top_alloc
314      !!----------------------------------------------------------------------
315      !!                     ***  ROUTINE top_alloc  ***
316      !!
317      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
318      !!----------------------------------------------------------------------
319      USE trcadv        , ONLY:   trc_adv_alloc          ! TOP-related alloc routines...
320      USE trc           , ONLY:   trc_alloc
321      USE trcnxt        , ONLY:   trc_nxt_alloc
322      USE trczdf        , ONLY:   trc_zdf_alloc
323      USE trdtrc_oce    , ONLY:   trd_trc_oce_alloc
324#if defined key_trdmxl_trc 
325      USE trdmxl_trc    , ONLY:   trd_mxl_trc_alloc
326#endif
327      !
328      INTEGER :: ierr
329      !!----------------------------------------------------------------------
330      !
331      ierr =        trc_adv_alloc()          ! Start of TOP-related alloc routines...
332      ierr = ierr + trc_alloc    ()
333      ierr = ierr + trc_nxt_alloc()
334      ierr = ierr + trc_zdf_alloc()
335      ierr = ierr + trd_trc_oce_alloc()
336#if defined key_trdmxl_trc 
337      ierr = ierr + trd_mxl_trc_alloc()
338#endif
339      !
340      IF( lk_mpp    )   CALL mpp_sum( ierr )
341      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'top_alloc : unable to allocate standard ocean arrays' )
342      !
343   END SUBROUTINE top_alloc
344
345#else
346   !!----------------------------------------------------------------------
347   !!  Empty module :                                     No passive tracer
348   !!----------------------------------------------------------------------
349CONTAINS
350   SUBROUTINE trc_init                      ! Dummy routine   
351   END SUBROUTINE trc_init
352#endif
353
354   !!======================================================================
355END MODULE trcini
Note: See TracBrowser for help on using the repository browser.