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

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

Last change on this file since 4026 was 4026, checked in by vichi, 11 years ago

Correct bug in deallocation of data structure
  • 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  , 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      ENDIF
250      !
251      IF( nn_timing == 1 )  CALL timing_stop('trc_dta')
252      !
253   END SUBROUTINE trc_dta
254#else
255   !!----------------------------------------------------------------------
256   !!   Dummy module                              NO 3D passive tracer data
257   !!----------------------------------------------------------------------
258CONTAINS
259   SUBROUTINE trc_dta( kt, sf_dta, zrf_trfac )        ! Empty routine
260      WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt
261   END SUBROUTINE trc_dta
262#endif
263   !!======================================================================
264END MODULE trcdta
Note: See TracBrowser for help on using the repository browser.