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 NEMO/trunk/src/TOP – NEMO

source: NEMO/trunk/src/TOP/trcdta.F90 @ 12489

Last change on this file since 12489 was 12377, checked in by acc, 4 years ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.
  • Property svn:keywords set to Id
File size: 12.4 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   !! Substitutions
42#include "do_loop_substitute.h90"
43   !!----------------------------------------------------------------------
44   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
45   !! $Id$
46   !! Software governed by the CeCILL license (see ./LICENSE)
47   !!----------------------------------------------------------------------
48CONTAINS
49
50   SUBROUTINE trc_dta_ini(ntrc)
51      !!----------------------------------------------------------------------
52      !!                   ***  ROUTINE trc_dta_ini  ***
53      !!                   
54      !! ** Purpose :   initialisation of passive tracer input data
55      !!
56      !! ** Method  : - Read namtsd namelist
57      !!              - allocates passive tracer data structure
58      !!----------------------------------------------------------------------
59      INTEGER,INTENT(in) ::   ntrc   ! number of tracers
60      !
61      INTEGER ::   jl, jn                            ! dummy loop indices
62      INTEGER ::   ios, ierr0, ierr1, ierr2, ierr3   ! local integers
63      REAL(wp) ::   zfact
64      CHARACTER(len=100) ::   clndta, clntrc
65      !
66      CHARACTER(len=100) ::   cn_dir
67      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i ! array of namelist informations on the fields to read
68      TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcdta
69      REAL(wp)   , DIMENSION(jpmaxtrc) :: rn_trfac    ! multiplicative factor for tracer values
70      !!
71      NAMELIST/namtrc_dta/ sn_trcdta, cn_dir, rn_trfac 
72      !!----------------------------------------------------------------------
73      !
74      IF( lwp ) THEN
75         WRITE(numout,*)
76         WRITE(numout,*) 'trc_dta_ini : Tracers Initial Conditions (IC)'
77         WRITE(numout,*) '~~~~~~~~~~~ '
78      ENDIF
79      !
80      !  Initialisation
81      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0 
82      ! Compute the number of tracers to be initialised with data
83      ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 )
84      IF( ierr0 > 0 ) THEN
85         CALL ctl_stop( 'trc_dta_ini: unable to allocate n_trc_index' )   ;   RETURN
86      ENDIF
87      nb_trcdta      = 0
88      n_trc_index(:) = 0
89      DO jn = 1, ntrc
90         IF( ln_trc_ini(jn) ) THEN
91             nb_trcdta       = nb_trcdta + 1 
92             n_trc_index(jn) = nb_trcdta 
93         ENDIF
94      END DO
95      !
96      ntra = MAX( 1, nb_trcdta )   ! To avoid compilation error with bounds checking
97      IF(lwp) THEN
98         WRITE(numout,*)
99         WRITE(numout,*) '   number of passive tracers to be initialize by data :', ntra
100      ENDIF
101      !
102      READ  ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901)
103901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_dta_ini in reference namelist' )
104      READ  ( numnat_cfg, namtrc_dta, IOSTAT = ios, ERR = 902 )
105902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_dta_ini in configuration namelist' )
106      IF(lwm) WRITE ( numont, namtrc_dta )
107
108      IF( lwp ) THEN
109         DO jn = 1, ntrc
110            IF( ln_trc_ini(jn) )  THEN    ! open input file only if ln_trc_ini(jn) is true
111               clndta = TRIM( sn_trcdta(jn)%clvar ) 
112               clntrc = TRIM( ctrcnm   (jn)       ) 
113               if (jn > jptra) clntrc='Dummy' ! By pass weird formats in ocean.output if ntrc > jptra
114               zfact  = rn_trfac(jn)
115               IF( clndta /=  clntrc ) THEN
116                  CALL ctl_warn( 'trc_dta_ini: passive tracer data initialisation    ',   &
117                  &              'Input name of data file : '//TRIM(clndta)//   &
118                  &              ' differs from that of tracer : '//TRIM(clntrc)//' ')
119               ENDIF
120               WRITE(numout,*)
121               WRITE(numout,'(a, i4,3a,e11.3)') '   Read IC file for tracer number :', &
122               &            jn, ', name : ', TRIM(clndta), ', Multiplicative Scaling factor : ', zfact
123            ENDIF
124         END DO
125      ENDIF
126      !
127      IF( nb_trcdta > 0 ) THEN       !  allocate only if the number of tracer to initialise is greater than zero
128         ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 )
129         IF( ierr1 > 0 ) THEN
130            CALL ctl_stop( 'trc_dta_ini: unable to allocate  sf_trcdta structure' )   ;   RETURN
131         ENDIF
132         !
133         DO jn = 1, ntrc
134            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file
135               jl = n_trc_index(jn)
136               slf_i(jl)    = sn_trcdta(jn)
137               rf_trfac(jl) = rn_trfac(jn)
138                                            ALLOCATE( sf_trcdta(jl)%fnow(jpi,jpj,jpk)   , STAT=ierr2 )
139               IF( sn_trcdta(jn)%ln_tint )  ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )
140               IF( ierr2 + ierr3 > 0 ) THEN
141                 CALL ctl_stop( 'trc_dta_ini : unable to allocate passive tracer data arrays' )   ;   RETURN
142               ENDIF
143            ENDIF
144            !   
145         ENDDO
146         !                         ! fill sf_trcdta with slf_i and control print
147         CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta_ini', 'Passive tracer data', 'namtrc' )
148         !
149      ENDIF
150      !
151      DEALLOCATE( slf_i )          ! deallocate local field structure
152      !
153   END SUBROUTINE trc_dta_ini
154
155
156   SUBROUTINE trc_dta( kt, Kmm, sf_trcdta, ptrcfac, ptrcdta)
157      !!----------------------------------------------------------------------
158      !!                   ***  ROUTINE trc_dta  ***
159      !!                   
160      !! ** Purpose :   provides passive tracer data at kt
161      !!
162      !! ** Method  : - call fldread routine
163      !!              - s- or mixed z-s coordinate: vertical interpolation on model mesh
164      !!              - ln_trcdmp=F: deallocates the data structure as they are not used
165      !!
166      !! ** Action  :   sf_trcdta   passive tracer data on meld mesh and interpolated at time-step kt
167      !!----------------------------------------------------------------------
168      INTEGER                          , INTENT(in   )   ::   kt         ! ocean time-step
169      INTEGER                          , INTENT(in   )   ::   Kmm        ! time level index
170      TYPE(FLD), DIMENSION(1)          , INTENT(inout)   ::   sf_trcdta  ! array of information on the field to read
171      REAL(wp)                         , INTENT(in   )   ::   ptrcfac    ! multiplication factor
172      REAL(wp),  DIMENSION(jpi,jpj,jpk), INTENT(inout  ) ::   ptrcdta    ! 3D data array
173      !
174      INTEGER ::   ji, jj, jk, jl, jkk, ik    ! dummy loop indices
175      REAL(wp)::   zl, zi
176      REAL(wp), DIMENSION(jpk) ::  ztp                ! 1D workspace
177      CHARACTER(len=100) :: clndta
178      !!----------------------------------------------------------------------
179      !
180      IF( ln_timing )   CALL timing_start('trc_dta')
181      !
182      IF( kt == nit000 .AND. lwp) THEN
183         WRITE(numout,*)
184         WRITE(numout,*) 'trc_dta : passive tracers data for IC'
185         WRITE(numout,*) '~~~~~~~ '
186      ENDIF
187      !
188      IF( nb_trcdta > 0 ) THEN
189         !
190         ! read data at kt time step
191         CALL fld_read( kt, 1, sf_trcdta )
192         ptrcdta(:,:,:) = sf_trcdta(1)%fnow(:,:,:) * tmask(:,:,:)
193         !
194         IF( ln_sco ) THEN                !== s- or mixed s-zps-coordinate  ==!
195            !
196            IF( kt == nit000 .AND. lwp )THEN
197               WRITE(numout,*)
198               WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh'
199            ENDIF
200            DO_2D_11_11
201               DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points
202                  zl = gdept(ji,jj,jk,Kmm)
203                  IF(     zl < gdept_1d(1  ) ) THEN         ! above the first level of data
204                     ztp(jk) = ptrcdta(ji,jj,1)
205                  ELSEIF( zl > gdept_1d(jpk) ) THEN         ! below the last level of data
206                     ztp(jk) = ptrcdta(ji,jj,jpkm1)
207                  ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1
208                     DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1)
209                        IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN
210                           zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk))
211                           ztp(jk) = ptrcdta(ji,jj,jkk) + ( ptrcdta(ji,jj,jkk+1) - ptrcdta(ji,jj,jkk) ) * zi
212                        ENDIF
213                     END DO
214                  ENDIF
215               END DO
216               DO jk = 1, jpkm1
217                  ptrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord
218               END DO
219               ptrcdta(ji,jj,jpk) = 0._wp
220            END_2D
221            !
222         ELSE                                !==   z- or zps- coordinate   ==!
223            ! zps-coordinate (partial steps) interpolation at the last ocean level
224!            IF( ln_zps ) THEN
225!               DO jj = 1, jpj
226!                  DO ji = 1, jpi
227!                     ik = mbkt(ji,jj)
228!                     IF( ik > 1 ) THEN
229!                        zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
230!                        ptrcdta(ji,jj,ik) = (1.-zl) * ptrcdta(ji,jj,ik) + zl * ptrcdta(ji,jj,ik-1)
231!                     ENDIF
232!                     ik = mikt(ji,jj)
233!                     IF( ik > 1 ) THEN
234!                        zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) )
235!                        ptrcdta(ji,jj,ik) = (1.-zl) * ptrcdta(ji,jj,ik) + zl * ptrcdta(ji,jj,ik+1)
236!                     ENDIF
237!                  END DO
238!              END DO
239!            ENDIF
240            !
241         ENDIF
242         !
243         ! Scale by multiplicative factor
244         ptrcdta(:,:,:) = ptrcdta(:,:,:) * ptrcfac
245         !
246      ENDIF
247      !
248      IF( ln_timing )  CALL timing_stop('trc_dta')
249      !
250   END SUBROUTINE trc_dta
251
252#else
253   !!----------------------------------------------------------------------
254   !!   Dummy module                              NO 3D passive tracer data
255   !!----------------------------------------------------------------------
256CONTAINS
257   SUBROUTINE trc_dta( kt, sf_trcdta, ptrcfac, ptrcdta)        ! Empty routine
258      WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt
259   END SUBROUTINE trc_dta
260#endif
261
262   !!======================================================================
263END MODULE trcdta
Note: See TracBrowser for help on using the repository browser.