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

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

CT : BUGFIX159 : initialize ipk=jpk to avoid error when running on IBM and with IOIPSL-2-0 tag
  • 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      ipk = jpk
118
119      ! 1. First call kt=nit000
120      ! -----------------------
121
122      IF( kt == nit000 .AND. nlecte == 0 ) THEN
123         ntem1 = 0
124         IF(lwp) WRITE(numout,*)
125         IF(lwp) WRITE(numout,*) ' dtatem : Levitus monthly fields'
126         IF(lwp) WRITE(numout,*) ' ~~~~~~'
127         IF(lwp) WRITE(numout,*) '             NetCDF FORMAT'
128         IF(lwp) WRITE(numout,*)
129         
130         ! open file
131
132         CALL flinopen( TRIM(cl_tdata), mig(1), nlci , mjg(1),  nlcj   &
133                      , .false.     , ipi   , ipj  , ipk   , zlon   &
134                      , zlat        , zlev  , itime, istep , zdate0   &
135                      , rdt         , numtdt                        )
136
137         ! title, dimensions and tests
138
139         IF( itime /= jpmois ) THEN
140            IF(lwp) THEN
141               WRITE(numout,*)
142               WRITE(numout,*) 'problem with time coordinates'
143               WRITE(numout,*) ' itime ',itime,' jpmois ',jpmois
144            ENDIF
145            STOP 'dtatem'
146         ENDIF
147         IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN
148            IF(lwp) THEN
149               WRITE(numout,*)
150               WRITE(numout,*) 'problem with dimensions'
151               WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta
152               WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta
153               WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk
154            ENDIF
155            STOP 'dtatem'
156         ENDIF
157         IF(lwp) WRITE(numout,*) itime,istep,zdate0,rdt,numtdt
158
159      ENDIF
160
161
162      ! 2. Read monthly file
163      ! -------------------
164
165      IF( ( kt == nit000 .AND. nlecte == 0 ) .OR. imois /= ntem1 ) THEN
166         nlecte = 1
167
168         ! Calendar computation
169         
170         ntem1 = imois        ! first file record used
171         ntem2 = ntem1 + 1    ! last  file record used
172         ntem1 = MOD( ntem1, iman )
173         IF( ntem1 == 0 )   ntem1 = iman
174         ntem2 = MOD( ntem2, iman )
175         IF( ntem2 == 0 )   ntem2 = iman
176         IF(lwp) WRITE(numout,*) 'first record file used ntem1 ', ntem1
177         IF(lwp) WRITE(numout,*) 'last  record file used ntem2 ', ntem2
178         
179         ! Read monthly temperature data Levitus
180         
181         CALL flinget( numtdt, 'votemper', jpidta, jpjdta, jpk   &
182                     , jpmois, ntem1     , ntem1 , mig(1), nlci   &
183                     , mjg(1), nlcj      , temdta(1:nlci,1:nlcj,1:jpk,1)     )
184         CALL flinget( numtdt, 'votemper', jpidta, jpjdta, jpk   &
185                     , jpmois, ntem2     , ntem2 , mig(1), nlci   &
186                     , mjg(1), nlcj      , temdta(1:nlci,1:nlcj,1:jpk,2)     )
187
188         IF(lwp) WRITE(numout,*)
189         IF(lwp) WRITE(numout,*) ' read Levitus temperature ok'
190         IF(lwp) WRITE(numout,*)
191         
192#  if defined key_tradmp
193         IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN
194     
195            !                                        ! =======================
196            !                                        !  ORCA_R2 configuration
197            !                                        ! =======================
198
199            ij0 = 101   ;   ij1 = 109
200            ii0 = 141   ;   ii1 = 155
201            DO jj = mj0(ij0), mj1(ij1)                      ! Reduced temperature in the Alboran Sea
202               DO ji = mi0(ii0), mi1(ii1)
203                  temdta(ji,jj, 13:13 ,:) = temdta(ji,jj, 13:13 ,:) - 0.20
204                  temdta(ji,jj, 14:15 ,:) = temdta(ji,jj, 14:15 ,:) - 0.35
205                  temdta(ji,jj, 16:25 ,:) = temdta(ji,jj, 16:25 ,:) - 0.40
206               END DO
207            END DO
208         
209            IF( n_cla == 0 ) THEN 
210               !                                         ! Reduced temperature at Red Sea
211               ij0 =  87   ;   ij1 =  96
212               ii0 = 148   ;   ii1 = 160
213               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 , : ) = 7.0 
214               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5 
215               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0
216            ELSE
217               il0 = 138   ;   il1 = 138
218               ij0 = 101   ;   ij1 = 102
219               ii0 = 139   ;   ii1 = 139
220               DO jl = mi0(il0), mi1(il1)                ! New temperature profile at Gibraltar
221                  DO jj = mj0(ij0), mj1(ij1)
222                     DO ji = mi0(ii0), mi1(ii1)
223                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
224                     END DO
225                  END DO
226               END DO
227               il0 = 164   ;   il1 = 164
228               ij0 =  88   ;   ij1 =  88
229               ii0 = 161   ;   ii1 = 163
230               DO jl = mi0(il0), mi1(il1)                ! New temperature profile at Bab el Mandeb
231                  DO jj = mj0(ij0), mj1(ij1)
232                     DO ji = mi0(ii0), mi1(ii1)
233                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
234                     END DO
235                  END DO
236                  ij0 =  87   ;   ij1 =  87
237                  DO jj = mj0(ij0), mj1(ij1)
238                     DO ji = mi0(ii0), mi1(ii1)
239                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
240                     END DO
241                  END DO
242               END DO
243            ENDIF
244
245         ENDIF
246#  endif
247
248         !                                  ! Mask
249         DO jl = 1, 2
250            temdta(:,:,:,jl) = temdta(:,:,:,jl) * tmask(:,:,:)
251            temdta(:,:,jpk,jl) = 0.
252            IF( lk_zps ) THEN                ! z-coord. with partial steps
253               DO jj = 1, jpj                  ! interpolation of temperature at the last level
254                  DO ji = 1, jpi
255                     ik = mbathy(ji,jj) - 1
256                     IF( ik > 2 ) THEN
257                        zl = ( gdept(ik) - fsdept(ji,jj,ik) ) / ( gdept(ik) - gdept(ik-1) )
258                        temdta(ji,jj,ik,jl) = (1.-zl) * temdta(ji,jj,ik,jl) + zl * temdta(ji,jj,ik-1,jl) 
259                     ENDIF
260                  END DO
261               END DO
262            ENDIF
263         END DO
264
265         IF(lwp) THEN
266            WRITE(numout,*) ' temperature Levitus month ', ntem1, ntem2
267            WRITE(numout,*)
268            WRITE(numout,*) ' Levitus month = ', ntem1, '  level = 1'
269            CALL prihre( temdta(1,1,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
270            WRITE(numout,*) ' Levitus month = ', ntem1, '  level = ', jpk/2
271            CALL prihre( temdta(1,1,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
272            WRITE(numout,*) ' Levitus month = ',ntem1,'  level = ', jpkm1
273            CALL prihre( temdta(1,1,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
274         ENDIF
275      ENDIF
276
277 
278      ! 2. At every time step compute temperature data
279      ! ----------------------------------------------
280
281      zxy = FLOAT( nday + 15 - 30 * i15 ) / 30.
282      t_dta(:,:,:) = (1.-zxy) * temdta(:,:,:,1) + zxy * temdta(:,:,:,2)
283
284   END SUBROUTINE dta_tem
285
286# endif
287
288#else
289   !!----------------------------------------------------------------------
290   !!   Default case                           NO 3D temperature data field
291   !!----------------------------------------------------------------------
292   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .FALSE.   !: temperature data flag
293CONTAINS
294   SUBROUTINE dta_tem( kt )        ! Empty routine
295      WRITE(*,*) 'dta_tem: You should not have seen this print! error?', kt
296   END SUBROUTINE dta_tem
297#endif
298   !!======================================================================
299END MODULE dtatem
Note: See TracBrowser for help on using the repository browser.