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

Last change on this file since 3 was 3, checked in by opalod, 20 years ago

Initial revision
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 11.1 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=38) ::   &
31      cl_tdata = 'data_1m_potiential_temperature_nomask '
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 , LODYC-IPSL  (2003)
43   !!----------------------------------------------------------------------
44
45CONTAINS
46
47# if defined key_fdir
48   !!----------------------------------------------------------------------
49   !!   'key_fdir'                                       direct access file
50   !!----------------------------------------------------------------------
51#  include "dtatem_fdir.h90"
52
53# else
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 ioipsl
83
84      !! * Arguments
85      INTEGER, INTENT( in ) ::   kt     ! ocean time-step
86
87      !! * Local declarations
88      INTEGER, PARAMETER ::   &
89         jpmois = 12                    ! number of month
90      INTEGER ::   ji, jj, jl           ! dummy loop indicies
91      INTEGER ::   &
92         imois, iman, itime, ik ,    &  ! temporary integers
93         i15, ipi, ipj, ipk             !    "          "
94
95      INTEGER, DIMENSION(jpmois) ::   istep
96      REAL(wp) ::   zxy, zl, zdate0
97      REAL(wp), DIMENSION(jpi,jpj) ::   zlon,zlat
98      REAL(wp), DIMENSION(jpk) ::   zlev
99      !!----------------------------------------------------------------------
100
101
102      ! 0. Initialization
103      ! -----------------
104
105      iman  = jpmois
106      i15   = nday / 16
107      imois = nmonth + i15 - 1
108      IF( imois == 0 )   imois = iman
109
110      itime = jpmois
111      ipi=jpiglo
112      ipj=jpjglo
113
114      ! 1. First call kt=nit000
115      ! -----------------------
116
117      IF( kt == nit000 .AND. nlecte == 0 ) THEN
118         ntem1 = 0
119         IF(lwp) WRITE(numout,*)
120         IF(lwp) WRITE(numout,*) ' dtatem : Levitus monthly fields'
121         IF(lwp) WRITE(numout,*) ' ~~~~~~'
122         IF(lwp) WRITE(numout,*) '             NetCDF FORMAT'
123         IF(lwp) WRITE(numout,*)
124         
125         ! open file
126
127         CALL flinopen( TRIM(cl_tdata), mig(1), nlci , mjg(1),  nlcj   &
128                      , .false.     , ipi   , ipj  , ipk   , zlon   &
129                      , zlat        , zlev  , itime, istep , zdate0   &
130                      , rdt         , numtdt                        )
131
132         ! title, dimensions and tests
133
134         IF( itime /= jpmois ) THEN
135            IF(lwp) THEN
136               WRITE(numout,*)
137               WRITE(numout,*) 'problem with time coordinates'
138               WRITE(numout,*) ' itime ',itime,' jpmois ',jpmois
139            ENDIF
140            STOP 'dtatem'
141         ENDIF
142         IF( ipi /= jpidta .AND. ipj /= jpjdta .AND. ipk /= jpk ) THEN
143            IF(lwp) THEN
144               WRITE(numout,*)
145               WRITE(numout,*) 'problem with dimensions'
146               WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta
147               WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta
148               WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk
149            ENDIF
150            STOP 'dtatem'
151         ENDIF
152         IF(lwp) WRITE(numout,*) itime,istep,zdate0,rdt,numtdt
153
154      ENDIF
155
156
157      ! 2. Read monthly file
158      ! -------------------
159
160      IF( ( kt == nit000 .AND. nlecte == 0 ) .OR. imois /= ntem1 ) THEN
161         nlecte = 1
162
163         ! Calendar computation
164         
165         ntem1 = imois        ! first file record used
166         ntem2 = ntem1 + 1    ! last  file record used
167         ntem1 = MOD( ntem1, iman )
168         IF( ntem1 == 0 )   ntem1 = iman
169         ntem2 = MOD( ntem2, iman )
170         IF( ntem2 == 0 )   ntem2 = iman
171         IF(lwp) WRITE(numout,*) 'first record file used ntem1 ', ntem1
172         IF(lwp) WRITE(numout,*) 'last  record file used ntem2 ', ntem2
173         
174         ! Read monthly temperature data Levitus
175         
176         CALL flinget( numtdt, 'votemper', jpidta, jpjdta, jpk   &
177                     , jpmois, ntem1     , ntem1 , mig(1), nlci   &
178                     , mjg(1), nlcj      , temdta(1:nlci,1:nlcj,1:jpk,1)     )
179         CALL flinget( numtdt, 'votemper', jpidta, jpjdta, jpk   &
180                     , jpmois, ntem2     , ntem2 , mig(1), nlci   &
181                     , mjg(1), nlcj      , temdta(1:nlci,1:nlcj,1:jpk,2)     )
182
183         IF(lwp) WRITE(numout,*)
184         IF(lwp) WRITE(numout,*) ' read Levitus temperature ok'
185         IF(lwp) WRITE(numout,*)
186         
187#  if defined key_tradmp
188         IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN
189     
190            !                                        ! =======================
191            !                                        !  ORCA_R2 configuration
192            !                                        ! =======================
193
194            DO jj = mj0(101), mj1(109)                   ! Reduced temperature at Alboran Sea
195               DO ji = mi0(141), mi1(155)
196                  temdta(ji,jj, 13:13 ,:) = temdta(ji,jj, 13:13 ,:) - 0.20
197                  temdta(ji,jj, 14:15 ,:) = temdta(ji,jj, 14:15 ,:) - 0.35
198                  temdta(ji,jj, 16:25 ,:) = temdta(ji,jj, 16:25 ,:) - 0.40
199               END DO
200            END DO
201         
202            IF( n_cla == 0 ) THEN 
203               !                                         ! Reduced temperature at Red Sea
204               temdta( mi0(148):mi1(160) , mj0(87):mj1(96) ,  4:10 , : ) = 7.0 
205               temdta( mi0(148):mi1(160) , mj0(87):mj1(96) , 11:13 , : ) = 6.5 
206               temdta( mi0(148):mi1(160) , mj0(87):mj1(96) , 14:20 , : ) = 6.0
207            ELSE
208               DO jl = mi0(138), mi1(138)                ! New temperature profile at Gibraltar
209                  DO jj = mj0(101), mj1(102)
210                     DO ji = mi0(139), mi1(139)
211                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
212                     END DO
213                  END DO
214               END DO
215               DO jl = mi0(164), mi1(164)                ! New temperature profile at Bab el Mandeb
216                  DO jj = mj0(88), mj1(88)
217                     DO ji = mi0(161), mi1(163)
218                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
219                     END DO
220                  END DO
221                  DO jj = mj0(87), mj1(87)
222                     DO ji = mi0(161), mi1(163)
223                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
224                     END DO
225                  END DO
226               END DO
227            ENDIF
228
229         ENDIF
230#  endif
231
232         !                                  ! Mask
233         DO jl = 1, 2
234            temdta(:,:,:,jl) = temdta(:,:,:,jl) * tmask(:,:,:)
235            temdta(:,:,jpk,jl) = 0.
236            IF( lk_zps ) THEN                ! z-coord. with partial steps
237               DO jj = 1, jpj                  ! interpolation of temperature at the last level
238                  DO ji = 1, jpi
239                     ik = mbathy(ji,jj) - 1
240                     IF( ik > 2 ) THEN
241                        zl = ( gdept(ik) - fsdept(ji,jj,ik) ) / ( gdept(ik) - gdept(ik-1) )
242                        temdta(ji,jj,ik,jl) = (1.-zl) * temdta(ji,jj,ik,jl) + zl * temdta(ji,jj,ik-1,jl) 
243                     ENDIF
244                  END DO
245               END DO
246            ENDIF
247         END DO
248
249         IF(lwp) THEN
250            WRITE(numout,*) ' temperature Levitus month ', ntem1, ntem2
251            WRITE(numout,*)
252            WRITE(numout,*) ' Levitus month = ', ntem1, '  level = 1'
253            CALL prihre( temdta(1,1,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
254            WRITE(numout,*) ' Levitus month = ', ntem1, '  level = ', jpk/2
255            CALL prihre( temdta(1,1,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
256            WRITE(numout,*) ' Levitus month = ',ntem1,'  level = ', jpkm1
257            CALL prihre( temdta(1,1,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
258         ENDIF
259      ENDIF
260
261 
262      ! 2. At every time step compute temperature data
263      ! ----------------------------------------------
264
265      zxy = FLOAT( nday + 15 - 30 * i15 ) / 30.
266      t_dta(:,:,:) = (1.-zxy) * temdta(:,:,:,1) + zxy * temdta(:,:,:,2)
267
268   END SUBROUTINE dta_tem
269
270# endif
271
272#else
273   !!----------------------------------------------------------------------
274   !!   Default case                           NO 3D temperature data field
275   !!----------------------------------------------------------------------
276   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .FALSE.   ! temperature data flag
277CONTAINS
278   SUBROUTINE dta_tem( kt )        ! Empty routine
279      WRITE(*,*) kt
280   END SUBROUTINE dta_tem
281#endif
282   !!======================================================================
283END MODULE dtatem
Note: See TracBrowser for help on using the repository browser.