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

Last change on this file since 1152 was 1152, checked in by rblod, 16 years ago

Convert cvs header to svn Id, step II
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 13.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   !!---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           
160            ij0 = 101   ;   ij1 = 109
161            ii0 = 141   ;   ii1 = 155
162            DO jj = mj0(ij0), mj1(ij1)                      ! Reduced temperature in the Alboran Sea
163               DO ji = mi0(ii0), mi1(ii1)
164#if defined key_orca_lev10
165                  ztem(  ji,jj, 13:13 ,:) = ztem  (ji,jj, 13:13 ,:) - 0.20
166                  ztem  (ji,jj, 14:15 ,:) = ztem  (ji,jj, 14:15 ,:) - 0.35
167                  ztem  (ji,jj, 16:25 ,:) = ztem  (ji,jj, 16:25 ,:) - 0.40
168#else
169                  temdta(ji,jj, 13:13 ,:) = temdta(ji,jj, 13:13 ,:) - 0.20
170                  temdta(ji,jj, 14:15 ,:) = temdta(ji,jj, 14:15 ,:) - 0.35
171                  temdta(ji,jj, 16:25 ,:) = temdta(ji,jj, 16:25 ,:) - 0.40
172#endif
173               END DO
174            END DO
175           
176            IF( n_cla == 0 ) THEN 
177               !                                         ! Reduced temperature at Red Sea
178               ij0 =  87   ;   ij1 =  96
179               ii0 = 148   ;   ii1 = 160
180#if defined key_orca_lev10
181               ztem  ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 , : ) = 7.0 
182               ztem  ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5 
183               ztem  ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0
184#else
185               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 , : ) = 7.0 
186               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5 
187               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0
188#endif
189            ELSE
190               il0 = 138   ;   il1 = 138
191               ij0 = 101   ;   ij1 = 102
192               ii0 = 139   ;   ii1 = 139
193               DO jl = mi0(il0), mi1(il1)                ! New temperature profile at Gibraltar
194                  DO jj = mj0(ij0), mj1(ij1)
195                     DO ji = mi0(ii0), mi1(ii1)
196#if defined key_orca_lev10
197                        ztem  (ji,jj,:,:) = ztem  (jl,jj,:,:)
198#else
199                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
200#endif
201                     END DO
202                  END DO
203               END DO
204               il0 = 164   ;   il1 = 164
205               ij0 =  88   ;   ij1 =  88
206               ii0 = 161   ;   ii1 = 163
207               DO jl = mi0(il0), mi1(il1)                ! New temperature profile at Bab el Mandeb
208                  DO jj = mj0(ij0), mj1(ij1)
209                     DO ji = mi0(ii0), mi1(ii1)
210#if defined key_orca_lev10
211                        ztem  (ji,jj,:,:) = ztem  (jl,jj,:,:)
212#else
213                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
214#endif
215                     END DO
216                  END DO
217                  ij0 =  87   ;   ij1 =  87
218                  DO jj = mj0(ij0), mj1(ij1)
219                     DO ji = mi0(ii0), mi1(ii1)
220#if defined key_orca_lev10
221                        ztem  (ji,jj,:,:) = ztem  (jl,jj,:,:)
222#else
223                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
224#endif
225                     END DO
226                  END DO
227               END DO
228            ENDIF
229           
230         ENDIF
231#endif
232         
233#if defined key_orca_lev10
234         ! interpolate from 31 to 301 level the ztem field result in temdta
235         DO jl = 1, 2
236            DO jjk = 1, 5
237               temdta(:,:,jjk,jl) = ztem(:,:,1,jl)
238            END DO
239            DO jk = 1, jpk-20,10
240               ik = jk+5
241               ikr =  INT(jk/10) + 1
242               ikw =  (ikr-1) *10 + 1
243               ikt =  ikw + 5
244               DO jjk=ikt,ikt+9
245                  zfac = ( gdept_0(jjk   ) - gdepw_0(ikt) ) / ( gdepw_0(ikt+10) - gdepw_0(ikt) )
246                  temdta(:,:,jjk,jl) = ztem(:,:,ikr,jl) + ( ztem(:,:,ikr+1,jl) - ztem(:,:,ikr,jl) ) * zfac
247               END DO
248            END DO
249            DO jjk = jpk-5, jpk
250               temdta(:,:,jjk,jl) = ztem(:,:,jpkdta-1,jl)
251            END DO
252            ! fill the overlap areas
253            CALL lbc_lnk (temdta(:,:,:,jl),'Z',-999.,'no0')
254         END DO
255#endif
256         
257         IF( ln_sco ) THEN
258            DO jl = 1, 2
259               DO jj = 1, jpj                  ! interpolation of temperatures
260                  DO ji = 1, jpi
261                     DO jk = 1, jpk
262                        zl=fsdept(ji,jj,jk)
263                        IF(zl < gdept_0(1)) ztemdta(jk,jl) =  temdta(ji,jj,1,jl)
264                        IF(zl > gdept_0(jpk)) ztemdta(jk,jl) =  temdta(ji,jj,jpkm1,jl)
265                        DO jkk = 1, jpkm1
266                           IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN
267                              ztemdta(jk,jl) = temdta(ji,jj,jkk,jl)                                 &
268                                   &           + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk))      &
269                                   &                              *(temdta(ji,jj,jkk+1,jl) - temdta(ji,jj,jkk,jl))
270                           ENDIF
271                        END DO
272                     END DO
273                     DO jk = 1, jpkm1
274                        temdta(ji,jj,jk,jl) = ztemdta(jk,jl)
275                     END DO
276                     temdta(ji,jj,jpk,jl) = 0.0
277                  END DO
278               END DO
279            END DO
280           
281            IF(lwp) WRITE(numout,*)
282            IF(lwp) WRITE(numout,*) ' Levitus temperature data interpolated to s-coordinate'
283            IF(lwp) WRITE(numout,*)
284           
285         ELSE
286           
287            !                                  ! Mask
288            DO jl = 1, 2
289               temdta(:,:,:,jl) = temdta(:,:,:,jl) * tmask(:,:,:)
290               temdta(:,:,jpk,jl) = 0.
291               IF( ln_zps ) THEN                ! z-coord. with partial steps
292                  DO jj = 1, jpj                  ! interpolation of temperature at the last level
293                     DO ji = 1, jpi
294                        ik = mbathy(ji,jj) - 1
295                        IF( ik > 2 ) THEN
296                           zl = ( gdept_0(ik) - fsdept(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) )
297                           temdta(ji,jj,ik,jl) = (1.-zl) * temdta(ji,jj,ik,jl) + zl * temdta(ji,jj,ik-1,jl)
298                        ENDIF
299                     END DO
300                  END DO
301               ENDIF
302            END DO
303           
304         ENDIF
305         
306         IF(lwp) THEN
307            WRITE(numout,*) ' temperature Levitus month ', ntem1, ntem2
308            WRITE(numout,*)
309            WRITE(numout,*) ' Levitus month = ', ntem1, '  level = 1'
310            CALL prihre( temdta(:,:,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
311            WRITE(numout,*) ' Levitus month = ', ntem1, '  level = ', jpk/2
312            CALL prihre( temdta(:,:,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
313            WRITE(numout,*) ' Levitus month = ',ntem1,'  level = ', jpkm1
314            CALL prihre( temdta(:,:,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
315         ENDIF
316      ENDIF
317     
318     
319      ! 2. At every time step compute temperature data
320      ! ----------------------------------------------
321     
322      zxy = FLOAT( nday + 15 - 30 * i15 ) / 30.
323      t_dta(:,:,:) = (1.-zxy) * temdta(:,:,:,1) + zxy * temdta(:,:,:,2)
324     
325      ! Close the file
326      ! --------------
327     
328      IF( kt == nitend )   CALL iom_close (numtdt)
329     
330    END SUBROUTINE dta_tem
331
332#else
333   !!----------------------------------------------------------------------
334   !!   Default case                           NO 3D temperature data field
335   !!----------------------------------------------------------------------
336   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .FALSE.   !: temperature data flag
337CONTAINS
338   SUBROUTINE dta_tem( kt )        ! Empty routine
339      WRITE(*,*) 'dta_tem: You should not have seen this print! error?', kt
340   END SUBROUTINE dta_tem
341#endif
342   !!======================================================================
343END MODULE dtatem
Note: See TracBrowser for help on using the repository browser.