source: branches/UKMO/AMM15_v3_6_STABLE_package_FABM/NEMOGCM/NEMO/TOP_SRC/trcdta.F90 @ 10156

Last change on this file since 10156 was 10156, checked in by dford, 2 years ago

Apply patch fabm_patch_e3284ca_889163b.diff from Jim Clark.

File size: 13.8 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   !!            3.6   !  2015-03  (T. Lovato) revision of code log info
12   !!----------------------------------------------------------------------
13#if  defined key_top 
14   !!----------------------------------------------------------------------
15   !!   'key_top'                                                TOP model
16   !!----------------------------------------------------------------------
17   !!   trc_dta    : read and time interpolated passive tracer data
18   !!----------------------------------------------------------------------
19   USE par_trc       !  passive tracers parameters
20   USE oce_trc       !  shared variables between ocean and passive tracers
21   USE trc           !  passive tracers common variables
22   USE iom           !  I/O manager
23   USE lib_mpp       !  MPP library
24   USE fldread       !  read input fields
25
26   IMPLICIT NONE
27   PRIVATE
28
29   PUBLIC   trc_dta         ! called in trcini.F90 and trcdmp.F90
30   PUBLIC   trc_dta_init    ! called in trcini.F90
31
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!$AGRIF_DO_NOT_TREAT
37   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcdta   ! structure of input SST (file informations, fields read)
38!$AGRIF_END_DO_NOT_TREAT
39   !! * Substitutions
40#  include "domzgr_substitute.h90"
41   !!----------------------------------------------------------------------
42   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
43   !! $Id$
44   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
45   !!----------------------------------------------------------------------
46CONTAINS
47
48   SUBROUTINE trc_dta_init(ntrc)
49      !!----------------------------------------------------------------------
50      !!                   ***  ROUTINE trc_dta_init  ***
51      !!                   
52      !! ** Purpose :   initialisation of passive tracer input data
53      !!
54      !! ** Method  : - Read namtsd namelist
55      !!              - allocates passive tracer data structure
56      !!----------------------------------------------------------------------
57      !
58      INTEGER,INTENT(IN) :: ntrc                             ! number of tracers
59      INTEGER            :: jl, jn                           ! dummy loop indices
60      INTEGER            :: ierr0, ierr1, ierr2, ierr3       ! temporary integers
61      INTEGER            :: ios                              ! Local integer output status for namelist read
62      CHARACTER(len=100) :: clndta, clntrc
63      REAL(wp)           :: zfact
64      !
65      CHARACTER(len=100)            :: cn_dir
66      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i ! array of namelist informations on the fields to read
67      TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcdta
68      REAL(wp)   , DIMENSION(jpmaxtrc) :: rn_trfac    ! multiplicative factor for tracer values
69      !!
70      NAMELIST/namtrc_dta/ sn_trcdta, cn_dir, rn_trfac 
71      !!----------------------------------------------------------------------
72      !
73      IF( nn_timing == 1 )  CALL timing_start('trc_dta_init')
74      !
75      IF( lwp ) THEN
76         WRITE(numout,*) ' '
77         WRITE(numout,*) '  trc_dta_init : Tracers Initial Conditions (IC)'
78         WRITE(numout,*) '  ~~~~~~~~~~~ '
79      ENDIF
80      !
81      !  Initialisation
82      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0 
83      ! Compute the number of tracers to be initialised with data
84      ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 )
85      IF( ierr0 > 0 ) THEN
86         CALL ctl_stop( 'trc_dta_init: unable to allocate n_trc_index' )   ;   RETURN
87      ENDIF
88      nb_trcdta      = 0
89      n_trc_index(:) = 0
90      DO jn = 1, ntrc
91         IF( ln_trc_ini(jn) ) THEN
92             nb_trcdta       = nb_trcdta + 1 
93             n_trc_index(jn) = nb_trcdta 
94         ENDIF
95      ENDDO
96      !
97      ntra = MAX( 1, nb_trcdta )   ! To avoid compilation error with bounds checking
98      IF(lwp) THEN
99         WRITE(numout,*) ' '
100         WRITE(numout,*) ' number of passive tracers to be initialize by data :', ntra
101         WRITE(numout,*) ' '
102      ENDIF
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_init 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_init in configuration namelist', lwp )
111      IF(lwm) WRITE ( numont, namtrc_dta )
112
113      IF( lwp ) THEN
114         DO jn = 1, ntrc
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               if (jn > jptra) clntrc='Dummy' ! By pass weird formats in ocean.output if ntrc > jptra
119               zfact  = rn_trfac(jn)
120               IF( clndta /=  clntrc ) THEN
121                  CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation    ',   &
122                  &              'Input name of data file : '//TRIM(clndta)//   &
123                  &              ' differs from that of tracer : '//TRIM(clntrc)//' ')
124               ENDIF
125               WRITE(numout,*) ' '
126               WRITE(numout,'(a, i3,3a,e11.3)') ' Read IC file for tracer number :', &
127               &            jn, ', name : ', TRIM(clndta), ', Multiplicative Scaling factor : ', zfact
128            ENDIF
129         END DO
130      ENDIF
131      !
132      IF( nb_trcdta > 0 ) THEN       !  allocate only if the number of tracer to initialise is greater than zero
133         ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 )
134         IF( ierr1 > 0 ) THEN
135            CALL ctl_stop( 'trc_dta_init: unable to allocate  sf_trcdta structure' )   ;   RETURN
136         ENDIF
137         !
138         DO jn = 1, ntrc
139            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file
140               jl = n_trc_index(jn)
141               slf_i(jl)    = sn_trcdta(jn)
142               rf_trfac(jl) = rn_trfac(jn)
143                                            ALLOCATE( sf_trcdta(jl)%fnow(jpi,jpj,jpk)   , STAT=ierr2 )
144               IF( sn_trcdta(jn)%ln_tint )  ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )
145               IF( ierr2 + ierr3 > 0 ) THEN
146                 CALL ctl_stop( 'trc_dta_init : unable to allocate passive tracer data arrays' )   ;   RETURN
147               ENDIF
148            ENDIF
149            !   
150         ENDDO
151         !                         ! fill sf_trcdta with slf_i and control print
152         CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta_init', 'Passive tracer data', 'namtrc' )
153         !
154      ENDIF
155      !
156      DEALLOCATE( slf_i )          ! deallocate local field structure
157      IF( nn_timing == 1 )  CALL timing_stop('trc_dta_init')
158      !
159   END SUBROUTINE trc_dta_init
160
161
162   SUBROUTINE trc_dta( kt, sf_dta, zrf_trfac )
163      !!----------------------------------------------------------------------
164      !!                   ***  ROUTINE trc_dta  ***
165      !!                   
166      !! ** Purpose :   provides passive tracer data at kt
167      !!
168      !! ** Method  : - call fldread routine
169      !!              - s- or mixed z-s coordinate: vertical interpolation on model mesh
170      !!              - ln_trcdmp=F: deallocates the data structure as they are not used
171      !!
172      !! ** Action  :   sf_dta   passive tracer data on medl mesh and interpolated at time-step kt
173      !!----------------------------------------------------------------------
174      INTEGER                     , INTENT(in   ) ::   kt     ! ocean time-step
175      TYPE(FLD), DIMENSION(1)   , INTENT(inout) ::   sf_dta     ! array of information on the field to read
176      REAL(wp)                  , INTENT(in   ) ::   zrf_trfac  ! multiplication factor
177      !
178      INTEGER ::   ji, jj, jk, jl, jkk, ik    ! dummy loop indices
179      REAL(wp)::   zl, zi
180      REAL(wp), DIMENSION(jpk) ::  ztp                ! 1D workspace
181      CHARACTER(len=100) :: clndta
182      !!----------------------------------------------------------------------
183      !
184      IF( nn_timing == 1 )  CALL timing_start('trc_dta')
185      !
186      IF( nb_trcdta > 0 ) THEN
187         !
188         CALL fld_read( kt, 1, sf_dta )      !==   read data at kt time step   ==!
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 jj = 1, jpj                         ! vertical interpolation of T & S
198                  DO ji = 1, jpi
199                     DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points
200                        zl = fsdept_n(ji,jj,jk)
201                        IF(     zl < gdept_1d(1  ) ) THEN         ! above the first level of data
202                           ztp(jk) =  sf_dta(1)%fnow(ji,jj,1)
203                        ELSEIF( zl > gdept_1d(jpk) ) THEN         ! below the last level of data
204                           ztp(jk) =  sf_dta(1)%fnow(ji,jj,jpkm1)
205                        ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1
206                           DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1)
207                              IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN
208                                 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk))
209                                 ztp(jk) = sf_dta(1)%fnow(ji,jj,jkk) + ( sf_dta(1)%fnow(ji,jj,jkk+1) - &
210                                           sf_dta(1)%fnow(ji,jj,jkk) ) * zi 
211                              ENDIF
212                           END DO
213                        ENDIF
214                     END DO
215                     DO jk = 1, jpkm1
216                        sf_dta(1)%fnow(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord
217                     END DO
218                     sf_dta(1)%fnow(ji,jj,jpk) = 0._wp
219                  END DO
220               END DO
221            !
222         ELSE                                !==   z- or zps- coordinate   ==!
223            !                             
224               sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * tmask(:,:,:)    ! Mask
225               !
226               IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level
227                  DO jj = 1, jpj
228                     DO ji = 1, jpi
229                        ik = mbkt(ji,jj) 
230                        IF( ik > 1 ) THEN
231                           zl = ( gdept_1d(ik) - fsdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
232                           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)
233                        ENDIF
234                        ik = mikt(ji,jj)
235                        IF( ik > 1 ) THEN
236                           zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) )
237                           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)
238                        ENDIF
239                     END DO
240                  END DO
241               ENDIF
242            !
243         ENDIF
244         !
245         sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * zrf_trfac   !  multiplicative factor
246         !
247         IF( lwp .AND. kt == nit000 ) THEN
248               clndta = TRIM( sf_dta(1)%clvar ) 
249               WRITE(numout,*) ''//clndta//' data '
250               WRITE(numout,*)
251               WRITE(numout,*)'  level = 1'
252               CALL prihre( sf_dta(1)%fnow(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
253               WRITE(numout,*)'  level = ', jpk/2
254               CALL prihre( sf_dta(1)%fnow(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
255               WRITE(numout,*)'  level = ', jpkm1
256               CALL prihre( sf_dta(1)%fnow(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
257               WRITE(numout,*)
258         ENDIF
259      ENDIF
260      !
261      IF( nn_timing == 1 )  CALL timing_stop('trc_dta')
262      !
263   END SUBROUTINE trc_dta
264#else
265   !!----------------------------------------------------------------------
266   !!   Dummy module                              NO 3D passive tracer data
267   !!----------------------------------------------------------------------
268CONTAINS
269   SUBROUTINE trc_dta( kt, sf_dta, zrf_trfac )        ! Empty routine
270      WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt
271   END SUBROUTINE trc_dta
272#endif
273   !!======================================================================
274END MODULE trcdta
Note: See TracBrowser for help on using the repository browser.