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

Last change on this file since 1273 was 1273, checked in by ctlod, 15 years ago

update Gibrlatar, Bab El Mandeb and Sound straits in both full & partial steps bathymetry files such as closed seas, see ticket: #305
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 13.5 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   !!---l-------------------------------------------------------------------
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 phycst          ! physical constants
17   USE daymod          ! calendar
18#if defined key_orca_lev10
19   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
20#endif
21   IMPLICIT NONE
22   PRIVATE
23
24   !! * Routine accessibility
25   PUBLIC dta_tem   ! called by step.F90 and inidta.F90
26
27   !! * Shared module variables
28   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .TRUE.   !: temperature data flag
29   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !:
30      t_dta             !: temperature data at given time-step
31
32   !! * Module variables
33   INTEGER ::   &
34      numtdt,        &  !: logical unit for data temperature
35      ntem1, ntem2  ! first and 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 , LOCEAN-IPSL (2005)
43   !! $Id$
44   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
45   !!----------------------------------------------------------------------
46
47CONTAINS
48
49   !!----------------------------------------------------------------------
50   !!   Default case                                            NetCDF file
51   !!----------------------------------------------------------------------
52
53   SUBROUTINE dta_tem( kt )
54      !!----------------------------------------------------------------------
55      !!                   ***  ROUTINE dta_tem  ***
56      !!                   
57      !! ** Purpose :   Reads monthly temperature data
58      !!
59      !! ** Method  :   Read on unit numtdt the interpolated temperature
60      !!      onto the model grid.
61      !!      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      !!      Read on unit numtdt
67      !!
68      !! ** Action  :   define t_dta array at time-step kt
69      !!
70      !! History :
71      !!        !  91-03  ()  Original code
72      !!        !  92-07  (M. Imbard)
73      !!        !  99-10  (M.A. Foujols, M. Imbard)  NetCDF FORMAT
74      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
75      !!----------------------------------------------------------------------
76      !! * Modules used
77      USE iom
78
79      !! * Arguments
80      INTEGER, INTENT( in ) ::   kt     ! ocean time-step
81
82      !! * Local declarations
83      INTEGER ::   ji, jj, jl, jk, jkk       ! dummy loop indicies
84      INTEGER ::   &
85         imois, iman, i15 , ik      ! temporary integers
86#  if defined key_tradmp
87      INTEGER ::   &
88         il0, il1, ii0, ii1, ij0, ij1   ! temporary integers
89# endif
90      REAL(wp) ::   zxy, zl
91#if defined key_orca_lev10
92      REAL(wp), DIMENSION(jpi,jpj,jpkdta,2) :: ztem
93      INTEGER   :: ikr, ikw, ikt, jjk 
94      REAL(wp)  :: zfac
95#endif
96      REAL(wp), DIMENSION(jpk,2) ::   &
97         ztemdta            ! auxiliary array for interpolation
98      !!----------------------------------------------------------------------
99     
100      ! 0. Initialization
101      ! -----------------
102     
103      iman  = INT( raamo )
104!!! better but change the results     i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) )
105      i15   = nday / 16
106      imois = nmonth + i15 - 1
107      IF( imois == 0 ) imois = iman
108     
109      ! 1. First call kt=nit000
110      ! -----------------------
111     
112      IF( kt == nit000 ) THEN
113         
114         ntem1= 0   ! initializations
115         IF(lwp) WRITE(numout,*) ' dta_tem : Levitus monthly fields'
116         CALL iom_open ( 'data_1m_potential_temperature_nomask', numtdt ) 
117         
118      ENDIF
119     
120     
121      ! 2. Read monthly file
122      ! -------------------
123     
124      IF( kt == nit000 .OR. imois /= ntem1 ) THEN
125         
126         ! Calendar computation
127         
128         ntem1 = imois        ! first file record used
129         ntem2 = ntem1 + 1    ! last  file record used
130         ntem1 = MOD( ntem1, iman )
131         IF( ntem1 == 0 )   ntem1 = iman
132         ntem2 = MOD( ntem2, iman )
133         IF( ntem2 == 0 )   ntem2 = iman
134         IF(lwp) WRITE(numout,*) 'first record file used ntem1 ', ntem1
135         IF(lwp) WRITE(numout,*) 'last  record file used ntem2 ', ntem2
136         
137         ! Read monthly temperature data Levitus
138         
139#if defined key_orca_lev10
140         if (ln_zps) stop
141         ztem(:,:,:,:) = 0.
142         CALL iom_get (numtdt,jpdom_data,'votemper',ztem(:,:,:,1),ntem1)
143         CALL iom_get (numtdt,jpdom_data,'votemper',ztem(:,:,:,2),ntem2)
144#else         
145         CALL iom_get (numtdt,jpdom_data,'votemper',temdta(:,:,:,1),ntem1)
146         CALL iom_get (numtdt,jpdom_data,'votemper',temdta(:,:,:,2),ntem2)
147#endif
148         
149         IF(lwp) WRITE(numout,*)
150         IF(lwp) WRITE(numout,*) ' read Levitus temperature ok'
151         IF(lwp) WRITE(numout,*)
152         
153#if defined key_tradmp
154         IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN
155           
156            !                                        ! =======================
157            !                                        !  ORCA_R2 configuration
158            !                                        ! =======================
159            ij0 = 101   ;   ij1 = 109
160            ii0 = 141   ;   ii1 = 155
161            DO jj = mj0(ij0), mj1(ij1)                      ! Reduced temperature in the Alboran Sea
162               DO ji = mi0(ii0), mi1(ii1)
163#if defined key_orca_lev10
164                  ztem(  ji,jj, 13:13 ,:) = ztem  (ji,jj, 13:13 ,:) - 0.20
165                  ztem  (ji,jj, 14:15 ,:) = ztem  (ji,jj, 14:15 ,:) - 0.35
166                  ztem  (ji,jj, 16:25 ,:) = ztem  (ji,jj, 16:25 ,:) - 0.40
167#else
168                  temdta(ji,jj, 13:13 ,:) = temdta(ji,jj, 13:13 ,:) - 0.20
169                  temdta(ji,jj, 14:15 ,:) = temdta(ji,jj, 14:15 ,:) - 0.35
170                  temdta(ji,jj, 16:25 ,:) = temdta(ji,jj, 16:25 ,:) - 0.40
171#endif
172               END DO
173            END DO
174           
175            IF( n_cla == 1 ) THEN 
176               !                                         ! New temperature profile at Gibraltar
177               il0 = 138   ;   il1 = 138
178               ij0 = 101   ;   ij1 = 102
179               ii0 = 139   ;   ii1 = 139
180               DO jl = mi0(il0), mi1(il1)
181                  DO jj = mj0(ij0), mj1(ij1)
182                     DO ji = mi0(ii0), mi1(ii1)
183#if defined key_orca_lev10
184                        ztem  (ji,jj,:,:) = ztem  (jl,jj,:,:)
185#else
186                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
187#endif
188                     END DO
189                  END DO
190               END DO
191               !                                         ! New temperature profile at Bab el Mandeb
192               il0 = 164   ;   il1 = 164
193               ij0 =  87   ;   ij1 =  88
194               ii0 = 161   ;   ii1 = 163
195               DO jl = mi0(il0), mi1(il1)
196                  DO jj = mj0(ij0), mj1(ij1)
197                     DO ji = mi0(ii0), mi1(ii1)
198#if defined key_orca_lev10
199                        ztem  (ji,jj,:,:) = ztem  (jl,jj,:,:)
200#else
201                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
202#endif
203                     END DO
204                  END DO
205               END DO
206               !
207            ELSE
208               !                                         ! Reduced temperature at Red Sea
209               ij0 =  87   ;   ij1 =  96
210               ii0 = 148   ;   ii1 = 160
211#if defined key_orca_lev10
212               ztem  ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 , : ) = 7.0 
213               ztem  ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5 
214               ztem  ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0
215#else
216               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 , : ) = 7.0 
217               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5 
218               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0
219#endif
220            ENDIF
221            !
222         ENDIF
223#endif
224         
225#if defined key_orca_lev10
226         ! interpolate from 31 to 301 level the ztem field result in temdta
227         DO jl = 1, 2
228            DO jjk = 1, 5
229               temdta(:,:,jjk,jl) = ztem(:,:,1,jl)
230            END DO
231            DO jk = 1, jpk-20,10
232               ik = jk+5
233               ikr =  INT(jk/10) + 1
234               ikw =  (ikr-1) *10 + 1
235               ikt =  ikw + 5
236               DO jjk=ikt,ikt+9
237                  zfac = ( gdept_0(jjk   ) - gdepw_0(ikt) ) / ( gdepw_0(ikt+10) - gdepw_0(ikt) )
238                  temdta(:,:,jjk,jl) = ztem(:,:,ikr,jl) + ( ztem(:,:,ikr+1,jl) - ztem(:,:,ikr,jl) ) * zfac
239               END DO
240            END DO
241            DO jjk = jpk-5, jpk
242               temdta(:,:,jjk,jl) = ztem(:,:,jpkdta-1,jl)
243            END DO
244            ! fill the overlap areas
245            CALL lbc_lnk (temdta(:,:,:,jl),'Z',-999.,'no0')
246         END DO
247#endif
248         
249         IF( ln_sco ) THEN
250            DO jl = 1, 2
251               DO jj = 1, jpj                  ! interpolation of temperatures
252                  DO ji = 1, jpi
253                     DO jk = 1, jpk
254                        zl=fsdept(ji,jj,jk)
255                        IF(zl < gdept_0(1)) ztemdta(jk,jl) =  temdta(ji,jj,1,jl)
256                        IF(zl > gdept_0(jpk)) ztemdta(jk,jl) =  temdta(ji,jj,jpkm1,jl)
257                        DO jkk = 1, jpkm1
258                           IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN
259                              ztemdta(jk,jl) = temdta(ji,jj,jkk,jl)                                 &
260                                   &           + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk))      &
261                                   &                              *(temdta(ji,jj,jkk+1,jl) - temdta(ji,jj,jkk,jl))
262                           ENDIF
263                        END DO
264                     END DO
265                     DO jk = 1, jpkm1
266                        temdta(ji,jj,jk,jl) = ztemdta(jk,jl)
267                     END DO
268                     temdta(ji,jj,jpk,jl) = 0.0
269                  END DO
270               END DO
271            END DO
272           
273            IF(lwp) WRITE(numout,*)
274            IF(lwp) WRITE(numout,*) ' Levitus temperature data interpolated to s-coordinate'
275            IF(lwp) WRITE(numout,*)
276           
277         ELSE
278           
279            !                                  ! Mask
280            DO jl = 1, 2
281               temdta(:,:,:,jl) = temdta(:,:,:,jl) * tmask(:,:,:)
282               temdta(:,:,jpk,jl) = 0.
283               IF( ln_zps ) THEN                ! z-coord. with partial steps
284                  DO jj = 1, jpj                  ! interpolation of temperature at the last level
285                     DO ji = 1, jpi
286                        ik = mbathy(ji,jj) - 1
287                        IF( ik > 2 ) THEN
288                           zl = ( gdept_0(ik) - fsdept(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) )
289                           temdta(ji,jj,ik,jl) = (1.-zl) * temdta(ji,jj,ik,jl) + zl * temdta(ji,jj,ik-1,jl)
290                        ENDIF
291                     END DO
292                  END DO
293               ENDIF
294            END DO
295           
296         ENDIF
297         
298         IF(lwp) THEN
299            WRITE(numout,*) ' temperature Levitus month ', ntem1, ntem2
300            WRITE(numout,*)
301            WRITE(numout,*) ' Levitus month = ', ntem1, '  level = 1'
302            CALL prihre( temdta(:,:,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
303            WRITE(numout,*) ' Levitus month = ', ntem1, '  level = ', jpk/2
304            CALL prihre( temdta(:,:,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
305            WRITE(numout,*) ' Levitus month = ',ntem1,'  level = ', jpkm1
306            CALL prihre( temdta(:,:,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
307         ENDIF
308      ENDIF
309     
310     
311      ! 2. At every time step compute temperature data
312      ! ----------------------------------------------
313     
314      zxy = FLOAT( nday + 15 - 30 * i15 ) / 30.
315      t_dta(:,:,:) = (1.-zxy) * temdta(:,:,:,1) + zxy * temdta(:,:,:,2)
316     
317      ! Close the file
318      ! --------------
319     
320      IF( kt == nitend )   CALL iom_close (numtdt)
321     
322    END SUBROUTINE dta_tem
323
324#else
325   !!----------------------------------------------------------------------
326   !!   Default case                           NO 3D temperature data field
327   !!----------------------------------------------------------------------
328   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .FALSE.   !: temperature data flag
329CONTAINS
330   SUBROUTINE dta_tem( kt )        ! Empty routine
331      WRITE(*,*) 'dta_tem: You should not have seen this print! error?', kt
332   END SUBROUTINE dta_tem
333#endif
334   !!======================================================================
335END MODULE dtatem
Note: See TracBrowser for help on using the repository browser.