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 @ 11536

Last change on this file since 11536 was 11536, checked in by smasson, 5 years ago

trunk: merge dev_r10984_HPC-13 into the trunk

  • Property svn:keywords set to Id
File size: 12.5 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
[7646]11   !!            3.6   !  2015-03  (T. Lovato) revisit code I/O
[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
[9124]22   !
[3294]23   USE iom           !  I/O manager
24   USE lib_mpp       !  MPP library
25   USE fldread       !  read input fields
[268]26
27   IMPLICIT NONE
28   PRIVATE
29
[2715]30   PUBLIC   trc_dta         ! called in trcini.F90 and trcdmp.F90
[7646]31   PUBLIC   trc_dta_ini     ! called in trcini.F90
[268]32
[3294]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
[4230]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
[4489]37!$AGRIF_DO_NOT_TREAT
[4230]38   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcdta   ! structure of input SST (file informations, fields read)
[4489]39!$AGRIF_END_DO_NOT_TREAT
[6140]40
[268]41   !!----------------------------------------------------------------------
[10068]42   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
[1152]43   !! $Id$
[10068]44   !! Software governed by the CeCILL license (see ./LICENSE)
[268]45   !!----------------------------------------------------------------------
46CONTAINS
47
[7646]48   SUBROUTINE trc_dta_ini(ntrc)
[335]49      !!----------------------------------------------------------------------
[7646]50      !!                   ***  ROUTINE trc_dta_ini  ***
[3294]51      !!                   
52      !! ** Purpose :   initialisation of passive tracer input data
53      !!
54      !! ** Method  : - Read namtsd namelist
55      !!              - allocates passive tracer data structure
[335]56      !!----------------------------------------------------------------------
[9169]57      INTEGER,INTENT(in) ::   ntrc   ! number of tracers
[3294]58      !
[9169]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
[3294]63      !
[9169]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      !
[6140]72      IF( lwp ) THEN
[9169]73         WRITE(numout,*)
74         WRITE(numout,*) 'trc_dta_ini : Tracers Initial Conditions (IC)'
75         WRITE(numout,*) '~~~~~~~~~~~ '
[6140]76      ENDIF
77      !
[3294]78      !  Initialisation
79      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0 
80      ! Compute the number of tracers to be initialised with data
[4230]81      ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 )
[3294]82      IF( ierr0 > 0 ) THEN
[7646]83         CALL ctl_stop( 'trc_dta_ini: unable to allocate n_trc_index' )   ;   RETURN
[3294]84      ENDIF
85      nb_trcdta      = 0
86      n_trc_index(:) = 0
[4230]87      DO jn = 1, ntrc
[3294]88         IF( ln_trc_ini(jn) ) THEN
89             nb_trcdta       = nb_trcdta + 1 
90             n_trc_index(jn) = nb_trcdta 
91         ENDIF
[9169]92      END DO
[3294]93      !
94      ntra = MAX( 1, nb_trcdta )   ! To avoid compilation error with bounds checking
[3827]95      IF(lwp) THEN
[9169]96         WRITE(numout,*)
97         WRITE(numout,*) '   number of passive tracers to be initialize by data :', ntra
[3827]98      ENDIF
[3294]99      !
[4147]100      REWIND( numnat_ref )              ! Namelist namtrc_dta in reference namelist : Passive tracer input data
101      READ  ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901)
[11536]102901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_dta_ini in reference namelist' )
[4147]103      REWIND( numnat_cfg )              ! Namelist namtrc_dta in configuration namelist : Passive tracer input data
104      READ  ( numnat_cfg, namtrc_dta, IOSTAT = ios, ERR = 902 )
[11536]105902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_dta_ini in configuration namelist' )
[4624]106      IF(lwm) WRITE ( numont, namtrc_dta )
[4147]107
[3294]108      IF( lwp ) THEN
[4230]109         DO jn = 1, ntrc
[3294]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)       ) 
[6140]113               if (jn > jptra) clntrc='Dummy' ! By pass weird formats in ocean.output if ntrc > jptra
[3294]114               zfact  = rn_trfac(jn)
115               IF( clndta /=  clntrc ) THEN
[7646]116                  CALL ctl_warn( 'trc_dta_ini: passive tracer data initialisation    ',   &
[6140]117                  &              'Input name of data file : '//TRIM(clndta)//   &
118                  &              ' differs from that of tracer : '//TRIM(clntrc)//' ')
[3294]119               ENDIF
[9169]120               WRITE(numout,*)
121               WRITE(numout,'(a, i4,3a,e11.3)') '   Read IC file for tracer number :', &
[6140]122               &            jn, ', name : ', TRIM(clndta), ', Multiplicative Scaling factor : ', zfact
[335]123            ENDIF
[3294]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
[7646]130            CALL ctl_stop( 'trc_dta_ini: unable to allocate  sf_trcdta structure' )   ;   RETURN
[3294]131         ENDIF
132         !
[4230]133         DO jn = 1, ntrc
[3294]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
[7646]141                 CALL ctl_stop( 'trc_dta_ini : unable to allocate passive tracer data arrays' )   ;   RETURN
[3294]142               ENDIF
143            ENDIF
144            !   
145         ENDDO
146         !                         ! fill sf_trcdta with slf_i and control print
[7646]147         CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta_ini', 'Passive tracer data', 'namtrc' )
[3294]148         !
149      ENDIF
150      !
[4230]151      DEALLOCATE( slf_i )          ! deallocate local field structure
[3294]152      !
[7646]153   END SUBROUTINE trc_dta_ini
[268]154
[493]155
[7646]156   SUBROUTINE trc_dta( kt, sf_trcdta, ptrcfac, ptrcdta)
[3294]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      !!
[7646]166      !! ** Action  :   sf_trcdta   passive tracer data on meld mesh and interpolated at time-step kt
[3294]167      !!----------------------------------------------------------------------
[7646]168      INTEGER                          , INTENT(in   )   ::   kt         ! ocean time-step
169      TYPE(FLD), DIMENSION(1)          , INTENT(inout)   ::   sf_trcdta  ! array of information on the field to read
170      REAL(wp)                         , INTENT(in   )   ::   ptrcfac    ! multiplication factor
171      REAL(wp),  DIMENSION(jpi,jpj,jpk), INTENT(inout  ) ::   ptrcdta    ! 3D data array
[3294]172      !
[4230]173      INTEGER ::   ji, jj, jk, jl, jkk, ik    ! dummy loop indices
[3294]174      REAL(wp)::   zl, zi
175      REAL(wp), DIMENSION(jpk) ::  ztp                ! 1D workspace
[6701]176      CHARACTER(len=100) :: clndta
[3294]177      !!----------------------------------------------------------------------
178      !
[9124]179      IF( ln_timing )   CALL timing_start('trc_dta')
[3294]180      !
181      IF( nb_trcdta > 0 ) THEN
182         !
[7646]183         ! read data at kt time step
184         CALL fld_read( kt, 1, sf_trcdta )
185         ptrcdta(:,:,:) = sf_trcdta(1)%fnow(:,:,:) * tmask(:,:,:)
186         !
187         IF( ln_sco ) THEN                !== s- or mixed s-zps-coordinate  ==!
[3294]188            !
189            IF( kt == nit000 .AND. lwp )THEN
190               WRITE(numout,*)
191               WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh'
[268]192            ENDIF
[6701]193            DO jj = 1, jpj                         ! vertical interpolation of T & S
194               DO ji = 1, jpi
195                  DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points
196                     zl = gdept_n(ji,jj,jk)
197                     IF(     zl < gdept_1d(1  ) ) THEN         ! above the first level of data
[7646]198                        ztp(jk) = ptrcdta(ji,jj,1)
[6701]199                     ELSEIF( zl > gdept_1d(jpk) ) THEN         ! below the last level of data
[7646]200                        ztp(jk) = ptrcdta(ji,jj,jpkm1)
[6701]201                     ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1
202                        DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1)
203                           IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN
204                              zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk))
[7646]205                              ztp(jk) = ptrcdta(ji,jj,jkk) + ( ptrcdta(ji,jj,jkk+1) - ptrcdta(ji,jj,jkk) ) * zi
[6701]206                           ENDIF
207                        END DO
208                     ENDIF
[3294]209                  END DO
[6701]210                  DO jk = 1, jpkm1
[7646]211                     ptrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord
[6701]212                  END DO
[7646]213                  ptrcdta(ji,jj,jpk) = 0._wp
[6701]214                END DO
[6607]215            END DO
[3294]216            !
217         ELSE                                !==   z- or zps- coordinate   ==!
[7646]218            ! zps-coordinate (partial steps) interpolation at the last ocean level
[10222]219!            IF( ln_zps ) THEN
220!               DO jj = 1, jpj
221!                  DO ji = 1, jpi
222!                     ik = mbkt(ji,jj)
223!                     IF( ik > 1 ) THEN
224!                        zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
225!                        ptrcdta(ji,jj,ik) = (1.-zl) * ptrcdta(ji,jj,ik) + zl * ptrcdta(ji,jj,ik-1)
226!                     ENDIF
227!                     ik = mikt(ji,jj)
228!                     IF( ik > 1 ) THEN
229!                        zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) )
230!                        ptrcdta(ji,jj,ik) = (1.-zl) * ptrcdta(ji,jj,ik) + zl * ptrcdta(ji,jj,ik+1)
231!                     ENDIF
232!                  END DO
233!              END DO
234!            ENDIF
[3294]235            !
236         ENDIF
237         !
[7646]238         ! Scale by multiplicative factor
239         ptrcdta(:,:,:) = ptrcdta(:,:,:) * ptrcfac
[6701]240         !
[3294]241      ENDIF
[4230]242      !
[9124]243      IF( ln_timing )  CALL timing_stop('trc_dta')
[945]244      !
[1011]245   END SUBROUTINE trc_dta
[6607]246
[268]247#else
248   !!----------------------------------------------------------------------
[945]249   !!   Dummy module                              NO 3D passive tracer data
[268]250   !!----------------------------------------------------------------------
251CONTAINS
[7646]252   SUBROUTINE trc_dta( kt, sf_trcdta, ptrcfac, ptrcdta)        ! 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.