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

Last change on this file since 420 was 376, checked in by opalod, 18 years ago

nemo_v1_bugfix017:RB+CE:small correction for jppo4
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 10.1 KB
RevLine 
[268]1MODULE trcdta
2   !!======================================================================
3   !!                     ***  MODULE  dtatem  ***
4   !! Ocean data  :  read passive tracer data from monthly atlas data
5   !!=====================================================================
[340]6   !!  TOP 1.0,  LOCEAN-IPSL (2005)
7   !! $Header$
8   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
[274]9   !!----------------------------------------------------------------------
[268]10
11#if  defined key_passivetrc && defined key_trc_dta
12   !!----------------------------------------------------------------------
13   !!   'key_trc_dta'                           3D tracer data field
14   !!----------------------------------------------------------------------
15   !!   dta_trc      : read ocean passive tracer data
16   !!----------------------------------------------------------------------
17   !! * Modules used
[335]18   USE oce_trc
19   USE trc
20   USE par_sms
21   USE lib_print
[268]22
23   IMPLICIT NONE
24   PRIVATE
25
26   !! * Routine accessibility
27   PUBLIC dta_trc   ! called by trcdtr.F90 and trcdmp.F90
28
29   !! * Shared module variables
30   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk,jptra) ::   &  !:
31      trdta             !: temperature data at given time-step
32
33   !! * Module variables
34   REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,2) ::   &
35      tracdta            ! temperature data at two consecutive times
36   INTEGER , DIMENSION(jptra) :: &
37      nlectr  ,   &    !!: switch for reading once
38      ntrc1   ,   &    !!: ????
39      ntrc2            !!: ????
40
41   !! * Substitutions
42#  include "passivetrc_substitute.h90"
43
44   !!----------------------------------------------------------------------
45   !!   OPA 9.0 , LODYC-IPSL  (2003)
46   !!----------------------------------------------------------------------
47
48CONTAINS
49
50   !!----------------------------------------------------------------------
51   !!   Default case                                            NetCDF file
52   !!----------------------------------------------------------------------
[335]53   
[268]54   SUBROUTINE dta_trc( kt )
[335]55      !!----------------------------------------------------------------------
56      !!                   ***  ROUTINE dta_trc  ***
57      !!
58      !! ** Purpose :   Reads passive tracer data (Levitus monthly data)
59      !!
60      !! ** Method  :   Read on unit numtr the interpolated tracer concentra-
61      !!      tion onto the global grid. Data begin at january.
62      !!      The value is centered at the middle of month.
63      !!      In the opa model, kt=1 agree with january 1.
64      !!      At each time step, a linear interpolation is applied between
65      !!      two monthly values.
66      !!
67      !! History :
68      !!   8.2  !  02-04  (O. Aumont)  Original code
69      !!   9.0  !  04-03  (C. Ethe)   
70      !!   9.0  !  05-03  (O. Aumont and A. El Moussaoui) F90
71      !!----------------------------------------------------------------------
72      !! * Modules used
[268]73      USE ioipsl
74
75      !! * Arguments
[335]76      !! * Arguments
[268]77      INTEGER, INTENT( in ) ::   kt     ! ocean time-step
78
[335]79      !! * Local declarations
[268]80      INTEGER :: ji, jj, jn, jl 
81      INTEGER, PARAMETER ::  &
82         jpmois  = 12        ! number of months
83
84      INTEGER ::   &
85         imois, iman, i15, itime, ik, &  ! temporary integers
86         ipi, ipj, ipk                              !    "        "
87      INTEGER :: istep(jpmois)
88      CHARACTER (len=39) :: clname(jptra)
89      REAL(wp), DIMENSION (jpi,jpj) ::  zlon, zlat
90      REAL(wp), DIMENSION (jpk) ::  zlev
91      REAL(wp) :: zdate0, zxy, zl
[335]92      !!----------------------------------------------------------------------
[268]93
94      DO jn = 1, jptra
95
[335]96         IF( lutini(jn) ) THEN
[268]97
[335]98            IF ( kt == nit000 ) THEN
99               !! 3D tracer data
100               IF(lwp)WRITE(numout,*)
101               IF(lwp)WRITE(numout,*) ' trcdta: reading tracer' 
102               IF(lwp)WRITE(numout,*) ' data file ', jn
103               IF(lwp)WRITE(numout,*)
104               nlectr(jn) = 0
105            ENDIF
106            ! Initialization
107            iman = jpmois
108            i15  = nday/16
109            imois = nmonth + i15 -1
110            IF( imois == 0 ) imois = iman
111            itime = jpmois
112            ipi = jpiglo
113            ipj = jpjglo
[268]114
[335]115            ! First call kt=nit000
116            ! --------------------
[268]117
[335]118            IF ( kt == nit000 .AND. nlectr(jn) == 0 ) THEN
119               ntrc1(jn) = 0
120               IF(lwp) THEN
121                  WRITE(numout,*)
122                  WRITE(numout,*) ' Tracer monthly fields' 
123                  WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~'
124                  WRITE(numout,*) ' NetCDF FORMAT'
125                  WRITE(numout,*)
126               ENDIF
[268]127
[335]128               ! open file
[268]129
[335]130               clname(jn) = 'LEVITUS_'//ctrcnm(jn)
131               CALL flinopen(TRIM(clname(jn)),mig(1),nlci,mjg(1),nlcj,    &
132                  .FALSE.,ipi,ipj,ipk,zlon,zlat,zlev,itime,    &
133                  istep,zdate0,rdt,numtr(jn)               )
[268]134
[335]135               ! title, dimensions and tests
136               IF( itime /= jpmois ) THEN
137                  IF(lwp) THEN
138                     WRITE(numout,*) ' '
139                     WRITE(numout,*) 'problem with time coordinates'
140                     WRITE(numout,*) ' itime ',itime,' jpmois ',jpmois
141                  ENDIF
142                  STOP 'trc_dta'
143               ENDIF
[268]144
[335]145               IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN
146                  IF(lwp) THEN
147                     WRITE(numout,*) ' '
148                     WRITE(numout,*) 'problem with dimensions'
149                     WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta
150                     WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta
151                     WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk
152                  ENDIF
153                  STOP 'trc_dta'
154               ENDIF
155               IF(lwp)WRITE(numout,*) itime,istep,zdate0,rdt,numtr(jn)
156               trdta(:,:,:,jn) = 0.
157
[268]158            ENDIF
159
160
[335]161            ! Read montly file
162            IF( ( kt == nit000 .AND. nlectr(jn) == 0)   & 
163               .OR. imois /= ntrc1(jn) ) THEN
164               nlectr(jn) = 1
[268]165
[335]166               ! Calendar computation
[268]167
[335]168               ! ntrc1 number of the first file record used in the simulation
169               ! ntrc2 number of the last  file record
[268]170
[335]171               ntrc1(jn) = imois
172               ntrc2(jn) = ntrc1(jn) + 1
173               ntrc1(jn) = MOD( ntrc1(jn), iman )
174               IF ( ntrc1(jn) == 0 ) ntrc1(jn) = iman
175               ntrc2(jn) = MOD( ntrc2(jn), iman )
176               IF ( ntrc2(jn) == 0 ) ntrc2(jn) = iman
177               IF(lwp) WRITE(numout,*) 'first record file used ntrc1 ', ntrc1(jn) 
178               IF(lwp) WRITE(numout,*) 'last  record file used ntrc2 ', ntrc2(jn)
[268]179
[335]180               ! Read montly passive tracer data Levitus
[268]181
[335]182               CALL flinget( numtr(jn),ctrcnm(jn),jpidta,jpjdta,jpk,    &
183                  jpmois,ntrc1(jn),ntrc1(jn),mig(1),nlci,mjg(1),nlcj,  &
184                  tracdta(1:nlci,1:nlcj,1:jpk,jn,1)                  )
[268]185
[335]186               CALL flinget( numtr(jn),ctrcnm(jn),jpidta,jpjdta,jpk,     &
187                  jpmois,ntrc2(jn),ntrc2(jn),mig(1),nlci,mjg(1),nlcj,   &
188                  tracdta(1:nlci,1:nlcj,1:jpk,jn,2)                  )
[268]189
[335]190               IF(lwp) THEN
191                  WRITE(numout,*)
192                  WRITE(numout,*) ' read tracer data ', ctrcnm(jn),' ok'
193                  WRITE(numout,*)
194               ENDIF
[268]195
[335]196               ! Apply Mask
197               DO jl = 1, 2
198                  tracdta(:,:,:  ,jn,jl) = tracdta(:,:,:,jn,jl) * tmask(:,:,:) 
199                  tracdta(:,:,jpk,jn,jl) = 0.
200                  IF( lk_zps ) THEN                ! z-coord. with partial steps
201                     DO jj = 1, jpj                ! interpolation of temperature at the last level
202                        DO ji = 1, jpi
203                           ik = mbathy(ji,jj) - 1
204                           IF( ik > 2 ) THEN
205                              zl = ( gdept(ik) - fsdept(ji,jj,ik) ) / ( gdept(ik) - gdept(ik-1) )
206                              tracdta(ji,jj,ik,jn,jl) = (1.-zl) * tracdta(ji,jj,ik,jn,jl) + zl * tracdta(ji,jj,ik-1,jn,jl)
207                           ENDIF
208                        END DO
209                     END DO
210                  ENDIF
[268]211
212               END DO
[335]213
[268]214            ENDIF
215
[335]216            IF(lwp) THEN
217               WRITE(numout,*) ctrcnm(jn), 'Levitus month ', ntrc1(jn),   &
218                  ntrc2(jn)
219               WRITE(numout,*)
220               WRITE(numout,*) ' Levitus month = ', ntrc1(jn),   &
[268]221                  '  level = 1'
[335]222               CALL prihre( tracdta(1,1,1,jn,1), jpi, jpj, 1, jpi, 20, 1   &
[268]223                  ,jpj, 20, 1., numout )
[335]224               WRITE(numout,*) ' Levitus month = ', ntrc1(jn),    &
[268]225                  '  level = ',jpk/2
[335]226               CALL prihre( tracdta(1,1,jpk/2,jn,1), jpi, jpj, 1, jpi,    &
[268]227                  20, 1, jpj, 20, 1., numout )
[335]228               WRITE(numout,*) ' Levitus month = ',ntrc1(jn)     &
[268]229                  ,'  level = ',jpkm1
[335]230               CALL prihre( tracdta(1,1,jpkm1,jn,1), jpi, jpj, 1, jpi,     &
[268]231                  20, 1, jpj, 20, 1., numout )
[335]232            ENDIF
[268]233
[335]234            ! At every time step compute temperature data
[268]235
[335]236            zxy = FLOAT( nday + 15 - 30 * i15 ) / 30.
237            trdta(:,:,:,jn)=  ( 1. - zxy ) * tracdta(:,:,:,jn,1)    &
238               +       zxy   * tracdta(:,:,:,jn,2) 
[268]239
[335]240            IF( jn == jpno3) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 7.6E-6
241            IF( jn == jpdic) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 1.E-6
242            IF( jn == jptal) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 1.E-6
243            IF( jn == jpoxy) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 44.6E-6
244            IF( jn == jpsil) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 1.E-6
[376]245            IF( jn == jppo4) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 122.E-6
[268]246
247
[335]248         ENDIF
249
[268]250      END DO
251
252   END SUBROUTINE dta_trc
253
254#else
255
256   !!----------------------------------------------------------------------
257   !!   Default case                        NO 3D passive tracer data field
258   !!----------------------------------------------------------------------
259CONTAINS
260   SUBROUTINE dta_trc( kt )        ! Empty routine
261      WRITE(*,*) 'dta_trc: You should not have seen this print! error?', kt
262   END SUBROUTINE dta_trc
263
264#endif
265
266END MODULE trcdta
Note: See TracBrowser for help on using the repository browser.