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

source: trunk/NEMO/TOP_SRC/trcdta.F90 @ 1004

Last change on this file since 1004 was 945, checked in by cetlod, 16 years ago

Update modules for new version of TOP model, see ticket 144
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 8.8 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
[274]9   !!----------------------------------------------------------------------
[945]10#if  defined key_top  &&  defined key_dtatrc
[268]11   !!----------------------------------------------------------------------
[945]12   !!   'key_top'  and  'key_dtatrc'        TOP model + passive tracer data
[268]13   !!----------------------------------------------------------------------
14   !!   dta_trc      : read ocean passive tracer data
15   !!----------------------------------------------------------------------
[335]16   USE oce_trc
[945]17   USE par_trc
[335]18   USE trc
19   USE lib_print
[945]20   USE iom
[268]21
22   IMPLICIT NONE
23   PRIVATE
24
[945]25   PUBLIC dta_trc   ! called in trcdtr.F90 and trcdmp.F90
[268]26
[945]27   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk,jptra) ::   trdta   !: tracer data at given time-step
[268]28
[945]29   REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,2) ::   tracdta            ! tracer data at two consecutive times
30   INTEGER , DIMENSION(jptra) ::   nlectr      !: switch for reading once
31   INTEGER , DIMENSION(jptra) ::   ntrc1       !: number of first month when reading 12 monthly value
32   INTEGER , DIMENSION(jptra) ::   ntrc2       !: number of second month when reading 12 monthly value
[268]33
34   !! * Substitutions
[945]35#  include "top_substitute.h90"
[268]36   !!----------------------------------------------------------------------
[945]37   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)
38   !! $Header:$
39   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
[268]40   !!----------------------------------------------------------------------
41
42CONTAINS
43
44   !!----------------------------------------------------------------------
45   !!   Default case                                            NetCDF file
46   !!----------------------------------------------------------------------
[335]47   
[268]48   SUBROUTINE dta_trc( kt )
[335]49      !!----------------------------------------------------------------------
50      !!                   ***  ROUTINE dta_trc  ***
51      !!
52      !! ** Purpose :   Reads passive tracer data (Levitus monthly data)
53      !!
54      !! ** Method  :   Read on unit numtr the interpolated tracer concentra-
55      !!      tion onto the global grid. Data begin at january.
56      !!      The value is centered at the middle of month.
57      !!      In the opa model, kt=1 agree with january 1.
58      !!      At each time step, a linear interpolation is applied between
59      !!      two monthly values.
60      !!----------------------------------------------------------------------
[268]61      INTEGER, INTENT( in ) ::   kt     ! ocean time-step
[945]62      !!
63      CHARACTER (len=39) ::   clname(jptra)
64      INTEGER, PARAMETER ::   jpmois  = 12        ! number of months
65      INTEGER ::   ji, jj, jn, jl 
66      INTEGER ::   imois, iman, i15, ik  ! temporary integers
67      REAL(wp) ::   zxy, zl
[335]68      !!----------------------------------------------------------------------
[268]69
70      DO jn = 1, jptra
71
[335]72         IF( lutini(jn) ) THEN
[268]73
[493]74            IF ( kt == nittrc000 ) THEN
[335]75               !! 3D tracer data
76               IF(lwp)WRITE(numout,*)
[433]77               IF(lwp)WRITE(numout,*) ' dta_trc: reading tracer' 
78               IF(lwp)WRITE(numout,*) ' data file ', jn, ctrcnm(jn)
[335]79               IF(lwp)WRITE(numout,*)
80               nlectr(jn) = 0
81            ENDIF
82            ! Initialization
83            iman = jpmois
84            i15  = nday/16
85            imois = nmonth + i15 -1
86            IF( imois == 0 ) imois = iman
[268]87
[493]88
[335]89            ! First call kt=nit000
90            ! --------------------
[268]91
[493]92            IF ( kt == nittrc000 .AND. nlectr(jn) == 0 ) THEN
[335]93               ntrc1(jn) = 0
[493]94               IF(lwp) WRITE(numout,*) ' trc_dta : Levitus tracer data monthly fields'
[335]95               ! open file
[945]96# if defined key_pisces
[335]97               clname(jn) = 'LEVITUS_'//ctrcnm(jn)
[945]98# else
[433]99               clname(jn) = ctrcnm(jn)
[945]100# endif
[493]101               CALL iom_open ( clname(jn), numtr(jn) )             
[268]102
103            ENDIF
104
[945]105# if defined key_pisces
[335]106            ! Read montly file
[493]107            IF( ( kt == nittrc000 .AND. nlectr(jn) == 0)  .OR. imois /= ntrc1(jn) ) THEN
[335]108               nlectr(jn) = 1
[268]109
[335]110               ! Calendar computation
[268]111
[335]112               ! ntrc1 number of the first file record used in the simulation
113               ! ntrc2 number of the last  file record
[268]114
[335]115               ntrc1(jn) = imois
116               ntrc2(jn) = ntrc1(jn) + 1
117               ntrc1(jn) = MOD( ntrc1(jn), iman )
118               IF ( ntrc1(jn) == 0 ) ntrc1(jn) = iman
119               ntrc2(jn) = MOD( ntrc2(jn), iman )
120               IF ( ntrc2(jn) == 0 ) ntrc2(jn) = iman
121               IF(lwp) WRITE(numout,*) 'first record file used ntrc1 ', ntrc1(jn) 
122               IF(lwp) WRITE(numout,*) 'last  record file used ntrc2 ', ntrc2(jn)
[268]123
[335]124               ! Read montly passive tracer data Levitus
[268]125
[493]126               CALL iom_get ( numtr(jn), jpdom_data, ctrcnm(jn), tracdta(:,:,:,jn,1), ntrc1(jn) )
127               CALL iom_get ( numtr(jn), jpdom_data, ctrcnm(jn), tracdta(:,:,:,jn,2), ntrc2(jn) )
[268]128
[335]129               IF(lwp) THEN
130                  WRITE(numout,*)
131                  WRITE(numout,*) ' read tracer data ', ctrcnm(jn),' ok'
132                  WRITE(numout,*)
133               ENDIF
[268]134
[335]135               ! Apply Mask
136               DO jl = 1, 2
137                  tracdta(:,:,:  ,jn,jl) = tracdta(:,:,:,jn,jl) * tmask(:,:,:) 
138                  tracdta(:,:,jpk,jn,jl) = 0.
[493]139                  IF( ln_zps ) THEN                ! z-coord. with partial steps
[335]140                     DO jj = 1, jpj                ! interpolation of temperature at the last level
141                        DO ji = 1, jpi
142                           ik = mbathy(ji,jj) - 1
143                           IF( ik > 2 ) THEN
[945]144                              zl = ( gdept_0(ik) - fsdept(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) )
145                              tracdta(ji,jj,ik,jn,jl) = (1.-zl) * tracdta(ji,jj,ik  ,jn,jl)   &
146                                 &                    +     zl  * tracdta(ji,jj,ik-1,jn,jl)
[335]147                           ENDIF
148                        END DO
149                     END DO
150                  ENDIF
[268]151
152               END DO
[335]153
[268]154            ENDIF
155
[335]156            IF(lwp) THEN
[945]157               WRITE(numout,*) ctrcnm(jn), 'Levitus month ', ntrc1(jn), ntrc2(jn)
[335]158               WRITE(numout,*)
[945]159               WRITE(numout,*) ' Levitus month = ', ntrc1(jn), '  level = 1'
[335]160               CALL prihre( tracdta(1,1,1,jn,1), jpi, jpj, 1, jpi, 20, 1   &
[945]161                  &        ,jpj, 20, 1., numout )
162               WRITE(numout,*) ' Levitus month = ', ntrc1(jn), '  level = ',jpk/2
[335]163               CALL prihre( tracdta(1,1,jpk/2,jn,1), jpi, jpj, 1, jpi,    &
[945]164                  &         20, 1, jpj, 20, 1., numout )
165               WRITE(numout,*) ' Levitus month = ',ntrc1(jn),'  level = ',jpkm1
[335]166               CALL prihre( tracdta(1,1,jpkm1,jn,1), jpi, jpj, 1, jpi,     &
[945]167                  &         20, 1, jpj, 20, 1., numout )
[335]168            ENDIF
[268]169
[335]170            ! At every time step compute temperature data
171            zxy = FLOAT( nday + 15 - 30 * i15 ) / 30.
[945]172            trdta(:,:,:,jn) =  ( 1. - zxy ) * tracdta(:,:,:,jn,1)    &
173               &              +       zxy   * tracdta(:,:,:,jn,2) 
[268]174
[945]175            IF( jn == jpno3 )   trdta(:,:,:,jn) = trdta(:,:,:,jn) *   7.6e-6
176            IF( jn == jpdic )   trdta(:,:,:,jn) = trdta(:,:,:,jn) *   1.0e-6
177            IF( jn == jptal )   trdta(:,:,:,jn) = trdta(:,:,:,jn) *   1.0e-6
178            IF( jn == jpoxy )   trdta(:,:,:,jn) = trdta(:,:,:,jn) *  44.6e-6
179            IF( jn == jpsil )   trdta(:,:,:,jn) = trdta(:,:,:,jn) *   1.0e-6
180            IF( jn == jppo4 )   trdta(:,:,:,jn) = trdta(:,:,:,jn) * 122.0e-6
[493]181
182            ! Close the file
183            ! --------------
184           
[945]185            IF( kt == nitend )   CALL iom_close( numtr(jn) )
[493]186
[945]187# else
[433]188            ! Read init file only
[493]189            IF( kt == nittrc000  ) THEN
190               CALL iom_get ( numtr(jn), jpdom_data, ctrcnm(jn), trdta(:,:,:,jn), ntrc1(jn) )
191               trdta(:,:,:,jn) = trdta(:,:,:,jn) * tmask(:,:,:)
192               CALL iom_close ( numtr(jn) )
[433]193            ENDIF 
[945]194# endif
[268]195
[945]196         ENDIF
[268]197
[945]198      END DO
199      !
[268]200   END SUBROUTINE dta_trc
201
202#else
203   !!----------------------------------------------------------------------
[945]204   !!   Dummy module                              NO 3D passive tracer data
[268]205   !!----------------------------------------------------------------------
206CONTAINS
207   SUBROUTINE dta_trc( kt )        ! Empty routine
208      WRITE(*,*) 'dta_trc: You should not have seen this print! error?', kt
209   END SUBROUTINE dta_trc
210#endif
211
[945]212   !!======================================================================
[268]213END MODULE trcdta
Note: See TracBrowser for help on using the repository browser.