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

source: trunk/NEMOGCM/NEMO/TOP_SRC/trcdta.F90 @ 6287

Last change on this file since 6287 was 6140, checked in by timgraham, 8 years ago

Merge of branches/2015/dev_merge_2015 back into trunk. Merge excludes NEMOGCM/TOOLS/OBSTOOLS/ for now due to issues with the change of file type. Will sort these manually with further commits.

Branch merged as follows:
In the working copy of branch ran:
svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk@HEAD
Small conflicts due to bug fixes applied to trunk since the dev_merge_2015 was copied. Bug fixes were applied to the branch as well so these were easy to resolve.
Branch committed at this stage

In working copy run:
svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
to switch working copy

Run:
svn merge --reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2015/dev_merge_2015
to merge the branch into the trunk and then commit - no conflicts at this stage.

  • Property svn:keywords set to Id
File size: 12.7 KB
RevLine 
[268]1MODULE trcdta
2   !!======================================================================
[433]3   !!                     ***  MODULE  trcdta  ***
[945]4   !! TOP :  reads passive tracer data
[268]5   !!=====================================================================
[945]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
[3294]9   !!            3.4   !  2010-11  (C. Ethe, G. Madec)  use of fldread + dynamical allocation
[4230]10   !!            3.5   !  2013-08  (M. Vichi)  generalization for other BGC models
[6140]11   !!            3.6   !  2015-03  (T. Lovato) revision of code log info
[274]12   !!----------------------------------------------------------------------
[6140]13#if defined key_top 
[268]14   !!----------------------------------------------------------------------
[3294]15   !!   'key_top'                                                TOP model
[268]16   !!----------------------------------------------------------------------
[3294]17   !!   trc_dta    : read and time interpolated passive tracer data
[268]18   !!----------------------------------------------------------------------
[3294]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
[268]25
26   IMPLICIT NONE
27   PRIVATE
28
[2715]29   PUBLIC   trc_dta         ! called in trcini.F90 and trcdmp.F90
[3294]30   PUBLIC   trc_dta_init    ! called in trcini.F90
[268]31
[3294]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
[4230]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
[4489]36!$AGRIF_DO_NOT_TREAT
[4230]37   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcdta   ! structure of input SST (file informations, fields read)
[4489]38!$AGRIF_END_DO_NOT_TREAT
[6140]39
[268]40   !!----------------------------------------------------------------------
[3294]41   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
[1152]42   !! $Id$
[2715]43   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
[268]44   !!----------------------------------------------------------------------
45CONTAINS
46
[4230]47   SUBROUTINE trc_dta_init(ntrc)
[335]48      !!----------------------------------------------------------------------
[3294]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
[335]55      !!----------------------------------------------------------------------
[3294]56      !
[4230]57      INTEGER,INTENT(IN) :: ntrc                             ! number of tracers
58      INTEGER            :: jl, jn                           ! dummy loop indices
[3294]59      INTEGER            :: ierr0, ierr1, ierr2, ierr3       ! temporary integers
[4147]60      INTEGER            :: ios                              ! Local integer output status for namelist read
[3294]61      CHARACTER(len=100) :: clndta, clntrc
62      REAL(wp)           :: zfact
63      !
[4147]64      CHARACTER(len=100)            :: cn_dir
[4230]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
[945]68      !!
[3294]69      NAMELIST/namtrc_dta/ sn_trcdta, cn_dir, rn_trfac 
[335]70      !!----------------------------------------------------------------------
[3294]71      !
72      IF( nn_timing == 1 )  CALL timing_start('trc_dta_init')
73      !
[6140]74      IF( lwp ) THEN
75         WRITE(numout,*) ' '
76         WRITE(numout,*) '  trc_dta_init : Tracers Initial Conditions (IC)'
77         WRITE(numout,*) '  ~~~~~~~~~~~ '
78      ENDIF
79      !
[3294]80      !  Initialisation
81      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0 
82      ! Compute the number of tracers to be initialised with data
[4230]83      ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 )
[3294]84      IF( ierr0 > 0 ) THEN
[6140]85         CALL ctl_stop( 'trc_dta_init: unable to allocate n_trc_index' )   ;   RETURN
[3294]86      ENDIF
87      nb_trcdta      = 0
88      n_trc_index(:) = 0
[4230]89      DO jn = 1, ntrc
[3294]90         IF( ln_trc_ini(jn) ) THEN
91             nb_trcdta       = nb_trcdta + 1 
92             n_trc_index(jn) = nb_trcdta 
93         ENDIF
94      ENDDO
95      !
96      ntra = MAX( 1, nb_trcdta )   ! To avoid compilation error with bounds checking
[3827]97      IF(lwp) THEN
98         WRITE(numout,*) ' '
99         WRITE(numout,*) ' number of passive tracers to be initialize by data :', ntra
100         WRITE(numout,*) ' '
101      ENDIF
[3294]102      !
[4147]103      REWIND( numnat_ref )              ! Namelist namtrc_dta in reference namelist : Passive tracer input data
104      READ  ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901)
[6140]105901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_init in reference namelist', lwp )
[268]106
[4147]107      REWIND( numnat_cfg )              ! Namelist namtrc_dta in configuration namelist : Passive tracer input data
108      READ  ( numnat_cfg, namtrc_dta, IOSTAT = ios, ERR = 902 )
[6140]109902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_init in configuration namelist', lwp )
[4624]110      IF(lwm) WRITE ( numont, namtrc_dta )
[4147]111
[3294]112      IF( lwp ) THEN
[4230]113         DO jn = 1, ntrc
[3294]114            IF( ln_trc_ini(jn) )  THEN    ! open input file only if ln_trc_ini(jn) is true
115               clndta = TRIM( sn_trcdta(jn)%clvar ) 
116               clntrc = TRIM( ctrcnm   (jn)       ) 
[6140]117               if (jn > jptra) clntrc='Dummy' ! By pass weird formats in ocean.output if ntrc > jptra
[3294]118               zfact  = rn_trfac(jn)
119               IF( clndta /=  clntrc ) THEN
[6140]120                  CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation    ',   &
121                  &              'Input name of data file : '//TRIM(clndta)//   &
122                  &              ' differs from that of tracer : '//TRIM(clntrc)//' ')
[3294]123               ENDIF
[6140]124               WRITE(numout,*) ' '
125               WRITE(numout,'(a, i3,3a,e11.3)') ' Read IC file for tracer number :', &
126               &            jn, ', name : ', TRIM(clndta), ', Multiplicative Scaling factor : ', zfact
[335]127            ENDIF
[3294]128         END DO
129      ENDIF
130      !
131      IF( nb_trcdta > 0 ) THEN       !  allocate only if the number of tracer to initialise is greater than zero
132         ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 )
133         IF( ierr1 > 0 ) THEN
[6140]134            CALL ctl_stop( 'trc_dta_init: unable to allocate  sf_trcdta structure' )   ;   RETURN
[3294]135         ENDIF
136         !
[4230]137         DO jn = 1, ntrc
[3294]138            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file
139               jl = n_trc_index(jn)
140               slf_i(jl)    = sn_trcdta(jn)
141               rf_trfac(jl) = rn_trfac(jn)
142                                            ALLOCATE( sf_trcdta(jl)%fnow(jpi,jpj,jpk)   , STAT=ierr2 )
143               IF( sn_trcdta(jn)%ln_tint )  ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )
144               IF( ierr2 + ierr3 > 0 ) THEN
[6140]145                 CALL ctl_stop( 'trc_dta_init : unable to allocate passive tracer data arrays' )   ;   RETURN
[3294]146               ENDIF
147            ENDIF
148            !   
149         ENDDO
150         !                         ! fill sf_trcdta with slf_i and control print
[6140]151         CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta_init', 'Passive tracer data', 'namtrc' )
[3294]152         !
153      ENDIF
154      !
[4230]155      DEALLOCATE( slf_i )          ! deallocate local field structure
[3294]156      IF( nn_timing == 1 )  CALL timing_stop('trc_dta_init')
157      !
158   END SUBROUTINE trc_dta_init
[268]159
[493]160
[4230]161   SUBROUTINE trc_dta( kt, sf_dta, zrf_trfac )
[3294]162      !!----------------------------------------------------------------------
163      !!                   ***  ROUTINE trc_dta  ***
164      !!                   
165      !! ** Purpose :   provides passive tracer data at kt
166      !!
167      !! ** Method  : - call fldread routine
168      !!              - s- or mixed z-s coordinate: vertical interpolation on model mesh
169      !!              - ln_trcdmp=F: deallocates the data structure as they are not used
170      !!
[4230]171      !! ** Action  :   sf_dta   passive tracer data on medl mesh and interpolated at time-step kt
[3294]172      !!----------------------------------------------------------------------
173      INTEGER                     , INTENT(in   ) ::   kt     ! ocean time-step
[4230]174      TYPE(FLD), DIMENSION(1)   , INTENT(inout) ::   sf_dta     ! array of information on the field to read
175      REAL(wp)                  , INTENT(in   ) ::   zrf_trfac  ! multiplication factor
[3294]176      !
[4230]177      INTEGER ::   ji, jj, jk, jl, jkk, ik    ! dummy loop indices
[3294]178      REAL(wp)::   zl, zi
179      REAL(wp), DIMENSION(jpk) ::  ztp                ! 1D workspace
180      CHARACTER(len=100) :: clndta
181      !!----------------------------------------------------------------------
182      !
183      IF( nn_timing == 1 )  CALL timing_start('trc_dta')
184      !
185      IF( nb_trcdta > 0 ) THEN
186         !
[4230]187         CALL fld_read( kt, 1, sf_dta )      !==   read data at kt time step   ==!
[3294]188         !
189         IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==!
190            !
191            IF( kt == nit000 .AND. lwp )THEN
192               WRITE(numout,*)
193               WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh'
[268]194            ENDIF
[3294]195            !
196               DO jj = 1, jpj                         ! vertical interpolation of T & S
197                  DO ji = 1, jpi
198                     DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points
[6140]199                        zl = gdept_n(ji,jj,jk)
[4292]200                        IF(     zl < gdept_1d(1  ) ) THEN         ! above the first level of data
[4230]201                           ztp(jk) =  sf_dta(1)%fnow(ji,jj,1)
[4292]202                        ELSEIF( zl > gdept_1d(jpk) ) THEN         ! below the last level of data
[4230]203                           ztp(jk) =  sf_dta(1)%fnow(ji,jj,jpkm1)
[3294]204                        ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1
205                           DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1)
[4292]206                              IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN
207                                 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk))
[4230]208                                 ztp(jk) = sf_dta(1)%fnow(ji,jj,jkk) + ( sf_dta(1)%fnow(ji,jj,jkk+1) - &
209                                           sf_dta(1)%fnow(ji,jj,jkk) ) * zi 
[3294]210                              ENDIF
211                           END DO
212                        ENDIF
[335]213                     END DO
[3294]214                     DO jk = 1, jpkm1
[4230]215                        sf_dta(1)%fnow(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord
[3294]216                     END DO
[4230]217                     sf_dta(1)%fnow(ji,jj,jpk) = 0._wp
[3294]218                  END DO
[268]219               END DO
[3294]220            !
221         ELSE                                !==   z- or zps- coordinate   ==!
222            !                             
[4230]223               sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * tmask(:,:,:)    ! Mask
[3294]224               !
225               IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level
226                  DO jj = 1, jpj
227                     DO ji = 1, jpi
228                        ik = mbkt(ji,jj) 
229                        IF( ik > 1 ) THEN
[6140]230                           zl = ( gdept_1d(ik) - gdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
[4230]231                           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)
[3294]232                        ENDIF
233                     END DO
234                  END DO
235               ENDIF
236            !
237         ENDIF
238         !
[4230]239         sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * zrf_trfac   !  multiplicative factor
[3294]240         !
241      ENDIF
[4230]242      !
[3294]243      IF( nn_timing == 1 )  CALL timing_stop('trc_dta')
[945]244      !
[1011]245   END SUBROUTINE trc_dta
[6140]246   
[268]247#else
248   !!----------------------------------------------------------------------
[945]249   !!   Dummy module                              NO 3D passive tracer data
[268]250   !!----------------------------------------------------------------------
251CONTAINS
[4230]252   SUBROUTINE trc_dta( kt, sf_dta, zrf_trfac )        ! Empty routine
[1011]253      WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt
254   END SUBROUTINE trc_dta
[268]255#endif
[6140]256
[945]257   !!======================================================================
[268]258END MODULE trcdta
Note: See TracBrowser for help on using the repository browser.