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 branches/TAM_V3_0/NEMO/OPA_SRC/DTA – NEMO

source: branches/TAM_V3_0/NEMO/OPA_SRC/DTA/dtatem.F90 @ 1884

Last change on this file since 1884 was 1884, checked in by rblod, 14 years ago

Light adaptation of NEMO direct model routine to handle TAM

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 14.3 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#if defined key_pomme_r025
36      ntem1, ntem2 , &  ! first and second record used
37      nlecte = 0        ! switch for frist read
38#else
39      ntem1, ntem2  ! first and second record used
40#endif
41   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   &
42      temdta            ! temperature data at two consecutive times
43
44   !! * Substitutions
45#  include "domzgr_substitute.h90"
46   !!----------------------------------------------------------------------
47   !!   OPA 9.0 , LOCEAN-IPSL (2005)
48   !! $Id$
49   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
50   !!----------------------------------------------------------------------
51
52CONTAINS
53
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 iom
83
84      !! * Arguments
85      INTEGER, INTENT( in ) ::   kt     ! ocean time-step
86
87      !! * Local declarations
88      INTEGER ::   ji, jj, jl, jk, jkk       ! dummy loop indicies
89      INTEGER ::   &
90         imois, iman, i15 , ik      ! temporary integers
91#  if defined key_tradmp
92      INTEGER ::   &
93         il0, il1, ii0, ii1, ij0, ij1   ! temporary integers
94# endif
95      REAL(wp) ::   zxy, zl
96#if defined key_orca_lev10
97      REAL(wp), DIMENSION(jpi,jpj,jpkdta,2) :: ztem
98      INTEGER   :: ikr, ikw, ikt, jjk 
99      REAL(wp)  :: zfac
100#endif
101      CHARACTER (len=38) ::   &
102         cl_tdata = 'data_1m_potential_temperature_nomask '
103      REAL(wp), DIMENSION(jpk,2) ::   &
104         ztemdta            ! auxiliary array for interpolation
105      !!----------------------------------------------------------------------
106     
107      ! 0. Initialization
108      ! -----------------
109     
110#if defined key_pomme_r025
111! DRAKKAR : we use input file with 1 month only
112      iman = 1
113#else
114      iman  = INT( raamo )
115#endif
116!!! better but change the results     i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) )
117      i15   = nday / 16
118      imois = nmonth + i15 - 1
119      IF( imois == 0 ) imois = iman
120     
121      ! 1. First call kt=nit000
122      ! -----------------------
123     
124      IF( kt == nit000 ) THEN
125         
126         ntem1= 0   ! initializations
127         IF(lwp) WRITE(numout,*) ' dta_tem : Levitus monthly fields'
128         CALL iom_open ( cl_tdata, numtdt ) 
129         
130      ENDIF
131     
132     
133      ! 2. Read monthly file
134      ! -------------------
135     
136#if defined key_pomme_r025
137! DRAKKAR read only first step
138!     IF( kt == nit000 .OR. imois /= ntem1 ) THEN
139      IF( kt == nit000 .AND. nlecte == 0 ) THEN
140         nlecte = 1
141#else
142      IF( kt == nit000 .OR. imois /= ntem1 ) THEN
143#endif
144         
145         ! Calendar computation
146         
147         ntem1 = imois        ! first file record used
148         ntem2 = ntem1 + 1    ! last  file record used
149         ntem1 = MOD( ntem1, iman )
150         IF( ntem1 == 0 )   ntem1 = iman
151         ntem2 = MOD( ntem2, iman )
152         IF( ntem2 == 0 )   ntem2 = iman
153         IF(lwp) WRITE(numout,*) 'first record file used ntem1 ', ntem1
154         IF(lwp) WRITE(numout,*) 'last  record file used ntem2 ', ntem2
155         
156         ! Read monthly temperature data Levitus
157         
158#if defined key_orca_lev10
159         if (ln_zps) stop
160         ztem(:,:,:,:) = 0.
161         CALL iom_get (numtdt,jpdom_data,'votemper',ztem(:,:,:,1),ntem1)
162         CALL iom_get (numtdt,jpdom_data,'votemper',ztem(:,:,:,2),ntem2)
163#else         
164         CALL iom_get (numtdt,jpdom_data,'votemper',temdta(:,:,:,1),ntem1)
165         CALL iom_get (numtdt,jpdom_data,'votemper',temdta(:,:,:,2),ntem2)
166#endif
167         
168         IF(lwp) WRITE(numout,*)
169         IF(lwp) WRITE(numout,*) ' read Levitus temperature ok'
170         IF(lwp) WRITE(numout,*)
171         
172#if defined key_tradmp
173         IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN
174           
175            !                                        ! =======================
176            !                                        !  ORCA_R2 configuration
177            !                                        ! =======================
178           
179            ij0 = 101   ;   ij1 = 109
180            ii0 = 141   ;   ii1 = 155
181            DO jj = mj0(ij0), mj1(ij1)                      ! Reduced temperature in the Alboran Sea
182               DO ji = mi0(ii0), mi1(ii1)
183#if defined key_orca_lev10
184                  ztem(  ji,jj, 13:13 ,:) = ztem  (ji,jj, 13:13 ,:) - 0.20
185                  ztem  (ji,jj, 14:15 ,:) = ztem  (ji,jj, 14:15 ,:) - 0.35
186                  ztem  (ji,jj, 16:25 ,:) = ztem  (ji,jj, 16:25 ,:) - 0.40
187#else
188                  temdta(ji,jj, 13:13 ,:) = temdta(ji,jj, 13:13 ,:) - 0.20
189                  temdta(ji,jj, 14:15 ,:) = temdta(ji,jj, 14:15 ,:) - 0.35
190                  temdta(ji,jj, 16:25 ,:) = temdta(ji,jj, 16:25 ,:) - 0.40
191#endif
192               END DO
193            END DO
194           
195            IF( n_cla == 0 ) THEN 
196               !                                         ! Reduced temperature at Red Sea
197               ij0 =  87   ;   ij1 =  96
198               ii0 = 148   ;   ii1 = 160
199#if defined key_orca_lev10
200               ztem  ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 , : ) = 7.0 
201               ztem  ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5 
202               ztem  ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0
203#else
204               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 , : ) = 7.0 
205               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5 
206               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0
207#endif
208            ELSE
209               il0 = 138   ;   il1 = 138
210               ij0 = 101   ;   ij1 = 102
211               ii0 = 139   ;   ii1 = 139
212               DO jl = mi0(il0), mi1(il1)                ! New temperature profile at Gibraltar
213                  DO jj = mj0(ij0), mj1(ij1)
214                     DO ji = mi0(ii0), mi1(ii1)
215#if defined key_orca_lev10
216                        ztem  (ji,jj,:,:) = ztem  (jl,jj,:,:)
217#else
218                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
219#endif
220                     END DO
221                  END DO
222               END DO
223               il0 = 164   ;   il1 = 164
224               ij0 =  88   ;   ij1 =  88
225               ii0 = 161   ;   ii1 = 163
226               DO jl = mi0(il0), mi1(il1)                ! New temperature profile at Bab el Mandeb
227                  DO jj = mj0(ij0), mj1(ij1)
228                     DO ji = mi0(ii0), mi1(ii1)
229#if defined key_orca_lev10
230                        ztem  (ji,jj,:,:) = ztem  (jl,jj,:,:)
231#else
232                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
233#endif
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#if defined key_orca_lev10
240                        ztem  (ji,jj,:,:) = ztem  (jl,jj,:,:)
241#else
242                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
243#endif
244                     END DO
245                  END DO
246               END DO
247            ENDIF
248           
249         ENDIF
250#endif
251         
252#if defined key_orca_lev10
253         ! interpolate from 31 to 301 level the ztem field result in temdta
254         DO jl = 1, 2
255            DO jjk = 1, 5
256               temdta(:,:,jjk,jl) = ztem(:,:,1,jl)
257            END DO
258            DO jk = 1, jpk-20,10
259               ik = jk+5
260               ikr =  INT(jk/10) + 1
261               ikw =  (ikr-1) *10 + 1
262               ikt =  ikw + 5
263               DO jjk=ikt,ikt+9
264                  zfac = ( gdept_0(jjk   ) - gdepw_0(ikt) ) / ( gdepw_0(ikt+10) - gdepw_0(ikt) )
265                  temdta(:,:,jjk,jl) = ztem(:,:,ikr,jl) + ( ztem(:,:,ikr+1,jl) - ztem(:,:,ikr,jl) ) * zfac
266               END DO
267            END DO
268            DO jjk = jpk-5, jpk
269               temdta(:,:,jjk,jl) = ztem(:,:,jpkdta-1,jl)
270            END DO
271            ! fill the overlap areas
272            CALL lbc_lnk (temdta(:,:,:,jl),'Z',-999.,'no0')
273         END DO
274#endif
275         
276         IF( ln_sco ) THEN
277            DO jl = 1, 2
278               DO jj = 1, jpj                  ! interpolation of temperatures
279                  DO ji = 1, jpi
280                     DO jk = 1, jpk
281                        zl=fsdept(ji,jj,jk)
282                        IF(zl < gdept_0(1)) ztemdta(jk,jl) =  temdta(ji,jj,1,jl)
283                        IF(zl > gdept_0(jpk)) ztemdta(jk,jl) =  temdta(ji,jj,jpkm1,jl)
284                        DO jkk = 1, jpkm1
285                           IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN
286                              ztemdta(jk,jl) = temdta(ji,jj,jkk,jl)                                 &
287                                   &           + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk))      &
288                                   &                              *(temdta(ji,jj,jkk+1,jl) - temdta(ji,jj,jkk,jl))
289                           ENDIF
290                        END DO
291                     END DO
292                     DO jk = 1, jpkm1
293                        temdta(ji,jj,jk,jl) = ztemdta(jk,jl)
294                     END DO
295                     temdta(ji,jj,jpk,jl) = 0.0
296                  END DO
297               END DO
298            END DO
299           
300            IF(lwp) WRITE(numout,*)
301            IF(lwp) WRITE(numout,*) ' Levitus temperature data interpolated to s-coordinate'
302            IF(lwp) WRITE(numout,*)
303           
304         ELSE
305           
306            !                                  ! Mask
307            DO jl = 1, 2
308               temdta(:,:,:,jl) = temdta(:,:,:,jl) * tmask(:,:,:)
309               temdta(:,:,jpk,jl) = 0.
310               IF( ln_zps ) THEN                ! z-coord. with partial steps
311                  DO jj = 1, jpj                  ! interpolation of temperature at the last level
312                     DO ji = 1, jpi
313                        ik = mbathy(ji,jj) - 1
314                        IF( ik > 2 ) THEN
315                           zl = ( gdept_0(ik) - fsdept(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) )
316                           temdta(ji,jj,ik,jl) = (1.-zl) * temdta(ji,jj,ik,jl) + zl * temdta(ji,jj,ik-1,jl)
317                        ENDIF
318                     END DO
319                  END DO
320               ENDIF
321            END DO
322           
323         ENDIF
324         
325         IF(lwp) THEN
326            WRITE(numout,*) ' temperature Levitus month ', ntem1, ntem2
327            WRITE(numout,*)
328            WRITE(numout,*) ' Levitus month = ', ntem1, '  level = 1'
329            CALL prihre( temdta(:,:,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
330            WRITE(numout,*) ' Levitus month = ', ntem1, '  level = ', jpk/2
331            CALL prihre( temdta(:,:,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
332            WRITE(numout,*) ' Levitus month = ',ntem1,'  level = ', jpkm1
333            CALL prihre( temdta(:,:,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
334         ENDIF
335#if ! defined key_pomme_r025
336      ENDIF
337#endif
338     
339     
340      ! 2. At every time step compute temperature data
341      ! ----------------------------------------------
342     
343      zxy = FLOAT( nday + 15 - 30 * i15 ) / 30.
344      t_dta(:,:,:) = (1.-zxy) * temdta(:,:,:,1) + zxy * temdta(:,:,:,2)
345
346#if defined key_pomme_r025
347      ENDIF
348#endif
349
350      ! Close the file
351      ! --------------
352     
353      IF( kt == nitend )   CALL iom_close (numtdt)
354     
355    END SUBROUTINE dta_tem
356
357#else
358   !!----------------------------------------------------------------------
359   !!   Default case                           NO 3D temperature data field
360   !!----------------------------------------------------------------------
361   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .FALSE.   !: temperature data flag
362CONTAINS
363   SUBROUTINE dta_tem( kt )        ! Empty routine
364      WRITE(*,*) 'dta_tem: You should not have seen this print! error?', kt
365   END SUBROUTINE dta_tem
366#endif
367   !!======================================================================
368END MODULE dtatem
Note: See TracBrowser for help on using the repository browser.