source: CONFIG/UNIFORM/v6/IPSLCM6/SOURCES/NEMO/trcdta.F90 @ 2865

Last change on this file since 2865 was 2865, checked in by cetlod, 5 years ago

Bugfix on passive tracers restoring in closed seas, before new NEMO revision

File size: 13.1 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: trcdta.F90 6308 2016-02-12 11:32:54Z cetlod $
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, ptrc )
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_trcdta   passive tracer data on medl mesh and interpolated at time-step kt
164      !!----------------------------------------------------------------------
165      INTEGER                       , INTENT(in   ) ::   kt     ! ocean time-step
166      REAL(wp), DIMENSION(jpi,jpj,jpk,nb_trcdta), INTENT(inout) ::   ptrc     ! array of information on the field to read
167      !
168      INTEGER ::   ji, jj, jk, jl, jkk, ik    ! dummy loop indices
169      REAL(wp)::   zl, zi
170      REAL(wp), DIMENSION(jpk) ::  ztp                ! 1D workspace
171      CHARACTER(len=100) :: clndta
172      !!----------------------------------------------------------------------
173      !
174      IF( nn_timing == 1 )  CALL timing_start('trc_dta')
175      !
176      IF( nb_trcdta > 0 ) THEN
177         !
178         CALL fld_read( kt, 1, sf_trcdta )      !==   read data at kt time step   ==!
179         !
180         DO jl = 1, nb_trcdta
181            ptrc(:,:,:,jl) = sf_trcdta(jl)%fnow(:,:,:) * tmask(:,:,:)    ! Mask
182         ENDDO
183         !
184         IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==!
185            !
186            IF( kt == nit000 .AND. lwp )THEN
187               WRITE(numout,*)
188               WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh'
189            ENDIF
190            DO jl = 1, nb_trcdta
191               DO jj = 1, jpj                         ! vertical interpolation of T & S
192                  DO ji = 1, jpi
193                     DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points
194                        zl = fsdept_n(ji,jj,jk)
195                        IF(     zl < gdept_1d(1  ) ) THEN         ! above the first level of data
196                           ztp(jk) =  ptrc(ji,jj,1,jl)
197                        ELSEIF( zl > gdept_1d(jpk) ) THEN         ! below the last level of data
198                           ztp(jk) =  ptrc(ji,jj,jpkm1,jl)
199                        ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1
200                           DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1)
201                              IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN
202                                 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk))
203                                 ztp(jk) = ptrc(ji,jj,jkk,jl) + ( ptrc(ji,jj,jkk+1,jl) - ptrc(ji,jj,jkk,jl) ) * zi 
204                              ENDIF
205                           END DO
206                        ENDIF
207                     END DO
208                     DO jk = 1, jpkm1
209                        ptrc(ji,jj,jk,jl) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord
210                     END DO
211                     ptrc(ji,jj,jpk,jl) = 0._wp
212                  END DO
213               END DO
214            END DO
215            !
216         ELSE                                !==   z- or zps- coordinate   ==!
217            !                             
218            IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level
219               DO jl = 1, nb_trcdta
220                  !
221                  DO jj = 1, jpj
222                     DO ji = 1, jpi
223                        ik = mbkt(ji,jj) 
224                        IF( ik > 1 ) THEN
225                           zl = ( gdept_1d(ik) - fsdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
226                           ptrc(ji,jj,ik,jl) = (1.-zl) * ptrc(ji,jj,ik,jl) + zl * ptrc(ji,jj,ik-1,jl)
227                        ENDIF
228                        ik = mikt(ji,jj)
229                        IF( ik > 1 ) THEN
230                           zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) )
231                           ptrc(ji,jj,ik,jl) = (1.-zl) * ptrc(ji,jj,ik,jl) + zl * ptrc(ji,jj,ik+1,jl)
232                        ENDIF
233                     END DO
234                  END DO
235              END DO
236            ENDIF
237            !
238         ENDIF
239         !
240      ENDIF
241      !
242      IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN      !== deallocate data structure   ==!
243        !                                                    (data used only for initialisation)
244        IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only used to initialize the run'
245        DO jl = 1, nb_trcdta
246                                        DEALLOCATE( sf_trcdta(jl)%fnow)     !  arrays in the structure
247           IF( sf_trcdta(jl)%ln_tint )  DEALLOCATE( sf_trcdta(jl)%fdta)
248        ENDDO
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_trcdta, 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.