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

Last change on this file since 5237 was 4624, checked in by acc, 10 years ago

#1305. Fix slow start-up problems on some systems by introducing and using lwm logical to restrict output of merged namelists to the first (or only) processor. lwm is true only on the first processor regardless of ln_ctl. Small changes to all flavours of nemogcm.F90 are also required to write namctl and namcfg after the call to mynode which now opens output.namelist.dyn and writes nammpp.
  • Property svn:keywords set to Id
File size: 13.0 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
[274]11   !!----------------------------------------------------------------------
[3294]12#if  defined key_top 
[268]13   !!----------------------------------------------------------------------
[3294]14   !!   'key_top'                                                TOP model
[268]15   !!----------------------------------------------------------------------
[3294]16   !!   trc_dta    : read and time interpolated passive tracer data
[268]17   !!----------------------------------------------------------------------
[3294]18   USE par_trc       !  passive tracers parameters
19   USE oce_trc       !  shared variables between ocean and passive tracers
20   USE trc           !  passive tracers common variables
21   USE iom           !  I/O manager
22   USE lib_mpp       !  MPP library
23   USE fldread       !  read input fields
[268]24
25   IMPLICIT NONE
26   PRIVATE
27
[2715]28   PUBLIC   trc_dta         ! called in trcini.F90 and trcdmp.F90
[3294]29   PUBLIC   trc_dta_init    ! called in trcini.F90
[268]30
[3294]31   INTEGER  , SAVE, PUBLIC                             :: nb_trcdta   ! number of tracers to be initialised with data
32   INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_index ! indice of tracer which is initialised with data
[4230]33   INTEGER  , SAVE, PUBLIC                             :: ntra        ! MAX( 1, nb_trcdta ) to avoid compilation error with bounds checking
34   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trfac    ! multiplicative factor for tracer values
[4489]35!$AGRIF_DO_NOT_TREAT
[4230]36   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcdta   ! structure of input SST (file informations, fields read)
[4489]37!$AGRIF_END_DO_NOT_TREAT
[268]38   !! * Substitutions
[3294]39#  include "domzgr_substitute.h90"
[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      !
74      !  Initialisation
75      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0 
76      ! Compute the number of tracers to be initialised with data
[4230]77      ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 )
[3294]78      IF( ierr0 > 0 ) THEN
79         CALL ctl_stop( 'trc_nam: unable to allocate n_trc_index' )   ;   RETURN
80      ENDIF
81      nb_trcdta      = 0
82      n_trc_index(:) = 0
[4230]83      DO jn = 1, ntrc
[3294]84         IF( ln_trc_ini(jn) ) THEN
85             nb_trcdta       = nb_trcdta + 1 
86             n_trc_index(jn) = nb_trcdta 
87         ENDIF
88      ENDDO
89      !
90      ntra = MAX( 1, nb_trcdta )   ! To avoid compilation error with bounds checking
[3827]91      IF(lwp) THEN
92         WRITE(numout,*) ' '
93         WRITE(numout,*) ' number of passive tracers to be initialize by data :', ntra
94         WRITE(numout,*) ' '
95      ENDIF
[3294]96      !
[4147]97      REWIND( numnat_ref )              ! Namelist namtrc_dta in reference namelist : Passive tracer input data
98      READ  ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901)
99901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta in reference namelist', lwp )
[268]100
[4147]101      REWIND( numnat_cfg )              ! Namelist namtrc_dta in configuration namelist : Passive tracer input data
102      READ  ( numnat_cfg, namtrc_dta, IOSTAT = ios, ERR = 902 )
103902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta in configuration namelist', lwp )
[4624]104      IF(lwm) WRITE ( numont, namtrc_dta )
[4147]105
[3294]106      IF( lwp ) THEN
[4230]107         DO jn = 1, ntrc
[3294]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               zfact  = rn_trfac(jn)
112               IF( clndta /=  clntrc ) THEN
113                  CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation :  ',   &
114                  &              'the variable name in the data file : '//clndta//   & 
115                  &              '  must be the same than the name of the passive tracer : '//clntrc//' ')
116               ENDIF
117               WRITE(numout,*) ' read an initial file for passive tracer number :', jn, ' name : ', clndta, & 
118               &               ' multiplicative factor : ', zfact
[335]119            ENDIF
[3294]120         END DO
121      ENDIF
122      !
123      IF( nb_trcdta > 0 ) THEN       !  allocate only if the number of tracer to initialise is greater than zero
124         ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 )
125         IF( ierr1 > 0 ) THEN
126            CALL ctl_stop( 'trc_dta_ini: unable to allocate  sf_trcdta structure' )   ;   RETURN
127         ENDIF
128         !
[4230]129         DO jn = 1, ntrc
[3294]130            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file
131               jl = n_trc_index(jn)
132               slf_i(jl)    = sn_trcdta(jn)
133               rf_trfac(jl) = rn_trfac(jn)
134                                            ALLOCATE( sf_trcdta(jl)%fnow(jpi,jpj,jpk)   , STAT=ierr2 )
135               IF( sn_trcdta(jn)%ln_tint )  ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )
136               IF( ierr2 + ierr3 > 0 ) THEN
137                 CALL ctl_stop( 'trc_dta : unable to allocate passive tracer data arrays' )   ;   RETURN
138               ENDIF
139            ENDIF
140            !   
141         ENDDO
142         !                         ! fill sf_trcdta with slf_i and control print
143         CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta', 'Passive tracer data', 'namtrc' )
144         !
145      ENDIF
146      !
[4230]147      DEALLOCATE( slf_i )          ! deallocate local field structure
[3294]148      IF( nn_timing == 1 )  CALL timing_stop('trc_dta_init')
149      !
150   END SUBROUTINE trc_dta_init
[268]151
[493]152
[4230]153   SUBROUTINE trc_dta( kt, sf_dta, zrf_trfac )
[3294]154      !!----------------------------------------------------------------------
155      !!                   ***  ROUTINE trc_dta  ***
156      !!                   
157      !! ** Purpose :   provides passive tracer data at kt
158      !!
159      !! ** Method  : - call fldread routine
160      !!              - s- or mixed z-s coordinate: vertical interpolation on model mesh
161      !!              - ln_trcdmp=F: deallocates the data structure as they are not used
162      !!
[4230]163      !! ** Action  :   sf_dta   passive tracer data on medl mesh and interpolated at time-step kt
[3294]164      !!----------------------------------------------------------------------
165      INTEGER                     , INTENT(in   ) ::   kt     ! ocean time-step
[4230]166      TYPE(FLD), DIMENSION(1)   , INTENT(inout) ::   sf_dta     ! array of information on the field to read
167      REAL(wp)                  , INTENT(in   ) ::   zrf_trfac  ! multiplication factor
[3294]168      !
[4230]169      INTEGER ::   ji, jj, jk, jl, jkk, ik    ! dummy loop indices
[3294]170      REAL(wp)::   zl, zi
171      REAL(wp), DIMENSION(jpk) ::  ztp                ! 1D workspace
172      CHARACTER(len=100) :: clndta
173      !!----------------------------------------------------------------------
174      !
175      IF( nn_timing == 1 )  CALL timing_start('trc_dta')
176      !
177      IF( nb_trcdta > 0 ) THEN
178         !
[4230]179         CALL fld_read( kt, 1, sf_dta )      !==   read data at kt time step   ==!
[3294]180         !
181         IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==!
182            !
183            IF( kt == nit000 .AND. lwp )THEN
184               WRITE(numout,*)
185               WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh'
[268]186            ENDIF
[3294]187            !
188               DO jj = 1, jpj                         ! vertical interpolation of T & S
189                  DO ji = 1, jpi
190                     DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points
[4292]191                        zl = fsdept_n(ji,jj,jk)
192                        IF(     zl < gdept_1d(1  ) ) THEN         ! above the first level of data
[4230]193                           ztp(jk) =  sf_dta(1)%fnow(ji,jj,1)
[4292]194                        ELSEIF( zl > gdept_1d(jpk) ) THEN         ! below the last level of data
[4230]195                           ztp(jk) =  sf_dta(1)%fnow(ji,jj,jpkm1)
[3294]196                        ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1
197                           DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1)
[4292]198                              IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN
199                                 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk))
[4230]200                                 ztp(jk) = sf_dta(1)%fnow(ji,jj,jkk) + ( sf_dta(1)%fnow(ji,jj,jkk+1) - &
201                                           sf_dta(1)%fnow(ji,jj,jkk) ) * zi 
[3294]202                              ENDIF
203                           END DO
204                        ENDIF
[335]205                     END DO
[3294]206                     DO jk = 1, jpkm1
[4230]207                        sf_dta(1)%fnow(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord
[3294]208                     END DO
[4230]209                     sf_dta(1)%fnow(ji,jj,jpk) = 0._wp
[3294]210                  END DO
[268]211               END DO
[3294]212            !
213         ELSE                                !==   z- or zps- coordinate   ==!
214            !                             
[4230]215               sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * tmask(:,:,:)    ! Mask
[3294]216               !
217               IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level
218                  DO jj = 1, jpj
219                     DO ji = 1, jpi
220                        ik = mbkt(ji,jj) 
221                        IF( ik > 1 ) THEN
[4292]222                           zl = ( gdept_1d(ik) - fsdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
[4230]223                           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]224                        ENDIF
225                     END DO
226                  END DO
227               ENDIF
228            !
229         ENDIF
230         !
[4230]231         sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * zrf_trfac   !  multiplicative factor
[3294]232         !
233         IF( lwp .AND. kt == nit000 ) THEN
[4230]234               clndta = TRIM( sf_dta(1)%clvar ) 
[3294]235               WRITE(numout,*) ''//clndta//' data '
[335]236               WRITE(numout,*)
[3294]237               WRITE(numout,*)'  level = 1'
[4230]238               CALL prihre( sf_dta(1)%fnow(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
[3294]239               WRITE(numout,*)'  level = ', jpk/2
[4230]240               CALL prihre( sf_dta(1)%fnow(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
[3294]241               WRITE(numout,*)'  level = ', jpkm1
[4230]242               CALL prihre( sf_dta(1)%fnow(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
[3294]243               WRITE(numout,*)
[945]244         ENDIF
[3294]245      ENDIF
[4230]246      !
[3294]247      IF( nn_timing == 1 )  CALL timing_stop('trc_dta')
[945]248      !
[1011]249   END SUBROUTINE trc_dta
[268]250#else
251   !!----------------------------------------------------------------------
[945]252   !!   Dummy module                              NO 3D passive tracer data
[268]253   !!----------------------------------------------------------------------
254CONTAINS
[4230]255   SUBROUTINE trc_dta( kt, sf_dta, zrf_trfac )        ! Empty routine
[1011]256      WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt
257   END SUBROUTINE trc_dta
[268]258#endif
[945]259   !!======================================================================
[268]260END MODULE trcdta
Note: See TracBrowser for help on using the repository browser.