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/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/TOP_SRC – NEMO

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, 11 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.