source: branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/TOP_SRC/trcdta.F90 @ 4148

Last change on this file since 4148 was 4148, checked in by cetlod, 8 years ago

merge in trunk changes between r3853 and r3940 and commit the changes, see ticket #1169

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