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

Last change on this file since 239 was 239, checked in by opalod, 19 years ago

CT : UPDATE172 : remove all direct acces modules and the related cpp key key_fdir
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 11.4 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   !!----------------------------------------------------------------------
48   !!   Default case                                            NetCDF file
49   !!----------------------------------------------------------------------
50
51   SUBROUTINE dta_tem( kt )
52      !!----------------------------------------------------------------------
53      !!                   ***  ROUTINE dta_tem  ***
54      !!                   
55      !! ** Purpose :   Reads monthly temperature data
56      !!
57      !! ** Method  :   Read on unit numtdt the interpolated temperature
58      !!      onto the model grid.
59      !!      Data begin at january.
60      !!      The value is centered at the middle of month.
61      !!      In the opa model, kt=1 agree with january 1.
62      !!      At each time step, a linear interpolation is applied between
63      !!      two monthly values.
64      !!      Read on unit numtdt
65      !!
66      !! ** Action  :   define t_dta array at time-step kt
67      !!
68      !! History :
69      !!        !  91-03  ()  Original code
70      !!        !  92-07  (M. Imbard)
71      !!        !  99-10  (M.A. Foujols, M. Imbard)  NetCDF FORMAT
72      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
73      !!----------------------------------------------------------------------
74      !! * Modules used
75      USE ioipsl
76
77      !! * Arguments
78      INTEGER, INTENT( in ) ::   kt     ! ocean time-step
79
80      !! * Local declarations
81      INTEGER, PARAMETER ::   &
82         jpmois = 12                    ! number of month
83      INTEGER ::   ji, jj, jl           ! dummy loop indicies
84      INTEGER ::   &
85         imois, iman, itime, ik ,    &  ! temporary integers
86         i15, ipi, ipj, ipk             !    "          "
87#  if defined key_tradmp
88      INTEGER ::   &
89         il0, il1, ii0, ii1, ij0, ij1   ! temporary integers
90# endif
91
92      INTEGER, DIMENSION(jpmois) ::   istep
93      REAL(wp) ::   zxy, zl, zdate0
94      REAL(wp), DIMENSION(jpi,jpj) ::   zlon,zlat
95      REAL(wp), DIMENSION(jpk) ::   zlev
96      !!----------------------------------------------------------------------
97
98
99      ! 0. Initialization
100      ! -----------------
101
102      iman  = jpmois
103      i15   = nday / 16
104      imois = nmonth + i15 - 1
105      IF( imois == 0 )   imois = iman
106
107      itime = jpmois
108      ipi = jpiglo
109      ipj = jpjglo
110      ipk = jpk
111
112      ! 1. First call kt=nit000
113      ! -----------------------
114
115      IF( kt == nit000 .AND. nlecte == 0 ) THEN
116         ntem1 = 0
117         IF(lwp) WRITE(numout,*)
118         IF(lwp) WRITE(numout,*) ' dtatem : Levitus monthly fields'
119         IF(lwp) WRITE(numout,*) ' ~~~~~~'
120         IF(lwp) WRITE(numout,*) '             NetCDF FORMAT'
121         IF(lwp) WRITE(numout,*)
122         
123         ! open file
124
125         CALL flinopen( TRIM(cl_tdata), mig(1), nlci , mjg(1),  nlcj   &
126                      , .false.     , ipi   , ipj  , ipk   , zlon   &
127                      , zlat        , zlev  , itime, istep , zdate0   &
128                      , rdt         , numtdt                        )
129
130         ! title, dimensions and tests
131
132         IF( itime /= jpmois ) THEN
133            IF(lwp) THEN
134               WRITE(numout,*)
135               WRITE(numout,*) 'problem with time coordinates'
136               WRITE(numout,*) ' itime ',itime,' jpmois ',jpmois
137            ENDIF
138            STOP 'dtatem'
139         ENDIF
140         IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN
141            IF(lwp) THEN
142               WRITE(numout,*)
143               WRITE(numout,*) 'problem with dimensions'
144               WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta
145               WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta
146               WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk
147            ENDIF
148            STOP 'dtatem'
149         ENDIF
150         IF(lwp) WRITE(numout,*) itime,istep,zdate0,rdt,numtdt
151
152      ENDIF
153
154
155      ! 2. Read monthly file
156      ! -------------------
157
158      IF( ( kt == nit000 .AND. nlecte == 0 ) .OR. imois /= ntem1 ) THEN
159         nlecte = 1
160
161         ! Calendar computation
162         
163         ntem1 = imois        ! first file record used
164         ntem2 = ntem1 + 1    ! last  file record used
165         ntem1 = MOD( ntem1, iman )
166         IF( ntem1 == 0 )   ntem1 = iman
167         ntem2 = MOD( ntem2, iman )
168         IF( ntem2 == 0 )   ntem2 = iman
169         IF(lwp) WRITE(numout,*) 'first record file used ntem1 ', ntem1
170         IF(lwp) WRITE(numout,*) 'last  record file used ntem2 ', ntem2
171         
172         ! Read monthly temperature data Levitus
173         
174         CALL flinget( numtdt, 'votemper', jpidta, jpjdta, jpk   &
175                     , jpmois, ntem1     , ntem1 , mig(1), nlci   &
176                     , mjg(1), nlcj      , temdta(1:nlci,1:nlcj,1:jpk,1)     )
177         CALL flinget( numtdt, 'votemper', jpidta, jpjdta, jpk   &
178                     , jpmois, ntem2     , ntem2 , mig(1), nlci   &
179                     , mjg(1), nlcj      , temdta(1:nlci,1:nlcj,1:jpk,2)     )
180
181         IF(lwp) WRITE(numout,*)
182         IF(lwp) WRITE(numout,*) ' read Levitus temperature ok'
183         IF(lwp) WRITE(numout,*)
184         
185#  if defined key_tradmp
186         IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN
187     
188            !                                        ! =======================
189            !                                        !  ORCA_R2 configuration
190            !                                        ! =======================
191
192            ij0 = 101   ;   ij1 = 109
193            ii0 = 141   ;   ii1 = 155
194            DO jj = mj0(ij0), mj1(ij1)                      ! Reduced temperature in the Alboran Sea
195               DO ji = mi0(ii0), mi1(ii1)
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               ij0 =  87   ;   ij1 =  96
205               ii0 = 148   ;   ii1 = 160
206               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 , : ) = 7.0 
207               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5 
208               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0
209            ELSE
210               il0 = 138   ;   il1 = 138
211               ij0 = 101   ;   ij1 = 102
212               ii0 = 139   ;   ii1 = 139
213               DO jl = mi0(il0), mi1(il1)                ! New temperature profile at Gibraltar
214                  DO jj = mj0(ij0), mj1(ij1)
215                     DO ji = mi0(ii0), mi1(ii1)
216                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
217                     END DO
218                  END DO
219               END DO
220               il0 = 164   ;   il1 = 164
221               ij0 =  88   ;   ij1 =  88
222               ii0 = 161   ;   ii1 = 163
223               DO jl = mi0(il0), mi1(il1)                ! New temperature profile at Bab el Mandeb
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                  ij0 =  87   ;   ij1 =  87
230                  DO jj = mj0(ij0), mj1(ij1)
231                     DO ji = mi0(ii0), mi1(ii1)
232                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
233                     END DO
234                  END DO
235               END DO
236            ENDIF
237
238         ENDIF
239#  endif
240
241         !                                  ! Mask
242         DO jl = 1, 2
243            temdta(:,:,:,jl) = temdta(:,:,:,jl) * tmask(:,:,:)
244            temdta(:,:,jpk,jl) = 0.
245            IF( lk_zps ) THEN                ! z-coord. with partial steps
246               DO jj = 1, jpj                  ! interpolation of temperature at the last level
247                  DO ji = 1, jpi
248                     ik = mbathy(ji,jj) - 1
249                     IF( ik > 2 ) THEN
250                        zl = ( gdept(ik) - fsdept(ji,jj,ik) ) / ( gdept(ik) - gdept(ik-1) )
251                        temdta(ji,jj,ik,jl) = (1.-zl) * temdta(ji,jj,ik,jl) + zl * temdta(ji,jj,ik-1,jl) 
252                     ENDIF
253                  END DO
254               END DO
255            ENDIF
256         END DO
257
258         IF(lwp) THEN
259            WRITE(numout,*) ' temperature Levitus month ', ntem1, ntem2
260            WRITE(numout,*)
261            WRITE(numout,*) ' Levitus month = ', ntem1, '  level = 1'
262            CALL prihre( temdta(1,1,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
263            WRITE(numout,*) ' Levitus month = ', ntem1, '  level = ', jpk/2
264            CALL prihre( temdta(1,1,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
265            WRITE(numout,*) ' Levitus month = ',ntem1,'  level = ', jpkm1
266            CALL prihre( temdta(1,1,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
267         ENDIF
268      ENDIF
269
270 
271      ! 2. At every time step compute temperature data
272      ! ----------------------------------------------
273
274      zxy = FLOAT( nday + 15 - 30 * i15 ) / 30.
275      t_dta(:,:,:) = (1.-zxy) * temdta(:,:,:,1) + zxy * temdta(:,:,:,2)
276
277   END SUBROUTINE dta_tem
278
279#else
280   !!----------------------------------------------------------------------
281   !!   Default case                           NO 3D temperature data field
282   !!----------------------------------------------------------------------
283   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .FALSE.   !: temperature data flag
284CONTAINS
285   SUBROUTINE dta_tem( kt )        ! Empty routine
286      WRITE(*,*) 'dta_tem: You should not have seen this print! error?', kt
287   END SUBROUTINE dta_tem
288#endif
289   !!======================================================================
290END MODULE dtatem
Note: See TracBrowser for help on using the repository browser.