source: branches/2013/dev_r3996_CMCC6_topbc/NEMOGCM/NEMO/TOP_SRC/trcdta.F90 @ 4011

Last change on this file since 4011 was 4011, checked in by vichi, 8 years ago

Make a generic interface for trcdta when using other BGCM

This change introduces a more general trcdta structure that
is not strictly dependent on the number of tracers defined
in PISCES. The loop on the number of tracers is moved outside
trcdta and the tracer info and array is passed as an argument.
This allows to use trcdta as a library subroutine by the BFM and
other models.
NOTE: it must be tested throughly with all the PISCES configurations

This commit also updates the GYRE_BFM configuration and corrects
some minor missing cpp keys and real type definitions

  • Property svn:keywords set to Id
File size: 13.5 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  , PARAMETER, PUBLIC                        :: MAXTRC=100  ! maximum number of tracers
32   INTEGER  , SAVE, PUBLIC                             :: nb_trcdta   ! number of tracers to be initialised with data
33   INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_index ! indice of tracer which is initialised with data
34   INTEGER  , SAVE, PUBLIC                             :: ntra        ! MAX( 1, nb_trcdta ) to avoid compilation error with bounds checking
35   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trfac    ! multiplicative factor for tracer values
36   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcdta   ! structure of input SST (file informations, fields read)
37
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
58      INTEGER            :: jl, jn                   ! dummy loop indicies
59      INTEGER            :: ierr0, ierr1, ierr2, ierr3       ! temporary integers
60      CHARACTER(len=100) :: clndta, clntrc
61      REAL(wp)           :: zfact
62      !
63      CHARACTER(len=100) :: cn_dir
64      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i     ! array of namelist informations on the fields to read
65      TYPE(FLD_N), DIMENSION(MAXTRC) :: sn_trcdta
66      REAL(wp)   , DIMENSION(MAXTRC) :: rn_trfac    ! multiplicative factor for tracer values
67      !!
68      NAMELIST/namtrc_dta/ sn_trcdta, cn_dir, rn_trfac 
69      !!----------------------------------------------------------------------
70      !
71      IF( nn_timing == 1 )  CALL timing_start('trc_dta_init')
72      !
73      !  Initialisation
74      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0 
75      ! Compute the number of tracers to be initialised with data
76      ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 )
77      IF( ierr0 > 0 ) THEN
78         CALL ctl_stop( 'trc_nam: unable to allocate n_trc_index' )   ;   RETURN
79      ENDIF
80      nb_trcdta      = 0
81      n_trc_index(:) = 0
82      DO jn = 1, ntrc
83         IF( ln_trc_ini(jn) ) THEN
84             nb_trcdta       = nb_trcdta + 1 
85             n_trc_index(jn) = nb_trcdta 
86         ENDIF
87      ENDDO
88      !
89      ntra = MAX( 1, nb_trcdta )   ! To avoid compilation error with bounds checking
90      IF(lwp) THEN
91         WRITE(numout,*) ' '
92         WRITE(numout,*) ' number of passive tracers to be initialize by data :', ntra
93         WRITE(numout,*) ' '
94      ENDIF
95      !                         ! allocate the arrays (if necessary)
96      !
97      cn_dir  = './'            ! directory in which the model is executed
98      DO jn = 1, ntrc
99         WRITE( clndta,'("TR_",I1)' ) jn
100         clndta = TRIM( clndta )
101         !                 !  file      ! frequency ! variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation !
102         !                 !  name      !  (hours)  !  name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    !
103         sn_trcdta(jn)  = FLD_N( clndta ,   -1      , clndta    ,  .false.   , .true.  ,  'monthly'  , ''       , ''       )
104         !
105         rn_trfac(jn) = 1._wp
106      END DO
107      !
108      REWIND( numnat )               ! read nattrc
109      READ  ( numnat, namtrc_dta )
110
111      IF( lwp ) THEN
112         DO jn = 1, ntrc
113            IF( ln_trc_ini(jn) )  THEN    ! open input file only if ln_trc_ini(jn) is true
114               clndta = TRIM( sn_trcdta(jn)%clvar ) 
115               clntrc = TRIM( ctrcnm   (jn)       ) 
116               zfact  = rn_trfac(jn)
117               IF( clndta /=  clntrc ) THEN
118                  CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation :  ',   &
119                  &              'the variable name in the data file : '//clndta//   & 
120                  &              '  must be the same than the name of the passive tracer : '//clntrc//' ')
121               ENDIF
122               WRITE(numout,*) ' read an initial file for passive tracer number :', jn, ' name : ', clndta, & 
123               &               ' multiplicative factor : ', zfact
124            ENDIF
125         END DO
126      ENDIF
127      !
128      IF( nb_trcdta > 0 ) THEN       !  allocate only if the number of tracer to initialise is greater than zero
129         ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 )
130         IF( ierr1 > 0 ) THEN
131            CALL ctl_stop( 'trc_dta_ini: unable to allocate  sf_trcdta structure' )   ;   RETURN
132         ENDIF
133         !
134         DO jn = 1, ntrc
135            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file
136               jl = n_trc_index(jn)
137               slf_i(jl)    = sn_trcdta(jn)
138               rf_trfac(jl) = rn_trfac(jn)
139                                            ALLOCATE( sf_trcdta(jl)%fnow(jpi,jpj,jpk)   , STAT=ierr2 )
140               IF( sn_trcdta(jn)%ln_tint )  ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )
141               IF( ierr2 + ierr3 > 0 ) THEN
142                 CALL ctl_stop( 'trc_dta : unable to allocate passive tracer data arrays' )   ;   RETURN
143               ENDIF
144            ENDIF
145            !   
146         ENDDO
147         !                         ! fill sf_trcdta with slf_i and control print
148         CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta', 'Passive tracer data', 'namtrc' )
149         !
150      ENDIF
151      !
152      IF( nn_timing == 1 )  CALL timing_stop('trc_dta_init')
153      !
154   END SUBROUTINE trc_dta_init
155
156
157   SUBROUTINE trc_dta( kt, sf_dta, zrf_trfac )
158      !!----------------------------------------------------------------------
159      !!                   ***  ROUTINE trc_dta  ***
160      !!                   
161      !! ** Purpose :   provides passive tracer data at kt
162      !!
163      !! ** Method  : - call fldread routine
164      !!              - s- or mixed z-s coordinate: vertical interpolation on model mesh
165      !!              - ln_trcdmp=F: deallocates the data structure as they are not used
166      !!
167      !! ** Action  :   sf_dta   passive tracer data on medl mesh and interpolated at time-step kt
168      !!----------------------------------------------------------------------
169      INTEGER                     , INTENT(in   ) ::   kt     ! ocean time-step
170      TYPE(FLD), DIMENSION(1)   , INTENT(inout) ::   sf_dta     ! array of information on the field to read
171      REAL(wp)                  , INTENT(in   ) ::   zrf_trfac  ! multiplication factor
172      !
173      INTEGER ::   ji, jj, jk, jl, jkk, ik    ! dummy loop indices
174      REAL(wp)::   zl, zi
175      REAL(wp), DIMENSION(jpk) ::  ztp                ! 1D workspace
176      CHARACTER(len=100) :: clndta
177      !!----------------------------------------------------------------------
178      !
179      IF( nn_timing == 1 )  CALL timing_start('trc_dta')
180      !
181      IF( nb_trcdta > 0 ) THEN
182         !
183         CALL fld_read( kt, 1, sf_dta )      !==   read data at kt time step   ==!
184         !
185         IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==!
186            !
187            IF( kt == nit000 .AND. lwp )THEN
188               WRITE(numout,*)
189               WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh'
190            ENDIF
191            !
192               DO jj = 1, jpj                         ! vertical interpolation of T & S
193                  DO ji = 1, jpi
194                     DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points
195                        zl = fsdept_0(ji,jj,jk)
196                        IF(     zl < gdept_0(1  ) ) THEN          ! above the first level of data
197                           ztp(jk) =  sf_dta(1)%fnow(ji,jj,1)
198                        ELSEIF( zl > gdept_0(jpk) ) THEN          ! below the last level of data
199                           ztp(jk) =  sf_dta(1)%fnow(ji,jj,jpkm1)
200                        ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1
201                           DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1)
202                              IF( (zl-gdept_0(jkk)) * (zl-gdept_0(jkk+1)) <= 0._wp ) THEN
203                                 zi = ( zl - gdept_0(jkk) ) / (gdept_0(jkk+1)-gdept_0(jkk))
204                                 ztp(jk) = sf_dta(1)%fnow(ji,jj,jkk) + ( sf_dta(1)%fnow(ji,jj,jkk+1) - &
205                                           sf_dta(1)%fnow(ji,jj,jkk) ) * zi 
206                              ENDIF
207                           END DO
208                        ENDIF
209                     END DO
210                     DO jk = 1, jpkm1
211                        sf_dta(1)%fnow(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord
212                     END DO
213                     sf_dta(1)%fnow(ji,jj,jpk) = 0._wp
214                  END DO
215               END DO
216            !
217         ELSE                                !==   z- or zps- coordinate   ==!
218            !                             
219               sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * tmask(:,:,:)    ! Mask
220               !
221               IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level
222                  DO jj = 1, jpj
223                     DO ji = 1, jpi
224                        ik = mbkt(ji,jj) 
225                        IF( ik > 1 ) THEN
226                           zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) )
227                           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)
228                        ENDIF
229                     END DO
230                  END DO
231               ENDIF
232            !
233         ENDIF
234         !
235         sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * zrf_trfac   !  multiplicative factor
236         !
237         IF( lwp .AND. kt == nit000 ) THEN
238               clndta = TRIM( sf_dta(1)%clvar ) 
239               WRITE(numout,*) ''//clndta//' data '
240               WRITE(numout,*)
241               WRITE(numout,*)'  level = 1'
242               CALL prihre( sf_dta(1)%fnow(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
243               WRITE(numout,*)'  level = ', jpk/2
244               CALL prihre( sf_dta(1)%fnow(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
245               WRITE(numout,*)'  level = ', jpkm1
246               CALL prihre( sf_dta(1)%fnow(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
247               WRITE(numout,*)
248         ENDIF
249         IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN      !==   deallocate data structure   ==!
250            !                                              (data used only for initialisation)
251            IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only use to initialize the run'
252                                      DEALLOCATE( sf_dta(1)%fnow )     !  arrays in the structure
253            IF( sf_dta(1)%ln_tint )   DEALLOCATE( sf_dta(1)%fdta )
254            !
255         ENDIF
256      ENDIF
257      !
258      IF( nn_timing == 1 )  CALL timing_stop('trc_dta')
259      !
260   END SUBROUTINE trc_dta
261#else
262   !!----------------------------------------------------------------------
263   !!   Dummy module                              NO 3D passive tracer data
264   !!----------------------------------------------------------------------
265CONTAINS
266   SUBROUTINE trc_dta( kt, sf_dta, zrf_trfac )        ! Empty routine
267      WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt
268   END SUBROUTINE trc_dta
269#endif
270   !!======================================================================
271END MODULE trcdta
Note: See TracBrowser for help on using the repository browser.