source: NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/TOP/trcdta.F90 @ 11954

Last change on this file since 11954 was 11671, checked in by acc, 17 months ago

Branch 2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles. Final, non-substantive changes to complete this branch. These changes remove all REWIND statements on the old namelist fortran units (now character variables for internal files). These changes have been left until last since they are easily repeated via a script and it may be preferable to use the previous revision for merge purposes and reapply these last changes separately. This branch has been fully SETTE tested.

  • Property svn:keywords set to Id
File size: 12.3 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) revisit code I/O
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   !
23   USE iom           !  I/O manager
24   USE lib_mpp       !  MPP library
25   USE fldread       !  read input fields
26
27   IMPLICIT NONE
28   PRIVATE
29
30   PUBLIC   trc_dta         ! called in trcini.F90 and trcdmp.F90
31   PUBLIC   trc_dta_ini     ! called in trcini.F90
32
33   INTEGER  , SAVE, PUBLIC                             :: nb_trcdta   ! number of tracers to be initialised with data
34   INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_index ! indice of tracer which is initialised with data
35   INTEGER  , SAVE, PUBLIC                             :: ntra        ! MAX( 1, nb_trcdta ) to avoid compilation error with bounds checking
36   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trfac    ! multiplicative factor for tracer values
37!$AGRIF_DO_NOT_TREAT
38   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcdta   ! structure of input SST (file informations, fields read)
39!$AGRIF_END_DO_NOT_TREAT
40
41   !!----------------------------------------------------------------------
42   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
43   !! $Id$
44   !! Software governed by the CeCILL license (see ./LICENSE)
45   !!----------------------------------------------------------------------
46CONTAINS
47
48   SUBROUTINE trc_dta_ini(ntrc)
49      !!----------------------------------------------------------------------
50      !!                   ***  ROUTINE trc_dta_ini  ***
51      !!                   
52      !! ** Purpose :   initialisation of passive tracer input data
53      !!
54      !! ** Method  : - Read namtsd namelist
55      !!              - allocates passive tracer data structure
56      !!----------------------------------------------------------------------
57      INTEGER,INTENT(in) ::   ntrc   ! number of tracers
58      !
59      INTEGER ::   jl, jn                            ! dummy loop indices
60      INTEGER ::   ios, ierr0, ierr1, ierr2, ierr3   ! local integers
61      REAL(wp) ::   zfact
62      CHARACTER(len=100) ::   clndta, clntrc
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( lwp ) THEN
73         WRITE(numout,*)
74         WRITE(numout,*) 'trc_dta_ini : Tracers Initial Conditions (IC)'
75         WRITE(numout,*) '~~~~~~~~~~~ '
76      ENDIF
77      !
78      !  Initialisation
79      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0 
80      ! Compute the number of tracers to be initialised with data
81      ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 )
82      IF( ierr0 > 0 ) THEN
83         CALL ctl_stop( 'trc_dta_ini: unable to allocate n_trc_index' )   ;   RETURN
84      ENDIF
85      nb_trcdta      = 0
86      n_trc_index(:) = 0
87      DO jn = 1, ntrc
88         IF( ln_trc_ini(jn) ) THEN
89             nb_trcdta       = nb_trcdta + 1 
90             n_trc_index(jn) = nb_trcdta 
91         ENDIF
92      END DO
93      !
94      ntra = MAX( 1, nb_trcdta )   ! To avoid compilation error with bounds checking
95      IF(lwp) THEN
96         WRITE(numout,*)
97         WRITE(numout,*) '   number of passive tracers to be initialize by data :', ntra
98      ENDIF
99      !
100      READ  ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901)
101901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_dta_ini in reference namelist' )
102      READ  ( numnat_cfg, namtrc_dta, IOSTAT = ios, ERR = 902 )
103902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_dta_ini in configuration namelist' )
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               if (jn > jptra) clntrc='Dummy' ! By pass weird formats in ocean.output if ntrc > jptra
112               zfact  = rn_trfac(jn)
113               IF( clndta /=  clntrc ) THEN
114                  CALL ctl_warn( 'trc_dta_ini: passive tracer data initialisation    ',   &
115                  &              'Input name of data file : '//TRIM(clndta)//   &
116                  &              ' differs from that of tracer : '//TRIM(clntrc)//' ')
117               ENDIF
118               WRITE(numout,*)
119               WRITE(numout,'(a, i4,3a,e11.3)') '   Read IC file for tracer number :', &
120               &            jn, ', name : ', TRIM(clndta), ', Multiplicative Scaling factor : ', zfact
121            ENDIF
122         END DO
123      ENDIF
124      !
125      IF( nb_trcdta > 0 ) THEN       !  allocate only if the number of tracer to initialise is greater than zero
126         ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 )
127         IF( ierr1 > 0 ) THEN
128            CALL ctl_stop( 'trc_dta_ini: unable to allocate  sf_trcdta structure' )   ;   RETURN
129         ENDIF
130         !
131         DO jn = 1, ntrc
132            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file
133               jl = n_trc_index(jn)
134               slf_i(jl)    = sn_trcdta(jn)
135               rf_trfac(jl) = rn_trfac(jn)
136                                            ALLOCATE( sf_trcdta(jl)%fnow(jpi,jpj,jpk)   , STAT=ierr2 )
137               IF( sn_trcdta(jn)%ln_tint )  ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )
138               IF( ierr2 + ierr3 > 0 ) THEN
139                 CALL ctl_stop( 'trc_dta_ini : unable to allocate passive tracer data arrays' )   ;   RETURN
140               ENDIF
141            ENDIF
142            !   
143         ENDDO
144         !                         ! fill sf_trcdta with slf_i and control print
145         CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta_ini', 'Passive tracer data', 'namtrc' )
146         !
147      ENDIF
148      !
149      DEALLOCATE( slf_i )          ! deallocate local field structure
150      !
151   END SUBROUTINE trc_dta_ini
152
153
154   SUBROUTINE trc_dta( kt, sf_trcdta, ptrcfac, ptrcdta)
155      !!----------------------------------------------------------------------
156      !!                   ***  ROUTINE trc_dta  ***
157      !!                   
158      !! ** Purpose :   provides passive tracer data at kt
159      !!
160      !! ** Method  : - call fldread routine
161      !!              - s- or mixed z-s coordinate: vertical interpolation on model mesh
162      !!              - ln_trcdmp=F: deallocates the data structure as they are not used
163      !!
164      !! ** Action  :   sf_trcdta   passive tracer data on meld mesh and interpolated at time-step kt
165      !!----------------------------------------------------------------------
166      INTEGER                          , INTENT(in   )   ::   kt         ! ocean time-step
167      TYPE(FLD), DIMENSION(1)          , INTENT(inout)   ::   sf_trcdta  ! array of information on the field to read
168      REAL(wp)                         , INTENT(in   )   ::   ptrcfac    ! multiplication factor
169      REAL(wp),  DIMENSION(jpi,jpj,jpk), INTENT(inout  ) ::   ptrcdta    ! 3D data array
170      !
171      INTEGER ::   ji, jj, jk, jl, jkk, ik    ! dummy loop indices
172      REAL(wp)::   zl, zi
173      REAL(wp), DIMENSION(jpk) ::  ztp                ! 1D workspace
174      CHARACTER(len=100) :: clndta
175      !!----------------------------------------------------------------------
176      !
177      IF( ln_timing )   CALL timing_start('trc_dta')
178      !
179      IF( nb_trcdta > 0 ) THEN
180         !
181         ! read data at kt time step
182         CALL fld_read( kt, 1, sf_trcdta )
183         ptrcdta(:,:,:) = sf_trcdta(1)%fnow(:,:,:) * tmask(:,:,:)
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            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 = gdept_n(ji,jj,jk)
195                     IF(     zl < gdept_1d(1  ) ) THEN         ! above the first level of data
196                        ztp(jk) = ptrcdta(ji,jj,1)
197                     ELSEIF( zl > gdept_1d(jpk) ) THEN         ! below the last level of data
198                        ztp(jk) = ptrcdta(ji,jj,jpkm1)
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) = ptrcdta(ji,jj,jkk) + ( ptrcdta(ji,jj,jkk+1) - ptrcdta(ji,jj,jkk) ) * zi
204                           ENDIF
205                        END DO
206                     ENDIF
207                  END DO
208                  DO jk = 1, jpkm1
209                     ptrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord
210                  END DO
211                  ptrcdta(ji,jj,jpk) = 0._wp
212                END DO
213            END DO
214            !
215         ELSE                                !==   z- or zps- coordinate   ==!
216            ! zps-coordinate (partial steps) interpolation at the last ocean level
217!            IF( ln_zps ) THEN
218!               DO jj = 1, jpj
219!                  DO ji = 1, jpi
220!                     ik = mbkt(ji,jj)
221!                     IF( ik > 1 ) THEN
222!                        zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
223!                        ptrcdta(ji,jj,ik) = (1.-zl) * ptrcdta(ji,jj,ik) + zl * ptrcdta(ji,jj,ik-1)
224!                     ENDIF
225!                     ik = mikt(ji,jj)
226!                     IF( ik > 1 ) THEN
227!                        zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) )
228!                        ptrcdta(ji,jj,ik) = (1.-zl) * ptrcdta(ji,jj,ik) + zl * ptrcdta(ji,jj,ik+1)
229!                     ENDIF
230!                  END DO
231!              END DO
232!            ENDIF
233            !
234         ENDIF
235         !
236         ! Scale by multiplicative factor
237         ptrcdta(:,:,:) = ptrcdta(:,:,:) * ptrcfac
238         !
239      ENDIF
240      !
241      IF( ln_timing )  CALL timing_stop('trc_dta')
242      !
243   END SUBROUTINE trc_dta
244
245#else
246   !!----------------------------------------------------------------------
247   !!   Dummy module                              NO 3D passive tracer data
248   !!----------------------------------------------------------------------
249CONTAINS
250   SUBROUTINE trc_dta( kt, sf_trcdta, ptrcfac, ptrcdta)        ! Empty routine
251      WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt
252   END SUBROUTINE trc_dta
253#endif
254
255   !!======================================================================
256END MODULE trcdta
Note: See TracBrowser for help on using the repository browser.