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

Last change on this file since 467 was 459, checked in by opalod, 18 years ago

nemo_v1_update_050:RB: update dtasal and dtatem according to the new coordinate definition
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 11.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   !!----------------------------------------------------------------------
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=45) ::   &
31      cl_tdata
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 , LOCEAN-IPSL (2005)
43   !! $Header$
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 ioipsl
78
79      !! * Arguments
80      INTEGER, INTENT( in ) ::   kt     ! ocean time-step
81
82      !! * Local declarations
83      INTEGER, PARAMETER ::   &
84         jpmois = 12                    ! number of month
85      INTEGER ::   ji, jj, jk, jl, jkk  ! dummy loop indicies
86      REAL(wp), DIMENSION(jpk,2) ::   &
87         ztemdta            ! auxiliary array for interpolation
88
89      INTEGER ::   &
90         imois, iman, itime, ik ,    &  ! temporary integers
91         i15, ipi, ipj, ipk             !    "          "
92#  if defined key_tradmp
93      INTEGER ::   &
94         il0, il1, ii0, ii1, ij0, ij1   ! temporary integers
95# endif
96
97      INTEGER, DIMENSION(jpmois) ::   istep
98      REAL(wp) ::   zxy, zl, zdate0
99      REAL(wp), DIMENSION(jpi,jpj) ::   zlon,zlat
100      REAL(wp), DIMENSION(jpk) ::   zlev
101      !!----------------------------------------------------------------------
102
103     ! 0. Initialization
104     ! -----------------
105
106     iman  = jpmois
107     i15   = nday / 16
108     imois = nmonth + i15 - 1
109     IF( imois == 0 )   imois = iman
110
111     itime = jpmois
112     ipi = jpiglo
113     ipj = jpjglo
114     ipk = jpk
115
116     ! 1. First call kt=nit000
117     ! -----------------------
118
119     IF( kt == nit000 .AND. nlecte == 0 ) THEN
120   ntem1 = 0
121   IF(lwp) WRITE(numout,*)
122   IF(lwp) WRITE(numout,*) ' dtatem : Levitus monthly fields'
123   IF(lwp) WRITE(numout,*) ' ~~~~~~'
124   IF(lwp) WRITE(numout,*) '             NetCDF FORMAT'
125   IF(lwp) WRITE(numout,*)
126
127   ! open file
128
129   cl_tdata = 'data_1m_potential_temperature_nomask '
130#if defined key_agrif
131   if ( .NOT. Agrif_Root() ) then
132      cl_tdata = TRIM(Agrif_CFixed())//'_'//TRIM(cl_tdata)
133   endif
134#endif           
135   CALL flinopen( TRIM(cl_tdata), mig(1), nlci , mjg(1),  nlcj   &
136      &          , .false.     , ipi   , ipj  , ipk   , zlon     &
137      &          , zlat        , zlev  , itime, istep , zdate0   &
138      &          , rdt         , numtdt                        )
139
140   ! title, dimensions and tests
141
142   IF( itime /= jpmois ) THEN
143      IF(lwp) THEN
144         WRITE(numout,*)
145         WRITE(numout,*) 'problem with time coordinates'
146         WRITE(numout,*) ' itime ',itime,' jpmois ',jpmois
147      ENDIF
148      STOP 'dtatem'
149   ENDIF
150   IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN
151      IF(lwp) THEN
152         WRITE(numout,*)
153         WRITE(numout,*) 'problem with dimensions'
154         WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta
155         WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta
156         WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk
157      ENDIF
158      STOP 'dtatem'
159   ENDIF
160   IF(lwp) WRITE(numout,*) itime,istep,zdate0,rdt,numtdt
161
162     ENDIF
163
164
165     ! 2. Read monthly file
166     ! -------------------
167
168     IF( ( kt == nit000 .AND. nlecte == 0 ) .OR. imois /= ntem1 ) THEN
169   nlecte = 1
170
171   ! Calendar computation
172
173   ntem1 = imois        ! first file record used
174   ntem2 = ntem1 + 1    ! last  file record used
175   ntem1 = MOD( ntem1, iman )
176   IF( ntem1 == 0 )   ntem1 = iman
177   ntem2 = MOD( ntem2, iman )
178   IF( ntem2 == 0 )   ntem2 = iman
179   IF(lwp) WRITE(numout,*) 'first record file used ntem1 ', ntem1
180   IF(lwp) WRITE(numout,*) 'last  record file used ntem2 ', ntem2
181
182   ! Read monthly temperature data Levitus
183
184   CALL flinget( numtdt, 'votemper', jpidta, jpjdta, jpk   &
185          , jpmois, ntem1     , ntem1 , mig(1), nlci   &
186          , mjg(1), nlcj      , temdta(1:nlci,1:nlcj,1:jpk,1)     )
187   CALL flinget( numtdt, 'votemper', jpidta, jpjdta, jpk   &
188          , jpmois, ntem2     , ntem2 , mig(1), nlci   &
189          , mjg(1), nlcj      , temdta(1:nlci,1:nlcj,1:jpk,2)     )
190
191   IF(lwp) WRITE(numout,*)
192   IF(lwp) WRITE(numout,*) ' read Levitus temperature ok'
193   IF(lwp) WRITE(numout,*)
194
195#if defined key_tradmp
196   IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN
197
198      !                                        ! =======================
199      !                                        !  ORCA_R2 configuration
200      !                                        ! =======================
201
202      ij0 = 101   ;   ij1 = 109
203      ii0 = 141   ;   ii1 = 155
204      DO jj = mj0(ij0), mj1(ij1)                      ! Reduced temperature in the Alboran Sea
205         DO ji = mi0(ii0), mi1(ii1)
206       temdta(ji,jj, 13:13 ,:) = temdta(ji,jj, 13:13 ,:) - 0.20
207       temdta(ji,jj, 14:15 ,:) = temdta(ji,jj, 14:15 ,:) - 0.35
208       temdta(ji,jj, 16:25 ,:) = temdta(ji,jj, 16:25 ,:) - 0.40
209         END DO
210      END DO
211
212      IF( n_cla == 0 ) THEN 
213         !                                         ! Reduced temperature at Red Sea
214         ij0 =  87   ;   ij1 =  96
215         ii0 = 148   ;   ii1 = 160
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      ELSE
220         il0 = 138   ;   il1 = 138
221         ij0 = 101   ;   ij1 = 102
222         ii0 = 139   ;   ii1 = 139
223         DO jl = mi0(il0), mi1(il1)                ! New temperature profile at Gibraltar
224       DO jj = mj0(ij0), mj1(ij1)
225          DO ji = mi0(ii0), mi1(ii1)
226             temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
227          END DO
228       END DO
229         END DO
230         il0 = 164   ;   il1 = 164
231         ij0 =  88   ;   ij1 =  88
232         ii0 = 161   ;   ii1 = 163
233         DO jl = mi0(il0), mi1(il1)                ! New temperature profile at Bab el Mandeb
234       DO jj = mj0(ij0), mj1(ij1)
235          DO ji = mi0(ii0), mi1(ii1)
236             temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
237          END DO
238       END DO
239       ij0 =  87   ;   ij1 =  87
240       DO jj = mj0(ij0), mj1(ij1)
241          DO ji = mi0(ii0), mi1(ii1)
242             temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
243          END DO
244       END DO
245         END DO
246      ENDIF
247
248   ENDIF
249#endif
250
251     IF( ln_sco ) THEN
252     DO jl = 1, 2
253   DO jj = 1, jpj                  ! interpolation of temperatures
254      DO ji = 1, jpi
255         DO jk = 1, jpk
256        zl=fsdept(ji,jj,jk)
257        IF(zl < gdept_0(1)) ztemdta(jk,jl) =  temdta(ji,jj,1,jl)
258        IF(zl > gdept_0(jpk)) ztemdta(jk,jl) =  temdta(ji,jj,jpkm1,jl)
259        DO jkk = 1, jpkm1
260            IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN
261           ztemdta(jk,jl) = temdta(ji,jj,jkk,jl)                                 &
262              &           + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk))      &
263              &                              *(temdta(ji,jj,jkk+1,jl) - temdta(ji,jj,jkk,jl))
264            ENDIF
265        END DO
266         END DO
267         DO jk = 1, jpkm1
268             temdta(ji,jj,jk,jl) = ztemdta(jk,jl)
269         END DO
270             temdta(ji,jj,jpk,jl) = 0.0
271      END DO
272   END DO
273     END DO
274
275     IF(lwp) WRITE(numout,*)
276     IF(lwp) WRITE(numout,*) ' Levitus temperature data interpolated to s-coordinate'
277     IF(lwp) WRITE(numout,*)
278
279     ELSE
280
281     !                                  ! Mask
282     DO jl = 1, 2
283   temdta(:,:,:,jl) = temdta(:,:,:,jl) * tmask(:,:,:)
284   temdta(:,:,jpk,jl) = 0.
285   IF( ln_zps ) THEN                ! z-coord. with partial steps
286      DO jj = 1, jpj                  ! interpolation of temperature at the last level
287         DO ji = 1, jpi
288       ik = mbathy(ji,jj) - 1
289       IF( ik > 2 ) THEN
290          zl = ( gdept_0(ik) - fsdept(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) )
291          temdta(ji,jj,ik,jl) = (1.-zl) * temdta(ji,jj,ik,jl) + zl * temdta(ji,jj,ik-1,jl)
292       ENDIF
293         END DO
294      END DO
295   ENDIF
296     END DO
297
298     ENDIF
299
300   IF(lwp) THEN
301      WRITE(numout,*) ' temperature Levitus month ', ntem1, ntem2
302      WRITE(numout,*)
303      WRITE(numout,*) ' Levitus month = ', ntem1, '  level = 1'
304      CALL prihre( temdta(:,:,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
305      WRITE(numout,*) ' Levitus month = ', ntem1, '  level = ', jpk/2
306      CALL prihre( temdta(:,:,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
307      WRITE(numout,*) ' Levitus month = ',ntem1,'  level = ', jpkm1
308      CALL prihre( temdta(:,:,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
309   ENDIF
310     ENDIF
311
312
313     ! 2. At every time step compute temperature data
314     ! ----------------------------------------------
315
316     zxy = FLOAT( nday + 15 - 30 * i15 ) / 30.
317     t_dta(:,:,:) = (1.-zxy) * temdta(:,:,:,1) + zxy * temdta(:,:,:,2)
318
319   END SUBROUTINE dta_tem
320
321#else
322   !!----------------------------------------------------------------------
323   !!   Default case                           NO 3D temperature data field
324   !!----------------------------------------------------------------------
325   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .FALSE.   !: temperature data flag
326CONTAINS
327   SUBROUTINE dta_tem( kt )        ! Empty routine
328      WRITE(*,*) 'dta_tem: You should not have seen this print! error?', kt
329   END SUBROUTINE dta_tem
330#endif
331   !!======================================================================
332END MODULE dtatem
Note: See TracBrowser for help on using the repository browser.