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.
dtatem.F90 in trunk/NEMO/OPA_SRC/DTA – NEMO

source: trunk/NEMO/OPA_SRC/DTA/dtatem.F90 @ 156

Last change on this file since 156 was 156, checked in by opalod, 20 years ago

CL + CT: UPDATE101: Avoid warning messages at compilation process
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 11.7 KB
Line 
1MODULE dtatem
2   !!======================================================================
3   !!                     ***  MODULE  dtatem  ***
4   !! Ocean data  :  read ocean temperature data from monthly atlas data
5   !!=====================================================================
6#if defined key_dtatem   ||   defined key_esopa
7   !!----------------------------------------------------------------------
8   !!   'key_dtatem'                              3D temperature data field
9   !!----------------------------------------------------------------------
10   !!   dta_tem      : read ocean temperature data
11   !!----------------------------------------------------------------------
12   !! * Modules used
13   USE oce             ! ocean dynamics and tracers
14   USE dom_oce         ! ocean space and time domain
15   USE in_out_manager  ! I/O manager
16   USE daymod          ! calendar
17
18   IMPLICIT NONE
19   PRIVATE
20
21   !! * Routine accessibility
22   PUBLIC dta_tem   ! called by step.F90 and inidta.F90
23
24   !! * Shared module variables
25   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .TRUE.   !: temperature data flag
26   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !:
27      t_dta             !: temperature data at given time-step
28
29   !! * Module variables
30   CHARACTER (len=38) ::   &
31      cl_tdata = 'data_1m_potential_temperature_nomask '
32   INTEGER ::   &
33      nlecte =  0,   &  ! switch for the first read
34      ntem1      ,   &  ! first record used
35      ntem2             ! second record used
36   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   &
37      temdta            ! temperature data at two consecutive times
38
39   !! * Substitutions
40#  include "domzgr_substitute.h90"
41   !!----------------------------------------------------------------------
42   !!   OPA 9.0 , LODYC-IPSL  (2003)
43   !!----------------------------------------------------------------------
44
45CONTAINS
46
47# if defined key_fdir
48   !!----------------------------------------------------------------------
49   !!   'key_fdir'                                       direct access file
50   !!----------------------------------------------------------------------
51#  include "dtatem_fdir.h90"
52
53# else
54   !!----------------------------------------------------------------------
55   !!   Default case                                            NetCDF file
56   !!----------------------------------------------------------------------
57
58   SUBROUTINE dta_tem( kt )
59      !!----------------------------------------------------------------------
60      !!                   ***  ROUTINE dta_tem  ***
61      !!                   
62      !! ** Purpose :   Reads monthly temperature data
63      !!
64      !! ** Method  :   Read on unit numtdt the interpolated temperature
65      !!      onto the model grid.
66      !!      Data begin at january.
67      !!      The value is centered at the middle of month.
68      !!      In the opa model, kt=1 agree with january 1.
69      !!      At each time step, a linear interpolation is applied between
70      !!      two monthly values.
71      !!      Read on unit numtdt
72      !!
73      !! ** Action  :   define t_dta array at time-step kt
74      !!
75      !! History :
76      !!        !  91-03  ()  Original code
77      !!        !  92-07  (M. Imbard)
78      !!        !  99-10  (M.A. Foujols, M. Imbard)  NetCDF FORMAT
79      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
80      !!----------------------------------------------------------------------
81      !! * Modules used
82      USE ioipsl
83
84      !! * Arguments
85      INTEGER, INTENT( in ) ::   kt     ! ocean time-step
86
87      !! * Local declarations
88      INTEGER, PARAMETER ::   &
89         jpmois = 12                    ! number of month
90      INTEGER ::   ji, jj, jl           ! dummy loop indicies
91      INTEGER ::   &
92         imois, iman, itime, ik ,    &  ! temporary integers
93         i15, ipi, ipj, ipk             !    "          "
94#  if defined key_tradmp
95      INTEGER ::   &
96         il0, il1, ii0, ii1, ij0, ij1   ! temporary integers
97# endif
98
99      INTEGER, DIMENSION(jpmois) ::   istep
100      REAL(wp) ::   zxy, zl, zdate0
101      REAL(wp), DIMENSION(jpi,jpj) ::   zlon,zlat
102      REAL(wp), DIMENSION(jpk) ::   zlev
103      !!----------------------------------------------------------------------
104
105
106      ! 0. Initialization
107      ! -----------------
108
109      iman  = jpmois
110      i15   = nday / 16
111      imois = nmonth + i15 - 1
112      IF( imois == 0 )   imois = iman
113
114      itime = jpmois
115      ipi=jpiglo
116      ipj=jpjglo
117
118      ! 1. First call kt=nit000
119      ! -----------------------
120
121      IF( kt == nit000 .AND. nlecte == 0 ) THEN
122         ntem1 = 0
123         IF(lwp) WRITE(numout,*)
124         IF(lwp) WRITE(numout,*) ' dtatem : Levitus monthly fields'
125         IF(lwp) WRITE(numout,*) ' ~~~~~~'
126         IF(lwp) WRITE(numout,*) '             NetCDF FORMAT'
127         IF(lwp) WRITE(numout,*)
128         
129         ! open file
130
131         CALL flinopen( TRIM(cl_tdata), mig(1), nlci , mjg(1),  nlcj   &
132                      , .false.     , ipi   , ipj  , ipk   , zlon   &
133                      , zlat        , zlev  , itime, istep , zdate0   &
134                      , rdt         , numtdt                        )
135
136         ! title, dimensions and tests
137
138         IF( itime /= jpmois ) THEN
139            IF(lwp) THEN
140               WRITE(numout,*)
141               WRITE(numout,*) 'problem with time coordinates'
142               WRITE(numout,*) ' itime ',itime,' jpmois ',jpmois
143            ENDIF
144            STOP 'dtatem'
145         ENDIF
146         IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN
147            IF(lwp) THEN
148               WRITE(numout,*)
149               WRITE(numout,*) 'problem with dimensions'
150               WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta
151               WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta
152               WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk
153            ENDIF
154            STOP 'dtatem'
155         ENDIF
156         IF(lwp) WRITE(numout,*) itime,istep,zdate0,rdt,numtdt
157
158      ENDIF
159
160
161      ! 2. Read monthly file
162      ! -------------------
163
164      IF( ( kt == nit000 .AND. nlecte == 0 ) .OR. imois /= ntem1 ) THEN
165         nlecte = 1
166
167         ! Calendar computation
168         
169         ntem1 = imois        ! first file record used
170         ntem2 = ntem1 + 1    ! last  file record used
171         ntem1 = MOD( ntem1, iman )
172         IF( ntem1 == 0 )   ntem1 = iman
173         ntem2 = MOD( ntem2, iman )
174         IF( ntem2 == 0 )   ntem2 = iman
175         IF(lwp) WRITE(numout,*) 'first record file used ntem1 ', ntem1
176         IF(lwp) WRITE(numout,*) 'last  record file used ntem2 ', ntem2
177         
178         ! Read monthly temperature data Levitus
179         
180         CALL flinget( numtdt, 'votemper', jpidta, jpjdta, jpk   &
181                     , jpmois, ntem1     , ntem1 , mig(1), nlci   &
182                     , mjg(1), nlcj      , temdta(1:nlci,1:nlcj,1:jpk,1)     )
183         CALL flinget( numtdt, 'votemper', jpidta, jpjdta, jpk   &
184                     , jpmois, ntem2     , ntem2 , mig(1), nlci   &
185                     , mjg(1), nlcj      , temdta(1:nlci,1:nlcj,1:jpk,2)     )
186
187         IF(lwp) WRITE(numout,*)
188         IF(lwp) WRITE(numout,*) ' read Levitus temperature ok'
189         IF(lwp) WRITE(numout,*)
190         
191#  if defined key_tradmp
192         IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN
193     
194            !                                        ! =======================
195            !                                        !  ORCA_R2 configuration
196            !                                        ! =======================
197
198            ij0 = 101   ;   ij1 = 109
199            ii0 = 141   ;   ii1 = 155
200            DO jj = mj0(ij0), mj1(ij1)                      ! Reduced temperature in the Alboran Sea
201               DO ji = mi0(ii0), mi1(ii1)
202                  temdta(ji,jj, 13:13 ,:) = temdta(ji,jj, 13:13 ,:) - 0.20
203                  temdta(ji,jj, 14:15 ,:) = temdta(ji,jj, 14:15 ,:) - 0.35
204                  temdta(ji,jj, 16:25 ,:) = temdta(ji,jj, 16:25 ,:) - 0.40
205               END DO
206            END DO
207         
208            IF( n_cla == 0 ) THEN 
209               !                                         ! Reduced temperature at Red Sea
210               ij0 =  87   ;   ij1 =  96
211               ii0 = 148   ;   ii1 = 160
212               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 , : ) = 7.0 
213               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5 
214               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0
215            ELSE
216               il0 = 138   ;   il1 = 138
217               ij0 = 101   ;   ij1 = 102
218               ii0 = 139   ;   ii1 = 139
219               DO jl = mi0(il0), mi1(il1)                ! New temperature profile at Gibraltar
220                  DO jj = mj0(ij0), mj1(ij1)
221                     DO ji = mi0(ii0), mi1(ii1)
222                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
223                     END DO
224                  END DO
225               END DO
226               il0 = 164   ;   il1 = 164
227               ij0 =  88   ;   ij1 =  88
228               ii0 = 161   ;   ii1 = 163
229               DO jl = mi0(il0), mi1(il1)                ! New temperature profile at Bab el Mandeb
230                  DO jj = mj0(ij0), mj1(ij1)
231                     DO ji = mi0(ii0), mi1(ii1)
232                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
233                     END DO
234                  END DO
235                  ij0 =  87   ;   ij1 =  87
236                  DO jj = mj0(ij0), mj1(ij1)
237                     DO ji = mi0(ii0), mi1(ii1)
238                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
239                     END DO
240                  END DO
241               END DO
242            ENDIF
243
244         ENDIF
245#  endif
246
247         !                                  ! Mask
248         DO jl = 1, 2
249            temdta(:,:,:,jl) = temdta(:,:,:,jl) * tmask(:,:,:)
250            temdta(:,:,jpk,jl) = 0.
251            IF( lk_zps ) THEN                ! z-coord. with partial steps
252               DO jj = 1, jpj                  ! interpolation of temperature at the last level
253                  DO ji = 1, jpi
254                     ik = mbathy(ji,jj) - 1
255                     IF( ik > 2 ) THEN
256                        zl = ( gdept(ik) - fsdept(ji,jj,ik) ) / ( gdept(ik) - gdept(ik-1) )
257                        temdta(ji,jj,ik,jl) = (1.-zl) * temdta(ji,jj,ik,jl) + zl * temdta(ji,jj,ik-1,jl) 
258                     ENDIF
259                  END DO
260               END DO
261            ENDIF
262         END DO
263
264         IF(lwp) THEN
265            WRITE(numout,*) ' temperature Levitus month ', ntem1, ntem2
266            WRITE(numout,*)
267            WRITE(numout,*) ' Levitus month = ', ntem1, '  level = 1'
268            CALL prihre( temdta(1,1,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
269            WRITE(numout,*) ' Levitus month = ', ntem1, '  level = ', jpk/2
270            CALL prihre( temdta(1,1,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
271            WRITE(numout,*) ' Levitus month = ',ntem1,'  level = ', jpkm1
272            CALL prihre( temdta(1,1,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
273         ENDIF
274      ENDIF
275
276 
277      ! 2. At every time step compute temperature data
278      ! ----------------------------------------------
279
280      zxy = FLOAT( nday + 15 - 30 * i15 ) / 30.
281      t_dta(:,:,:) = (1.-zxy) * temdta(:,:,:,1) + zxy * temdta(:,:,:,2)
282
283   END SUBROUTINE dta_tem
284
285# endif
286
287#else
288   !!----------------------------------------------------------------------
289   !!   Default case                           NO 3D temperature data field
290   !!----------------------------------------------------------------------
291   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .FALSE.   !: temperature data flag
292CONTAINS
293   SUBROUTINE dta_tem( kt )        ! Empty routine
294      WRITE(*,*) 'dta_tem: You should not have seen this print! error?', kt
295   END SUBROUTINE dta_tem
296#endif
297   !!======================================================================
298END MODULE dtatem
Note: See TracBrowser for help on using the repository browser.