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.F in trunk/NEMO/TOP_SRC – NEMO

source: trunk/NEMO/TOP_SRC/trcdta.F @ 186

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

CL + CE : NEMO TRC_SRC start

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 6.8 KB
Line 
1       SUBROUTINE trcdta( kt )
2!!----------------------------------------------------------------------
3!!                   ***  ROUTINE trcdta  ***
4!!
5!! ** Purpose :   Reads passive tracer data (Levitus monthly data)
6!!
7!! ** Method  :   Read on unit numtr the interpolated tracer concentra-
8!!      tion onto the global grid. Data begin at january.
9!!      The value is centered at the middle of month.
10!!      In the opa model, kt=1 agree with january 1.
11!!      At each time step, a linear interpolation is applied between
12!!      two monthly values.
13!!
14!! History :
15!!   8.2  !  02-04  (O. Aumont)  Original code
16!!   9.0  !  04-03  (C. Ethe)   
17!!----------------------------------------------------------------------
18!! * Modules used
19      USE ioipsl
20      USE oce_trc
21      USE trc 
22      USE par_sms
23      USE lib_print
24!! * Arguments
25      INTEGER  kt 
26#if  defined key_passivetrc && defined key_trc_dta 
27!! * Local declarations
28      INTEGER  jn, jl 
29 
30      INTEGER jpmois, jpf
31      PARAMETER (jpmois = 12, jpf = 1 )
32
33      INTEGER imois, iman 
34      INTEGER iyy, imm, idd, i15, itime
35      CHARACTER*38 clname(jptra)
36      INTEGER istep(jpmois)
37      REAL  zlon(jpi, jpj), zlat(jpi, jpj)
38      REAL  zlev(jpk)
39      INTEGER ipi,ipj,ipk
40      REAL zdate0, zxy
41!!----------------------------------------------------------------------
42
43      DO jn = 1, jptra
44
45         IF( lutini(jn) ) THEN
46
47            IF ( kt == nit000 ) THEN
48!! 3D tracer data
49               IF(lwp)WRITE(numout,*)
50               IF(lwp)WRITE(numout,*) ' trcdta: reading tracer' 
51               IF(lwp)WRITE(numout,*) ' data file ', jn
52               IF(lwp)WRITE(numout,*)
53               nlectr(jn) = 0
54            ENDIF
55! Initialization
56            iman = jpmois
57            iyy  = ndastp/10000
58            imm  = (ndastp - iyy*10000)/100
59            idd  = (ndastp - iyy*10000 - imm*100)
60            i15  = idd/16
61            imois = imm + i15 - 1
62            IF( imois == 0 ) imois = iman
63            itime = jpmois
64            ipi = jpi
65            ipj = jpj
66            ipk = jpk
67
68! First call kt=nit000
69            IF ( kt == nit000 .AND. nlectr(jn) == 0 ) THEN
70               ntrc1(jn) = 0
71               IF(lwp) THEN
72                  WRITE(numout,*)
73                  WRITE(numout,*) ' Tracer monthly fields' 
74                  WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~'
75                  WRITE(numout,*) ' NetCDF FORMAT'
76                  WRITE(numout,*)
77               ENDIF
78
79! open file
80               clname(jn) = 'LEVITUS_'//ctrcnm(jn)
81               CALL flinopen(TRIM(clname(jn)),mig(1),nlci,mjg(1),nlcj,
82     &                       .FALSE.,ipi,ipj,ipk,zlon,zlat,zlev,itime,
83     &                        istep,zdate0,rdt,numtr(jn))
84
85! title, dimensions and tests
86               IF( itime /= jpmois ) THEN
87                  IF(lwp) THEN
88                     WRITE(numout,*) ' '
89                     WRITE(numout,*) 'problem with time coordinates'
90                     WRITE(numout,*) ' itime ',itime,' jpmois ',jpmois
91                  ENDIF
92                  STOP 'trc_dta'
93               ENDIF
94               IF( ipi /= jpidta .AND.  ipj /= jpjdta 
95     &                           .AND. ipk /= jpk ) THEN
96                  IF(lwp) THEN
97                     WRITE(numout,*) ' '
98                     WRITE(numout,*) 'problem with dimensions'
99                     WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta
100                     WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta
101                     WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk
102                  ENDIF
103                  STOP 'trc_dta'
104               ENDIF
105               IF(lwp)WRITE(numout,*) itime,istep,zdate0,rdt,numtr(jn)
106               trdta(:,:,:,jn) = 0.
107
108            ENDIF
109
110
111! Read montly file
112            IF( ( kt == nit000 .AND. nlectr(jn) == 0) 
113     &           .OR. imois /= ntrc1(jn) ) THEN
114               nlectr(jn) = 1
115! Calendar computation
116
117! ntrc1 number of the first file record used in the simulation
118! ntrc2 number of the last  file record
119               ntrc1(jn) = imois
120               ntrc2(jn) = ntrc1(jn) + 1
121               ntrc1(jn) = MOD( ntrc1(jn), iman )
122               IF ( ntrc1(jn) == 0 ) ntrc1(jn) = iman
123               ntrc2(jn) = MOD( ntrc2(jn), iman )
124               IF ( ntrc2(jn) == 0 ) ntrc2(jn) = iman
125               IF(lwp) WRITE(numout,*) 'first record file used ntrc1 ', 
126     &                                 ntrc1(jn)
127               IF(lwp) WRITE(numout,*) 'last  record file used ntrc2 ', 
128     &                                 ntrc2(jn)
129
130! Read montly passive tracer data Levitus
131
132               CALL flinget( numtr(jn),ctrcnm(jn),jpidta,jpjdta,jpk,
133     &              jpmois,ntrc1(jn),ntrc1(jn),mig(1),nlci,mjg(1),nlcj,
134     &              tracdta(1:nlci,1:nlcj,1:jpk,jn,1) )
135
136               CALL flinget( numtr(jn),ctrcnm(jn),jpidta,jpjdta,jpk,
137     &              jpmois,ntrc2(jn),ntrc2(jn),mig(1),nlci,mjg(1),nlcj,
138     &              tracdta(1:nlci,1:nlcj,1:jpk,jn,2) )
139
140               IF(lwp) THEN
141                  WRITE(numout,*)
142                  WRITE(numout,*) ' read tracer data ', ctrcnm(jn),' ok'
143                  WRITE(numout,*)
144               ENDIF
145! Apply Mask
146               DO jl = 1, 2
147                  tracdta(:,:,:  ,jn,jl) = tracdta(:,:,:,jn,jl) 
148     &                                   * tmask(:,:,:)
149                  tracdta(:,:,jpk,jn,jl) = 0.
150               END DO
151
152            ENDIF
153
154            IF(lwp) THEN
155               WRITE(numout,*) ctrcnm(jn), 'Levitus month ', ntrc1(jn),
156     $             ntrc2(jn)
157               WRITE(numout,*)
158               WRITE(numout,*) ' Levitus month = ', ntrc1(jn),
159     $             '  level = 1'
160               CALL prihre( tracdta(1,1,1,jn,1), jpi, jpj, 1, jpi, 20, 1
161     $             ,jpj, 20, 1., numout )
162               WRITE(numout,*) ' Levitus month = ', ntrc1(jn),
163     $             '  level = ',jpk/2
164               CALL prihre( tracdta(1,1,jpk/2,jn,1), jpi, jpj, 1, jpi,
165     $             20, 1, jpj, 20, 1., numout )
166               WRITE(numout,*) ' Levitus month = ',ntrc1(jn)
167     $             ,'  level = ',jpkm1
168               CALL prihre( tracdta(1,1,jpkm1,jn,1), jpi, jpj, 1, jpi,
169     $             20, 1, jpj, 20, 1., numout )
170            ENDIF 
171
172! At every time step compute temperature data
173
174            zxy = FLOAT( idd + 15 - 30 * i15 ) / 30.
175            trdta(:,:,:,jn)= ( ( 1. - zxy ) * tracdta(:,:,:,jn,1) 
176     &                        +       zxy   * tracdta(:,:,:,jn,2) )
177   
178            IF( jn == jpno3) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 7.6E-6
179            IF( jn == jpdic) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 1.E-6
180            IF( jn == jptal) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 1.E-6
181            IF( jn == jpoxy) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 44.6E-6
182            IF( jn == jpsil) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 1.E-6
183
184
185         ENDIF
186
187      END DO
188#else
189!      No passive tracer data read
190#endif
191       RETURN
192
193       END SUBROUTINE trcdta
194
Note: See TracBrowser for help on using the repository browser.