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

Last change on this file since 268 was 268, checked in by opalod, 19 years ago

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