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.
trcbc.F90 in trunk/NEMOGCM/NEMO/TOP_SRC – NEMO

source: trunk/NEMOGCM/NEMO/TOP_SRC/trcbc.F90 @ 4990

Last change on this file since 4990 was 4624, checked in by acc, 10 years ago

#1305. Fix slow start-up problems on some systems by introducing and using lwm logical to restrict output of merged namelists to the first (or only) processor. lwm is true only on the first processor regardless of ln_ctl. Small changes to all flavours of nemogcm.F90 are also required to write namctl and namcfg after the call to mynode which now opens output.namelist.dyn and writes nammpp.
File size: 15.4 KB
Line 
1MODULE trcbc
2   !!======================================================================
3   !!                     ***  MODULE  trcdta  ***
4   !! TOP :  module for passive tracer boundary conditions
5   !!=====================================================================
6   !!----------------------------------------------------------------------
7#if  defined key_top 
8   !!----------------------------------------------------------------------
9   !!   'key_top'                                                TOP model
10   !!----------------------------------------------------------------------
11   !!   trc_dta    : read and time interpolated passive tracer data
12   !!----------------------------------------------------------------------
13   USE par_trc       !  passive tracers parameters
14   USE oce_trc       !  shared variables between ocean and passive tracers
15   USE trc           !  passive tracers common variables
16   USE iom           !  I/O manager
17   USE lib_mpp       !  MPP library
18   USE fldread       !  read input fields
19
20   IMPLICIT NONE
21   PRIVATE
22
23   PUBLIC   trc_bc_init    ! called in trcini.F90
24   PUBLIC   trc_bc_read    ! called in trcstp.F90 or within
25
26   INTEGER  , SAVE, PUBLIC                             :: nb_trcobc   ! number of tracers with open BC
27   INTEGER  , SAVE, PUBLIC                             :: nb_trcsbc   ! number of tracers with surface BC
28   INTEGER  , SAVE, PUBLIC                             :: nb_trccbc   ! number of tracers with coastal BC
29   INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_indobc ! index of tracer with OBC data
30   INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_indsbc ! index of tracer with SBC data
31   INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_indcbc ! index of tracer with CBC data
32   INTEGER  , SAVE, PUBLIC                             :: ntra_obc     ! MAX( 1, nb_trcxxx ) to avoid compilation error with bounds checking
33   INTEGER  , SAVE, PUBLIC                             :: ntra_sbc     ! MAX( 1, nb_trcxxx ) to avoid compilation error with bounds checking
34   INTEGER  , SAVE, PUBLIC                             :: ntra_cbc     ! MAX( 1, nb_trcxxx ) to avoid compilation error with bounds checking
35   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trofac   ! multiplicative factor for OBCtracer values
36   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcobc   ! structure of data input OBC (file informations, fields read)
37   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trsfac   ! multiplicative factor for SBC tracer values
38   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcsbc   ! structure of data input SBC (file informations, fields read)
39   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trcfac   ! multiplicative factor for CBC tracer values
40   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trccbc   ! structure of data input CBC (file informations, fields read)
41
42   !! * Substitutions
43#  include "domzgr_substitute.h90"
44   !!----------------------------------------------------------------------
45   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
46   !! $Id: trcdta.F90 2977 2011-10-22 13:46:41Z cetlod $
47   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
48   !!----------------------------------------------------------------------
49CONTAINS
50
51   SUBROUTINE trc_bc_init(ntrc)
52      !!----------------------------------------------------------------------
53      !!                   ***  ROUTINE trc_bc_init  ***
54      !!                   
55      !! ** Purpose :   initialisation of passive tracer BC data
56      !!
57      !! ** Method  : - Read namtsd namelist
58      !!              - allocates passive tracer BC data structure
59      !!----------------------------------------------------------------------
60      !
61      INTEGER,INTENT(IN) :: ntrc                           ! number of tracers
62      INTEGER            :: jl, jn                         ! dummy loop indices
63      INTEGER            :: ierr0, ierr1, ierr2, ierr3     ! temporary integers
64      INTEGER            ::  ios                           ! Local integer output status for namelist read
65      CHARACTER(len=100) :: clndta, clntrc
66      !
67      CHARACTER(len=100) :: cn_dir
68      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i  ! local array of namelist informations on the fields to read
69      TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcobc    ! open
70      TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcsbc    ! surface
71      TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trccbc    ! coastal
72      REAL(wp)   , DIMENSION(jpmaxtrc) :: rn_trofac    ! multiplicative factor for tracer values
73      REAL(wp)   , DIMENSION(jpmaxtrc) :: rn_trsfac    ! multiplicative factor for tracer values
74      REAL(wp)   , DIMENSION(jpmaxtrc) :: rn_trcfac    ! multiplicative factor for tracer values
75      !!
76      NAMELIST/namtrc_bc/ cn_dir, sn_trcobc, rn_trofac, sn_trcsbc, rn_trsfac, sn_trccbc, rn_trcfac 
77      !!----------------------------------------------------------------------
78      IF( nn_timing == 1 )  CALL timing_start('trc_bc_init')
79      !
80      !  Initialisation and local array allocation
81      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0 
82      ALLOCATE( slf_i(ntrc), STAT=ierr0 )
83      IF( ierr0 > 0 ) THEN
84         CALL ctl_stop( 'trc_bc_init: unable to allocate local slf_i' )   ;   RETURN
85      ENDIF
86
87      ! Compute the number of tracers to be initialised with open, surface and boundary data
88      ALLOCATE( n_trc_indobc(ntrc), STAT=ierr0 )
89      IF( ierr0 > 0 ) THEN
90         CALL ctl_stop( 'trc_bc_init: unable to allocate n_trc_indobc' )   ;   RETURN
91      ENDIF
92      nb_trcobc      = 0
93      n_trc_indobc(:) = 0
94      !
95      ALLOCATE( n_trc_indsbc(ntrc), STAT=ierr0 )
96      IF( ierr0 > 0 ) THEN
97         CALL ctl_stop( 'trc_bc_init: unable to allocate n_trc_indsbc' )   ;   RETURN
98      ENDIF
99      nb_trcsbc      = 0
100      n_trc_indsbc(:) = 0
101      !
102      ALLOCATE( n_trc_indcbc(ntrc), STAT=ierr0 )
103      IF( ierr0 > 0 ) THEN
104         CALL ctl_stop( 'trc_bc_init: unable to allocate n_trc_indcbc' )   ;   RETURN
105      ENDIF
106      nb_trccbc      = 0
107      n_trc_indcbc(:) = 0
108      !
109      DO jn = 1, ntrc
110         IF( ln_trc_obc(jn) ) THEN
111             nb_trcobc       = nb_trcobc + 1 
112             n_trc_indobc(jn) = nb_trcobc 
113         ENDIF
114         IF( ln_trc_sbc(jn) ) THEN
115             nb_trcsbc       = nb_trcsbc + 1
116             n_trc_indsbc(jn) = nb_trcsbc
117         ENDIF
118         IF( ln_trc_cbc(jn) ) THEN
119             nb_trccbc       = nb_trccbc + 1
120             n_trc_indcbc(jn) = nb_trccbc
121         ENDIF
122      ENDDO
123      ntra_obc = MAX( 1, nb_trcobc )   ! To avoid compilation error with bounds checking
124      IF( lwp ) WRITE(numout,*) ' '
125      IF( lwp ) WRITE(numout,*) ' Number of passive tracers to be initialized with open boundary data :', nb_trcobc
126      IF( lwp ) WRITE(numout,*) ' '
127      ntra_sbc = MAX( 1, nb_trcsbc )   ! To avoid compilation error with bounds checking
128      IF( lwp ) WRITE(numout,*) ' '
129      IF( lwp ) WRITE(numout,*) ' Number of passive tracers to be initialized with surface boundary data :', nb_trcsbc
130      IF( lwp ) WRITE(numout,*) ' '
131      ntra_cbc = MAX( 1, nb_trccbc )   ! To avoid compilation error with bounds checking
132      IF( lwp ) WRITE(numout,*) ' '
133      IF( lwp ) WRITE(numout,*) ' Number of passive tracers to be initialized with coastal boundary data :', nb_trccbc
134      IF( lwp ) WRITE(numout,*) ' '
135
136      REWIND( numnat_ref )              ! Namelist namtrc_bc in reference namelist : Passive tracer data structure
137      READ  ( numnat_ref, namtrc_bc, IOSTAT = ios, ERR = 901)
138901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bc in reference namelist', lwp )
139
140      REWIND( numnat_cfg )              ! Namelist namtrc_bc in configuration namelist : Passive tracer data structure
141      READ  ( numnat_cfg, namtrc_bc, IOSTAT = ios, ERR = 902 )
142902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bc in configuration namelist', lwp )
143      IF(lwm) WRITE ( numont, namtrc_bc )
144
145      ! print some information for each
146      IF( lwp ) THEN
147         DO jn = 1, ntrc
148            IF( ln_trc_obc(jn) )  THEN   
149               clndta = TRIM( sn_trcobc(jn)%clvar ) 
150               IF(lwp) WRITE(numout,*) 'Preparing to read OBC data file for passive tracer number :', jn, ' name : ', clndta, & 
151               &               ' multiplicative factor : ', rn_trofac(jn)
152            ENDIF
153            IF( ln_trc_sbc(jn) )  THEN   
154               clndta = TRIM( sn_trcsbc(jn)%clvar ) 
155               IF(lwp) WRITE(numout,*) 'Preparing to read SBC data file for passive tracer number :', jn, ' name : ', clndta, & 
156               &               ' multiplicative factor : ', rn_trsfac(jn)
157            ENDIF
158            IF( ln_trc_cbc(jn) )  THEN   
159               clndta = TRIM( sn_trccbc(jn)%clvar ) 
160               IF(lwp) WRITE(numout,*) 'Preparing to read CBC data file for passive tracer number :', jn, ' name : ', clndta, & 
161               &               ' multiplicative factor : ', rn_trcfac(jn)
162            ENDIF
163         END DO
164      ENDIF
165      !
166      ! The following code is written this way to reduce memory usage and repeated for each boundary data
167      ! MAV: note that this is just a placeholder and the dimensions must be changed according to
168      !      what will be done with BDY. A new structure will probably need to be included
169      !
170      ! OPEN Lateral boundary conditions
171      IF( nb_trcobc > 0 ) THEN       !  allocate only if the number of tracer to initialise is greater than zero
172         ALLOCATE( sf_trcobc(nb_trcobc), rf_trofac(nb_trcobc), STAT=ierr1 )
173         IF( ierr1 > 0 ) THEN
174            CALL ctl_stop( 'trc_bc_init: unable to allocate  sf_trcobc structure' )   ;   RETURN
175         ENDIF
176         !
177         DO jn = 1, ntrc
178            IF( ln_trc_obc(jn) ) THEN      ! update passive tracers arrays with input data read from file
179               jl = n_trc_indobc(jn)
180               slf_i(jl)    = sn_trcobc(jn)
181               rf_trofac(jl) = rn_trofac(jn)
182                                            ALLOCATE( sf_trcobc(jl)%fnow(jpi,jpj,jpk)   , STAT=ierr2 )
183               IF( sn_trcobc(jn)%ln_tint )  ALLOCATE( sf_trcobc(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )
184               IF( ierr2 + ierr3 > 0 ) THEN
185                 CALL ctl_stop( 'trc_bc_init : unable to allocate passive tracer OBC data arrays' )   ;   RETURN
186               ENDIF
187            ENDIF
188            !   
189         ENDDO
190         !                         ! fill sf_trcdta with slf_i and control print
191         CALL fld_fill( sf_trcobc, slf_i, cn_dir, 'trc_bc_init', 'Passive tracer OBC data', 'namtrc_bc' )
192         !
193      ENDIF
194      !
195      ! SURFACE Boundary conditions
196      IF( nb_trcsbc > 0 ) THEN       !  allocate only if the number of tracer to initialise is greater than zero
197         ALLOCATE( sf_trcsbc(nb_trcsbc), rf_trsfac(nb_trcsbc), STAT=ierr1 )
198         IF( ierr1 > 0 ) THEN
199            CALL ctl_stop( 'trc_bc_init: unable to allocate  sf_trcsbc structure' )   ;   RETURN
200         ENDIF
201         !
202         DO jn = 1, ntrc
203            IF( ln_trc_sbc(jn) ) THEN      ! update passive tracers arrays with input data read from file
204               jl = n_trc_indsbc(jn)
205               slf_i(jl)    = sn_trcsbc(jn)
206               rf_trsfac(jl) = rn_trsfac(jn)
207                                            ALLOCATE( sf_trcsbc(jl)%fnow(jpi,jpj,1)   , STAT=ierr2 )
208               IF( sn_trcsbc(jn)%ln_tint )  ALLOCATE( sf_trcsbc(jl)%fdta(jpi,jpj,1,2) , STAT=ierr3 )
209               IF( ierr2 + ierr3 > 0 ) THEN
210                 CALL ctl_stop( 'trc_bc_init : unable to allocate passive tracer SBC data arrays' )   ;   RETURN
211               ENDIF
212            ENDIF
213            !   
214         ENDDO
215         !                         ! fill sf_trcsbc with slf_i and control print
216         CALL fld_fill( sf_trcsbc, slf_i, cn_dir, 'trc_bc_init', 'Passive tracer SBC data', 'namtrc_bc' )
217         !
218      ENDIF
219      !
220      ! COSTAL Boundary conditions
221      IF( nb_trccbc > 0 ) THEN       !  allocate only if the number of tracer to initialise is greater than zero
222         ALLOCATE( sf_trccbc(nb_trccbc), rf_trcfac(nb_trccbc), STAT=ierr1 )
223         IF( ierr1 > 0 ) THEN
224            CALL ctl_stop( 'trc_bc_ini: unable to allocate  sf_trccbc structure' )   ;   RETURN
225         ENDIF
226         !
227         DO jn = 1, ntrc
228            IF( ln_trc_cbc(jn) ) THEN      ! update passive tracers arrays with input data read from file
229               jl = n_trc_indcbc(jn)
230               slf_i(jl)    = sn_trccbc(jn)
231               rf_trcfac(jl) = rn_trcfac(jn)
232                                            ALLOCATE( sf_trccbc(jl)%fnow(jpi,jpj,1)   , STAT=ierr2 )
233               IF( sn_trccbc(jn)%ln_tint )  ALLOCATE( sf_trccbc(jl)%fdta(jpi,jpj,1,2) , STAT=ierr3 )
234               IF( ierr2 + ierr3 > 0 ) THEN
235                 CALL ctl_stop( 'trc_bc_ini : unable to allocate passive tracer CBC data arrays' )   ;   RETURN
236               ENDIF
237            ENDIF
238            !   
239         ENDDO
240         !                         ! fill sf_trccbc with slf_i and control print
241         CALL fld_fill( sf_trccbc, slf_i, cn_dir, 'trc_bc_init', 'Passive tracer CBC data', 'namtrc_bc' )
242         !
243      ENDIF
244 
245      DEALLOCATE( slf_i )          ! deallocate local field structure
246      IF( nn_timing == 1 )  CALL timing_stop('trc_bc_init')
247
248   END SUBROUTINE trc_bc_init
249
250
251   SUBROUTINE trc_bc_read(kt)
252      !!----------------------------------------------------------------------
253      !!                   ***  ROUTINE trc_bc_init  ***
254      !!
255      !! ** Purpose :  Read passive tracer Boundary Conditions data
256      !!
257      !! ** Method  :  Read BC inputs and update data structures using fldread
258      !!             
259      !!----------------------------------------------------------------------
260   
261      ! NEMO
262      USE fldread
263     
264      !! * Arguments
265      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
266
267      !!---------------------------------------------------------------------
268      !
269      IF( nn_timing == 1 )  CALL timing_start('trc_bc_read')
270
271      IF( kt == nit000 ) THEN
272         IF(lwp) WRITE(numout,*)
273         IF(lwp) WRITE(numout,*) 'trc_bc_read : Surface boundary conditions for passive tracers.'
274         IF(lwp) WRITE(numout,*) '~~~~~~~ '
275      ENDIF
276
277      ! OPEN boundary conditions: DOES NOT WORK. Waiting for stable BDY
278      IF( nb_trcobc > 0 ) THEN
279        if (lwp) write(numout,'(a,i5,a,i5)') '   reading OBC data for ', nb_trcobc ,' variables at step ', kt
280        CALL fld_read(kt,1,sf_trcobc)
281        ! vertical interpolation on s-grid and partial step to be added
282      ENDIF
283
284      ! SURFACE boundary conditions       
285      IF( nb_trcsbc > 0 ) THEN
286        if (lwp) write(numout,'(a,i5,a,i5)') '   reading SBC data for ', nb_trcsbc ,' variables at step ', kt
287        CALL fld_read(kt,1,sf_trcsbc)
288      ENDIF
289
290      ! COASTAL boundary conditions       
291      IF( nb_trccbc > 0 ) THEN
292        if (lwp) write(numout,'(a,i5,a,i5)') '   reading CBC data for ', nb_trccbc ,' variables at step ', kt
293        CALL fld_read(kt,1,sf_trccbc)
294      ENDIF   
295      !
296      IF( nn_timing == 1 )  CALL timing_stop('trc_bc_read')
297      !       
298
299   END SUBROUTINE trc_bc_read
300#else
301   !!----------------------------------------------------------------------
302   !!   Dummy module                              NO 3D passive tracer data
303   !!----------------------------------------------------------------------
304CONTAINS
305   SUBROUTINE trc_bc_read( kt )        ! Empty routine
306      WRITE(*,*) 'trc_bc_read: You should not have seen this print! error?', kt
307   END SUBROUTINE trc_bc_read
308#endif
309
310   !!======================================================================
311END MODULE trcbc
Note: See TracBrowser for help on using the repository browser.