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 NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/TOP – NEMO

source: NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/TOP/trcini.F90 @ 12749

Last change on this file since 12749 was 12377, checked in by acc, 4 years ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

  • Property svn:keywords set to Id
File size: 13.2 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   !!----------------------------------------------------------------------
11#if defined key_top
12   !!----------------------------------------------------------------------
13   !!   'key_top'                                                TOP models
14   !!----------------------------------------------------------------------
15   !!   trc_init  :   Initialization for passive tracer
16   !!   top_alloc :   allocate the TOP arrays
17   !!----------------------------------------------------------------------
18   USE oce_trc         ! shared variables between ocean and passive tracers
19   USE trc             ! passive tracers common variables
20   USE trcnam          ! Namelist read
21   USE daymod          ! calendar manager
22   USE prtctl_trc      ! Print control passive tracers (prt_ctl_trc_init routine)
23   USE trcrst
24   USE lib_mpp         ! distribued memory computing library
25   USE trcice          ! tracers in sea ice
26   USE trcbc           ! generalized Boundary Conditions
27 
28   IMPLICIT NONE
29   PRIVATE
30   
31   PUBLIC   trc_init   ! called by opa
32
33   !!----------------------------------------------------------------------
34   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
35   !! $Id$
36   !! Software governed by the CeCILL license (see ./LICENSE)
37   !!----------------------------------------------------------------------
38CONTAINS
39   
40   SUBROUTINE trc_init( Kbb, Kmm, Kaa )
41      !!---------------------------------------------------------------------
42      !!                     ***  ROUTINE trc_init  ***
43      !!
44      !! ** Purpose :   Initialization of the passive tracer fields
45      !!
46      !! ** Method  : - read namelist
47      !!              - control the consistancy
48      !!              - compute specific initialisations
49      !!              - set initial tracer fields (either read restart
50      !!                or read data or analytical formulation
51      !!---------------------------------------------------------------------
52      INTEGER, INTENT(in) :: Kbb, Kmm, Kaa   ! time level indices
53      !
54      IF( ln_timing )   CALL timing_start('trc_init')
55      !
56      IF(lwp) WRITE(numout,*)
57      IF(lwp) WRITE(numout,*) 'trc_init : initial set up of the passive tracers'
58      IF(lwp) WRITE(numout,*) '~~~~~~~~'
59      !
60      CALL trc_nam       ! read passive tracers namelists
61      CALL top_alloc()   ! allocate TOP arrays
62
63      !
64      IF(.NOT.ln_trcdta )   ln_trc_ini(:) = .FALSE.
65      !
66      IF(lwp) WRITE(numout,*)
67      IF( ln_rsttr .AND. .NOT. l_offline ) CALL trc_rst_cal( nit000, 'READ' )   ! calendar
68      IF(lwp) WRITE(numout,*)
69      !
70      CALL trc_ini_sms( Kmm )   ! SMS
71      CALL trc_ini_trp          ! passive tracers transport
72      CALL trc_ice_ini          ! Tracers in sea ice
73      !
74      IF( lwm .AND. sn_cfctl%l_trcstat ) THEN
75         CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp , narea )
76      ENDIF
77      !
78      CALL trc_ini_state( Kbb, Kmm, Kaa )  !  passive tracers initialisation : from a restart or from clim
79      !
80      CALL trc_ini_inv( Kmm )              ! Inventories
81      !
82      IF( ln_timing )   CALL timing_stop('trc_init')
83      !
84   END SUBROUTINE trc_init
85
86
87   SUBROUTINE trc_ini_inv( Kmm )
88      !!----------------------------------------------------------------------
89      !!                     ***  ROUTINE trc_ini_stat  ***
90      !! ** Purpose :      passive tracers inventories at initialsation phase
91      !!----------------------------------------------------------------------
92      INTEGER, INTENT(in) ::   Kmm    ! time level index
93      INTEGER             ::  jk, jn  ! dummy loop indices
94      CHARACTER (len=25) :: charout
95      !!----------------------------------------------------------------------
96      !
97      IF(lwp) WRITE(numout,*)
98      IF(lwp) WRITE(numout,*) 'trc_ini_inv : initial passive tracers inventories'
99      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
100      !
101      !                          ! masked grid volume
102      DO jk = 1, jpk
103         cvol(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk)
104      END DO
105      !                          ! total volume of the ocean
106      areatot = glob_sum( 'trcini', cvol(:,:,:) )
107      !
108      trai(:) = 0._wp            ! initial content of all tracers
109      DO jn = 1, jptra
110         trai(jn) = trai(jn) + glob_sum( 'trcini', tr(:,:,:,jn,Kmm) * cvol(:,:,:)   )
111      END DO
112
113      IF(lwp) THEN               ! control print
114         WRITE(numout,*)
115         WRITE(numout,*) '   ==>>>   Total number of passive tracer jptra = ', jptra
116         WRITE(numout,*) '           Total volume of ocean                = ', areatot
117         WRITE(numout,*) '           Total inital content of all tracers '
118         WRITE(numout,*)
119         DO jn = 1, jptra
120            WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn)
121         ENDDO
122         WRITE(numout,*)
123      ENDIF
124      IF(lwp) WRITE(numout,*)
125      IF(sn_cfctl%l_prttrc) THEN            ! print mean trends (used for debugging)
126         CALL prt_ctl_trc_init
127         WRITE(charout, FMT="('ini ')")
128         CALL prt_ctl_trc_info( charout )
129         CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm )
130      ENDIF
1319000  FORMAT('      tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10)
132      !
133   END SUBROUTINE trc_ini_inv
134
135
136   SUBROUTINE trc_ini_sms( Kmm )
137      !!----------------------------------------------------------------------
138      !!                     ***  ROUTINE trc_ini_sms  ***
139      !! ** Purpose :   SMS initialisation
140      !!----------------------------------------------------------------------
141      USE trcini_pisces  ! PISCES   initialisation
142      USE trcini_cfc     ! CFC      initialisation
143      USE trcini_c14     ! C14  initialisation
144      USE trcini_age     ! age initialisation
145      USE trcini_my_trc  ! MY_TRC   initialisation
146      !
147      INTEGER, INTENT(in) ::   Kmm ! time level indices
148      INTEGER :: jn
149      !!----------------------------------------------------------------------
150      !
151      ! Pass sn_tracer fields to specialized arrays
152      DO jn = 1, jp_bgc
153         ctrcnm    (jn) = TRIM( sn_tracer(jn)%clsname )
154         ctrcln    (jn) = TRIM( sn_tracer(jn)%cllname )
155         ctrcun    (jn) = TRIM( sn_tracer(jn)%clunit  )
156         ln_trc_ini(jn) =       sn_tracer(jn)%llinit
157         ln_trc_sbc(jn) =       sn_tracer(jn)%llsbc
158         ln_trc_cbc(jn) =       sn_tracer(jn)%llcbc
159         ln_trc_obc(jn) =       sn_tracer(jn)%llobc
160      END DO
161      !
162      IF( .NOT.ln_trcbc ) THEN
163         DO jn = 1, jp_bgc
164            ln_trc_sbc(jn) = .FALSE.
165            ln_trc_cbc(jn) = .FALSE.
166            ln_trc_obc(jn) = .FALSE.
167         END DO
168      ENDIF
169     
170      lltrcbc = ( COUNT(ln_trc_sbc) + COUNT(ln_trc_obc) + COUNT(ln_trc_cbc) ) > 0 
171      !   
172      IF( ln_pisces      )   CALL trc_ini_pisces( Kmm )     !  PISCES model
173      IF( ln_my_trc      )   CALL trc_ini_my_trc( Kmm )     !  MY_TRC model
174      IF( ll_cfc         )   CALL trc_ini_cfc   ( Kmm )     !  CFC's
175      IF( ln_c14         )   CALL trc_ini_c14   ( Kmm )     !  C14 model
176      IF( ln_age         )   CALL trc_ini_age   ( Kmm )     !  AGE
177      !
178      IF(lwp) THEN                   ! control print
179         WRITE(numout,*)
180         WRITE(numout,*) 'trc_init_sms : Summary for selected passive tracers'
181         WRITE(numout,*) '~~~~~~~~~~~~'
182         WRITE(numout,*) '    ID     NAME     INI  SBC  CBC  OBC'
183         DO jn = 1, jptra
184            WRITE(numout,9001) jn, TRIM(ctrcnm(jn)), ln_trc_ini(jn), ln_trc_sbc(jn),ln_trc_cbc(jn),ln_trc_obc(jn)
185         END DO
186      ENDIF
187      IF( lwp .AND. ln_trcbc .AND. lltrcbc ) THEN
188         WRITE(numout,*)
189         WRITE(numout,*) ' Applying tracer boundary conditions '
190      ENDIF
191     
1929001  FORMAT(3x,i3,1x,a10,3x,l2,3x,l2,3x,l2,3x,l2)
193      !
194   END SUBROUTINE trc_ini_sms
195
196
197   SUBROUTINE trc_ini_trp
198      !!----------------------------------------------------------------------
199      !!                     ***  ROUTINE trc_ini_trp  ***
200      !!
201      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
202      !!----------------------------------------------------------------------
203      USE trcdmp , ONLY:  trc_dmp_ini
204      USE trcadv , ONLY:  trc_adv_ini
205      USE trcldf , ONLY:  trc_ldf_ini
206      USE trcrad , ONLY:  trc_rad_ini
207      USE trcsink, ONLY:  trc_sink_ini
208      !
209      INTEGER :: ierr
210      !!----------------------------------------------------------------------
211      !
212      IF( ln_trcdmp )  CALL  trc_dmp_ini          ! damping
213                       CALL  trc_adv_ini          ! advection
214                       CALL  trc_ldf_ini          ! lateral diffusion
215                       !                          ! vertical diffusion: always implicit time stepping scheme
216                       CALL  trc_rad_ini          ! positivity of passive tracers
217                       CALL  trc_sink_ini         ! Vertical sedimentation of particles
218      !
219   END SUBROUTINE trc_ini_trp
220
221
222   SUBROUTINE trc_ini_state( Kbb, Kmm, Kaa )
223      !!----------------------------------------------------------------------
224      !!                     ***  ROUTINE trc_ini_state ***
225      !! ** Purpose :          Initialisation of passive tracer concentration
226      !!----------------------------------------------------------------------
227      USE zpshde          ! partial step: hor. derivative   (zps_hde routine)
228      USE trcrst          ! passive tracers restart
229      USE trcdta          ! initialisation from files
230      !
231      INTEGER, INTENT(in) :: Kbb, Kmm, Kaa   ! time level index
232      INTEGER             :: jn, jl          ! dummy loop indices
233      !!----------------------------------------------------------------------
234      !
235      IF( ln_trcdta )   CALL trc_dta_ini( jptra )           ! set initial tracers values
236      !
237      IF( ln_trcbc .AND. lltrcbc )  THEN
238        CALL trc_bc_ini ( jptra, Kmm  )            ! set tracers Boundary Conditions
239        CALL trc_bc     ( nit000, Kmm, tr, Kaa )   ! tracers: surface and lateral Boundary Conditions
240      ENDIF
241      !
242      !
243      IF( ln_rsttr ) THEN              ! restart from a file
244        !
245        CALL trc_rst_read( Kbb, Kmm )
246        !
247      ELSE                             ! Initialisation of tracer from a file that may also be used for damping
248!!gm BUG ?   if damping and restart, what's happening ?
249        IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN
250            ! update passive tracers arrays with input data read from file
251            DO jn = 1, jptra
252               IF( ln_trc_ini(jn) ) THEN
253                  jl = n_trc_index(jn) 
254                  CALL trc_dta( nit000, Kmm, sf_trcdta(jl), rf_trfac(jl), tr(:,:,:,jn,Kmm) )
255                  !
256                  ! deallocate data structure if data are not used for damping
257                  IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN
258                     IF(lwp) WRITE(numout,*) 'trc_ini_state: deallocate data arrays as they are only used to initialize the run'
259                                                  DEALLOCATE( sf_trcdta(jl)%fnow )
260                     IF( sf_trcdta(jl)%ln_tint )  DEALLOCATE( sf_trcdta(jl)%fdta )
261                     !
262                  ENDIF
263               ENDIF
264            END DO
265            !
266        ENDIF
267        !
268        tr(:,:,:,:,Kbb) = tr(:,:,:,:,Kmm)
269        !
270      ENDIF
271      !
272      tr(:,:,:,:,Kaa) = 0._wp
273      !                                                         ! Partial top/bottom cell: GRADh(tr(Kmm))
274   END SUBROUTINE trc_ini_state
275
276
277   SUBROUTINE top_alloc
278      !!----------------------------------------------------------------------
279      !!                     ***  ROUTINE top_alloc  ***
280      !!
281      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
282      !!----------------------------------------------------------------------
283      USE trc           , ONLY:   trc_alloc
284      USE trdtrc_oce    , ONLY:   trd_trc_oce_alloc
285#if defined key_trdmxl_trc 
286      USE trdmxl_trc    , ONLY:   trd_mxl_trc_alloc
287#endif
288      !
289      INTEGER ::   ierr   ! local integer
290      !!----------------------------------------------------------------------
291      !
292      ierr =        trc_alloc()
293      ierr = ierr + trd_trc_oce_alloc()
294#if defined key_trdmxl_trc 
295      ierr = ierr + trd_mxl_trc_alloc()
296#endif
297      !
298      CALL mpp_sum( 'trcini', ierr )
299      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'top_alloc : unable to allocate standard ocean arrays' )
300      !
301   END SUBROUTINE top_alloc
302
303#else
304   !!----------------------------------------------------------------------
305   !!  Empty module :                                     No passive tracer
306   !!----------------------------------------------------------------------
307CONTAINS
308   SUBROUTINE trc_init                      ! Dummy routine   
309   END SUBROUTINE trc_init
310#endif
311
312   !!======================================================================
313END MODULE trcini
Note: See TracBrowser for help on using the repository browser.