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

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

CT : UPDATE073 : Correction of typo and control tests just after the flinopen CALL
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 11.6 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_potential_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         il0, il1, ii0, ii1, ij0, ij1   !    "          "
95
96      INTEGER, DIMENSION(jpmois) ::   istep
97      REAL(wp) ::   zxy, zl, zdate0
98      REAL(wp), DIMENSION(jpi,jpj) ::   zlon,zlat
99      REAL(wp), DIMENSION(jpk) ::   zlev
100      !!----------------------------------------------------------------------
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
115      ! 1. First call kt=nit000
116      ! -----------------------
117
118      IF( kt == nit000 .AND. nlecte == 0 ) THEN
119         ntem1 = 0
120         IF(lwp) WRITE(numout,*)
121         IF(lwp) WRITE(numout,*) ' dtatem : Levitus monthly fields'
122         IF(lwp) WRITE(numout,*) ' ~~~~~~'
123         IF(lwp) WRITE(numout,*) '             NetCDF FORMAT'
124         IF(lwp) WRITE(numout,*)
125         
126         ! open file
127
128         CALL flinopen( TRIM(cl_tdata), mig(1), nlci , mjg(1),  nlcj   &
129                      , .false.     , ipi   , ipj  , ipk   , zlon   &
130                      , zlat        , zlev  , itime, istep , zdate0   &
131                      , rdt         , numtdt                        )
132
133         ! title, dimensions and tests
134
135         IF( itime /= jpmois ) THEN
136            IF(lwp) THEN
137               WRITE(numout,*)
138               WRITE(numout,*) 'problem with time coordinates'
139               WRITE(numout,*) ' itime ',itime,' jpmois ',jpmois
140            ENDIF
141            STOP 'dtatem'
142         ENDIF
143         IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN
144            IF(lwp) THEN
145               WRITE(numout,*)
146               WRITE(numout,*) 'problem with dimensions'
147               WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta
148               WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta
149               WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk
150            ENDIF
151            STOP 'dtatem'
152         ENDIF
153         IF(lwp) WRITE(numout,*) itime,istep,zdate0,rdt,numtdt
154
155      ENDIF
156
157
158      ! 2. Read monthly file
159      ! -------------------
160
161      IF( ( kt == nit000 .AND. nlecte == 0 ) .OR. imois /= ntem1 ) THEN
162         nlecte = 1
163
164         ! Calendar computation
165         
166         ntem1 = imois        ! first file record used
167         ntem2 = ntem1 + 1    ! last  file record used
168         ntem1 = MOD( ntem1, iman )
169         IF( ntem1 == 0 )   ntem1 = iman
170         ntem2 = MOD( ntem2, iman )
171         IF( ntem2 == 0 )   ntem2 = iman
172         IF(lwp) WRITE(numout,*) 'first record file used ntem1 ', ntem1
173         IF(lwp) WRITE(numout,*) 'last  record file used ntem2 ', ntem2
174         
175         ! Read monthly temperature data Levitus
176         
177         CALL flinget( numtdt, 'votemper', jpidta, jpjdta, jpk   &
178                     , jpmois, ntem1     , ntem1 , mig(1), nlci   &
179                     , mjg(1), nlcj      , temdta(1:nlci,1:nlcj,1:jpk,1)     )
180         CALL flinget( numtdt, 'votemper', jpidta, jpjdta, jpk   &
181                     , jpmois, ntem2     , ntem2 , mig(1), nlci   &
182                     , mjg(1), nlcj      , temdta(1:nlci,1:nlcj,1:jpk,2)     )
183
184         IF(lwp) WRITE(numout,*)
185         IF(lwp) WRITE(numout,*) ' read Levitus temperature ok'
186         IF(lwp) WRITE(numout,*)
187         
188#  if defined key_tradmp
189         IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN
190     
191            !                                        ! =======================
192            !                                        !  ORCA_R2 configuration
193            !                                        ! =======================
194
195            ij0 = 101   ;   ij1 = 109
196            ii0 = 141   ;   ii1 = 155
197            DO jj = mj0(ij0), mj1(ij1)                      ! Reduced temperature in the Alboran Sea
198               DO ji = mi0(ii0), mi1(ii1)
199                  temdta(ji,jj, 13:13 ,:) = temdta(ji,jj, 13:13 ,:) - 0.20
200                  temdta(ji,jj, 14:15 ,:) = temdta(ji,jj, 14:15 ,:) - 0.35
201                  temdta(ji,jj, 16:25 ,:) = temdta(ji,jj, 16:25 ,:) - 0.40
202               END DO
203            END DO
204         
205            IF( n_cla == 0 ) THEN 
206               !                                         ! Reduced temperature at Red Sea
207               ij0 =  87   ;   ij1 =  96
208               ii0 = 148   ;   ii1 = 160
209               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 , : ) = 7.0 
210               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5 
211               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0
212            ELSE
213               il0 = 138   ;   il1 = 138
214               ij0 = 101   ;   ij1 = 102
215               ii0 = 139   ;   ii1 = 139
216               DO jl = mi0(il0), mi1(il1)                ! New temperature profile at Gibraltar
217                  DO jj = mj0(ij0), mj1(ij1)
218                     DO ji = mi0(ii0), mi1(ii1)
219                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
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                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
230                     END DO
231                  END DO
232                  ij0 =  87   ;   ij1 =  87
233                  DO jj = mj0(ij0), mj1(ij1)
234                     DO ji = mi0(ii0), mi1(ii1)
235                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
236                     END DO
237                  END DO
238               END DO
239            ENDIF
240
241         ENDIF
242#  endif
243
244         !                                  ! Mask
245         DO jl = 1, 2
246            temdta(:,:,:,jl) = temdta(:,:,:,jl) * tmask(:,:,:)
247            temdta(:,:,jpk,jl) = 0.
248            IF( lk_zps ) THEN                ! z-coord. with partial steps
249               DO jj = 1, jpj                  ! interpolation of temperature at the last level
250                  DO ji = 1, jpi
251                     ik = mbathy(ji,jj) - 1
252                     IF( ik > 2 ) THEN
253                        zl = ( gdept(ik) - fsdept(ji,jj,ik) ) / ( gdept(ik) - gdept(ik-1) )
254                        temdta(ji,jj,ik,jl) = (1.-zl) * temdta(ji,jj,ik,jl) + zl * temdta(ji,jj,ik-1,jl) 
255                     ENDIF
256                  END DO
257               END DO
258            ENDIF
259         END DO
260
261         IF(lwp) THEN
262            WRITE(numout,*) ' temperature Levitus month ', ntem1, ntem2
263            WRITE(numout,*)
264            WRITE(numout,*) ' Levitus month = ', ntem1, '  level = 1'
265            CALL prihre( temdta(1,1,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
266            WRITE(numout,*) ' Levitus month = ', ntem1, '  level = ', jpk/2
267            CALL prihre( temdta(1,1,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
268            WRITE(numout,*) ' Levitus month = ',ntem1,'  level = ', jpkm1
269            CALL prihre( temdta(1,1,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
270         ENDIF
271      ENDIF
272
273 
274      ! 2. At every time step compute temperature data
275      ! ----------------------------------------------
276
277      zxy = FLOAT( nday + 15 - 30 * i15 ) / 30.
278      t_dta(:,:,:) = (1.-zxy) * temdta(:,:,:,1) + zxy * temdta(:,:,:,2)
279
280   END SUBROUTINE dta_tem
281
282# endif
283
284#else
285   !!----------------------------------------------------------------------
286   !!   Default case                           NO 3D temperature data field
287   !!----------------------------------------------------------------------
288   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .FALSE.   !: temperature data flag
289CONTAINS
290   SUBROUTINE dta_tem( kt )        ! Empty routine
291      WRITE(*,*) 'dta_tem: You should not have seen this print! error?', kt
292   END SUBROUTINE dta_tem
293#endif
294   !!======================================================================
295END MODULE dtatem
Note: See TracBrowser for help on using the repository browser.