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

Last change on this file since 1715 was 1715, checked in by smasson, 14 years ago

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