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.
trcdta.F90 in branches/NERC/dev_r5107_NOC_MEDUSA/NEMOGCM/NEMO/TOP_SRC – NEMO

source: branches/NERC/dev_r5107_NOC_MEDUSA/NEMOGCM/NEMO/TOP_SRC/trcdta.F90 @ 5712

Last change on this file since 5712 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.
  • Property svn:keywords set to Id
File size: 13.0 KB
Line 
1MODULE trcdta
2   !!======================================================================
3   !!                     ***  MODULE  trcdta  ***
4   !! TOP :  reads passive tracer data
5   !!=====================================================================
6   !! History :   1.0  !  2002-04  (O. Aumont)  original code
7   !!              -   !  2004-03  (C. Ethe)  module
8   !!              -   !  2005-03  (O. Aumont, A. El Moussaoui) F90
9   !!            3.4   !  2010-11  (C. Ethe, G. Madec)  use of fldread + dynamical allocation
10   !!            3.5   !  2013-08  (M. Vichi)  generalization for other BGC models
11   !!----------------------------------------------------------------------
12#if  defined key_top 
13   !!----------------------------------------------------------------------
14   !!   'key_top'                                                TOP model
15   !!----------------------------------------------------------------------
16   !!   trc_dta    : read and time interpolated passive tracer data
17   !!----------------------------------------------------------------------
18   USE par_trc       !  passive tracers parameters
19   USE oce_trc       !  shared variables between ocean and passive tracers
20   USE trc           !  passive tracers common variables
21   USE iom           !  I/O manager
22   USE lib_mpp       !  MPP library
23   USE fldread       !  read input fields
24
25   IMPLICIT NONE
26   PRIVATE
27
28   PUBLIC   trc_dta         ! called in trcini.F90 and trcdmp.F90
29   PUBLIC   trc_dta_init    ! called in trcini.F90
30
31   INTEGER  , SAVE, PUBLIC                             :: nb_trcdta   ! number of tracers to be initialised with data
32   INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_index ! indice of tracer which is initialised with data
33   INTEGER  , SAVE, PUBLIC                             :: ntra        ! MAX( 1, nb_trcdta ) to avoid compilation error with bounds checking
34   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trfac    ! multiplicative factor for tracer values
35!$AGRIF_DO_NOT_TREAT
36   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcdta   ! structure of input SST (file informations, fields read)
37!$AGRIF_END_DO_NOT_TREAT
38   !! * Substitutions
39#  include "domzgr_substitute.h90"
40   !!----------------------------------------------------------------------
41   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
42   !! $Id$
43   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
44   !!----------------------------------------------------------------------
45CONTAINS
46
47   SUBROUTINE trc_dta_init(ntrc)
48      !!----------------------------------------------------------------------
49      !!                   ***  ROUTINE trc_dta_init  ***
50      !!                   
51      !! ** Purpose :   initialisation of passive tracer input data
52      !!
53      !! ** Method  : - Read namtsd namelist
54      !!              - allocates passive tracer data structure
55      !!----------------------------------------------------------------------
56      !
57      INTEGER,INTENT(IN) :: ntrc                             ! number of tracers
58      INTEGER            :: jl, jn                           ! dummy loop indices
59      INTEGER            :: ierr0, ierr1, ierr2, ierr3       ! temporary integers
60      INTEGER            :: ios                              ! Local integer output status for namelist read
61      CHARACTER(len=100) :: clndta, clntrc
62      REAL(wp)           :: zfact
63      !
64      CHARACTER(len=100)            :: cn_dir
65      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i ! array of namelist informations on the fields to read
66      TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcdta
67      REAL(wp)   , DIMENSION(jpmaxtrc) :: rn_trfac    ! multiplicative factor for tracer values
68      !!
69      NAMELIST/namtrc_dta/ sn_trcdta, cn_dir, rn_trfac 
70      !!----------------------------------------------------------------------
71      !
72      IF( nn_timing == 1 )  CALL timing_start('trc_dta_init')
73      !
74      !  Initialisation
75      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0 
76      ! Compute the number of tracers to be initialised with data
77      ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 )
78      IF( ierr0 > 0 ) THEN
79         CALL ctl_stop( 'trc_nam: unable to allocate n_trc_index' )   ;   RETURN
80      ENDIF
81      nb_trcdta      = 0
82      n_trc_index(:) = 0
83      DO jn = 1, ntrc
84         IF( ln_trc_ini(jn) ) THEN
85             nb_trcdta       = nb_trcdta + 1 
86             n_trc_index(jn) = nb_trcdta 
87         ENDIF
88      ENDDO
89      !
90      ntra = MAX( 1, nb_trcdta )   ! To avoid compilation error with bounds checking
91      IF(lwp) THEN
92         WRITE(numout,*) ' '
93         WRITE(numout,*) ' number of passive tracers to be initialize by data :', ntra
94         WRITE(numout,*) ' '
95      ENDIF
96      !
97      REWIND( numnat_ref )              ! Namelist namtrc_dta in reference namelist : Passive tracer input data
98      READ  ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901)
99901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta in reference namelist', lwp )
100
101      REWIND( numnat_cfg )              ! Namelist namtrc_dta in configuration namelist : Passive tracer input data
102      READ  ( numnat_cfg, namtrc_dta, IOSTAT = ios, ERR = 902 )
103902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta in configuration namelist', lwp )
104      IF(lwm) WRITE ( numont, namtrc_dta )
105
106      IF( lwp ) THEN
107         DO jn = 1, ntrc
108            IF( ln_trc_ini(jn) )  THEN    ! open input file only if ln_trc_ini(jn) is true
109               clndta = TRIM( sn_trcdta(jn)%clvar ) 
110               clntrc = TRIM( ctrcnm   (jn)       ) 
111               zfact  = rn_trfac(jn)
112               IF( clndta /=  clntrc ) THEN
113                  CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation :  ',   &
114                  &              'the variable name in the data file : '//clndta//   & 
115                  &              '  must be the same than the name of the passive tracer : '//clntrc//' ')
116               ENDIF
117               WRITE(numout,*) ' read an initial file for passive tracer number :', jn, ' name : ', clndta, & 
118               &               ' multiplicative factor : ', zfact
119            ENDIF
120         END DO
121      ENDIF
122      !
123      IF( nb_trcdta > 0 ) THEN       !  allocate only if the number of tracer to initialise is greater than zero
124         ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 )
125         IF( ierr1 > 0 ) THEN
126            CALL ctl_stop( 'trc_dta_ini: unable to allocate  sf_trcdta structure' )   ;   RETURN
127         ENDIF
128         !
129         DO jn = 1, ntrc
130            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file
131               jl = n_trc_index(jn)
132               slf_i(jl)    = sn_trcdta(jn)
133               rf_trfac(jl) = rn_trfac(jn)
134                                            ALLOCATE( sf_trcdta(jl)%fnow(jpi,jpj,jpk)   , STAT=ierr2 )
135               IF( sn_trcdta(jn)%ln_tint )  ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )
136               IF( ierr2 + ierr3 > 0 ) THEN
137                 CALL ctl_stop( 'trc_dta : unable to allocate passive tracer data arrays' )   ;   RETURN
138               ENDIF
139            ENDIF
140            !   
141         ENDDO
142         !                         ! fill sf_trcdta with slf_i and control print
143         CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta', 'Passive tracer data', 'namtrc' )
144         !
145      ENDIF
146      !
147      DEALLOCATE( slf_i )          ! deallocate local field structure
148      IF( nn_timing == 1 )  CALL timing_stop('trc_dta_init')
149      !
150   END SUBROUTINE trc_dta_init
151
152
153   SUBROUTINE trc_dta( kt, sf_dta, zrf_trfac )
154      !!----------------------------------------------------------------------
155      !!                   ***  ROUTINE trc_dta  ***
156      !!                   
157      !! ** Purpose :   provides passive tracer data at kt
158      !!
159      !! ** Method  : - call fldread routine
160      !!              - s- or mixed z-s coordinate: vertical interpolation on model mesh
161      !!              - ln_trcdmp=F: deallocates the data structure as they are not used
162      !!
163      !! ** Action  :   sf_dta   passive tracer data on medl mesh and interpolated at time-step kt
164      !!----------------------------------------------------------------------
165      INTEGER                     , INTENT(in   ) ::   kt     ! ocean time-step
166      TYPE(FLD), DIMENSION(1)   , INTENT(inout) ::   sf_dta     ! array of information on the field to read
167      REAL(wp)                  , INTENT(in   ) ::   zrf_trfac  ! multiplication factor
168      !
169      INTEGER ::   ji, jj, jk, jl, jkk, ik    ! dummy loop indices
170      REAL(wp)::   zl, zi
171      REAL(wp), DIMENSION(jpk) ::  ztp                ! 1D workspace
172      CHARACTER(len=100) :: clndta
173      !!----------------------------------------------------------------------
174      !
175      IF( nn_timing == 1 )  CALL timing_start('trc_dta')
176      !
177      IF( nb_trcdta > 0 ) THEN
178         !
179         CALL fld_read( kt, 1, sf_dta )      !==   read data at kt time step   ==!
180         !
181         IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==!
182            !
183            IF( kt == nit000 .AND. lwp )THEN
184               WRITE(numout,*)
185               WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh'
186            ENDIF
187            !
188               DO jj = 1, jpj                         ! vertical interpolation of T & S
189                  DO ji = 1, jpi
190                     DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points
191                        zl = fsdept_n(ji,jj,jk)
192                        IF(     zl < gdept_1d(1  ) ) THEN         ! above the first level of data
193                           ztp(jk) =  sf_dta(1)%fnow(ji,jj,1)
194                        ELSEIF( zl > gdept_1d(jpk) ) THEN         ! below the last level of data
195                           ztp(jk) =  sf_dta(1)%fnow(ji,jj,jpkm1)
196                        ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1
197                           DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1)
198                              IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN
199                                 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk))
200                                 ztp(jk) = sf_dta(1)%fnow(ji,jj,jkk) + ( sf_dta(1)%fnow(ji,jj,jkk+1) - &
201                                           sf_dta(1)%fnow(ji,jj,jkk) ) * zi 
202                              ENDIF
203                           END DO
204                        ENDIF
205                     END DO
206                     DO jk = 1, jpkm1
207                        sf_dta(1)%fnow(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord
208                     END DO
209                     sf_dta(1)%fnow(ji,jj,jpk) = 0._wp
210                  END DO
211               END DO
212            !
213         ELSE                                !==   z- or zps- coordinate   ==!
214            !                             
215               sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * tmask(:,:,:)    ! Mask
216               !
217               IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level
218                  DO jj = 1, jpj
219                     DO ji = 1, jpi
220                        ik = mbkt(ji,jj) 
221                        IF( ik > 1 ) THEN
222                           zl = ( gdept_1d(ik) - fsdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
223                           sf_dta(1)%fnow(ji,jj,ik) = (1.-zl) * sf_dta(1)%fnow(ji,jj,ik) + zl * sf_dta(1)%fnow(ji,jj,ik-1)
224                        ENDIF
225                     END DO
226                  END DO
227               ENDIF
228            !
229         ENDIF
230         !
231         sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * zrf_trfac   !  multiplicative factor
232         !
233         IF( lwp .AND. kt == nit000 ) THEN
234               clndta = TRIM( sf_dta(1)%clvar ) 
235               WRITE(numout,*) ''//clndta//' data '
236               WRITE(numout,*)
237               WRITE(numout,*)'  level = 1'
238               CALL prihre( sf_dta(1)%fnow(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
239               WRITE(numout,*)'  level = ', jpk/2
240               CALL prihre( sf_dta(1)%fnow(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
241               WRITE(numout,*)'  level = ', jpkm1
242               CALL prihre( sf_dta(1)%fnow(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
243               WRITE(numout,*)
244         ENDIF
245      ENDIF
246      !
247      IF( nn_timing == 1 )  CALL timing_stop('trc_dta')
248      !
249   END SUBROUTINE trc_dta
250#else
251   !!----------------------------------------------------------------------
252   !!   Dummy module                              NO 3D passive tracer data
253   !!----------------------------------------------------------------------
254CONTAINS
255   SUBROUTINE trc_dta( kt, sf_dta, zrf_trfac )        ! Empty routine
256      WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt
257   END SUBROUTINE trc_dta
258#endif
259   !!======================================================================
260END MODULE trcdta
Note: See TracBrowser for help on using the repository browser.