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

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

CL : Add CVS Header and CeCILL licence information
  • 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=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 , 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, jl           ! dummy loop indicies
86      INTEGER ::   &
87         imois, iman, itime, ik ,    &  ! temporary integers
88         i15, ipi, ipj, ipk             !    "          "
89#  if defined key_tradmp
90      INTEGER ::   &
91         il0, il1, ii0, ii1, ij0, ij1   ! temporary integers
92# endif
93
94      INTEGER, DIMENSION(jpmois) ::   istep
95      REAL(wp) ::   zxy, zl, zdate0
96      REAL(wp), DIMENSION(jpi,jpj) ::   zlon,zlat
97      REAL(wp), DIMENSION(jpk) ::   zlev
98      !!----------------------------------------------------------------------
99
100
101      ! 0. Initialization
102      ! -----------------
103
104      iman  = jpmois
105      i15   = nday / 16
106      imois = nmonth + i15 - 1
107      IF( imois == 0 )   imois = iman
108
109      itime = jpmois
110      ipi = jpiglo
111      ipj = jpjglo
112      ipk = jpk
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 .OR. ipj /= jpjdta .OR. 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            ij0 = 101   ;   ij1 = 109
195            ii0 = 141   ;   ii1 = 155
196            DO jj = mj0(ij0), mj1(ij1)                      ! Reduced temperature in the Alboran Sea
197               DO ji = mi0(ii0), mi1(ii1)
198                  temdta(ji,jj, 13:13 ,:) = temdta(ji,jj, 13:13 ,:) - 0.20
199                  temdta(ji,jj, 14:15 ,:) = temdta(ji,jj, 14:15 ,:) - 0.35
200                  temdta(ji,jj, 16:25 ,:) = temdta(ji,jj, 16:25 ,:) - 0.40
201               END DO
202            END DO
203         
204            IF( n_cla == 0 ) THEN 
205               !                                         ! Reduced temperature at Red Sea
206               ij0 =  87   ;   ij1 =  96
207               ii0 = 148   ;   ii1 = 160
208               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 , : ) = 7.0 
209               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5 
210               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0
211            ELSE
212               il0 = 138   ;   il1 = 138
213               ij0 = 101   ;   ij1 = 102
214               ii0 = 139   ;   ii1 = 139
215               DO jl = mi0(il0), mi1(il1)                ! New temperature profile at Gibraltar
216                  DO jj = mj0(ij0), mj1(ij1)
217                     DO ji = mi0(ii0), mi1(ii1)
218                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
219                     END DO
220                  END DO
221               END DO
222               il0 = 164   ;   il1 = 164
223               ij0 =  88   ;   ij1 =  88
224               ii0 = 161   ;   ii1 = 163
225               DO jl = mi0(il0), mi1(il1)                ! New temperature profile at Bab el Mandeb
226                  DO jj = mj0(ij0), mj1(ij1)
227                     DO ji = mi0(ii0), mi1(ii1)
228                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
229                     END DO
230                  END DO
231                  ij0 =  87   ;   ij1 =  87
232                  DO jj = mj0(ij0), mj1(ij1)
233                     DO ji = mi0(ii0), mi1(ii1)
234                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
235                     END DO
236                  END DO
237               END DO
238            ENDIF
239
240         ENDIF
241#  endif
242
243         !                                  ! Mask
244         DO jl = 1, 2
245            temdta(:,:,:,jl) = temdta(:,:,:,jl) * tmask(:,:,:)
246            temdta(:,:,jpk,jl) = 0.
247            IF( lk_zps ) THEN                ! z-coord. with partial steps
248               DO jj = 1, jpj                  ! interpolation of temperature at the last level
249                  DO ji = 1, jpi
250                     ik = mbathy(ji,jj) - 1
251                     IF( ik > 2 ) THEN
252                        zl = ( gdept(ik) - fsdept(ji,jj,ik) ) / ( gdept(ik) - gdept(ik-1) )
253                        temdta(ji,jj,ik,jl) = (1.-zl) * temdta(ji,jj,ik,jl) + zl * temdta(ji,jj,ik-1,jl) 
254                     ENDIF
255                  END DO
256               END DO
257            ENDIF
258         END DO
259
260         IF(lwp) THEN
261            WRITE(numout,*) ' temperature Levitus month ', ntem1, ntem2
262            WRITE(numout,*)
263            WRITE(numout,*) ' Levitus month = ', ntem1, '  level = 1'
264            CALL prihre( temdta(1,1,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
265            WRITE(numout,*) ' Levitus month = ', ntem1, '  level = ', jpk/2
266            CALL prihre( temdta(1,1,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
267            WRITE(numout,*) ' Levitus month = ',ntem1,'  level = ', jpkm1
268            CALL prihre( temdta(1,1,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
269         ENDIF
270      ENDIF
271
272 
273      ! 2. At every time step compute temperature data
274      ! ----------------------------------------------
275
276      zxy = FLOAT( nday + 15 - 30 * i15 ) / 30.
277      t_dta(:,:,:) = (1.-zxy) * temdta(:,:,:,1) + zxy * temdta(:,:,:,2)
278
279   END SUBROUTINE dta_tem
280
281#else
282   !!----------------------------------------------------------------------
283   !!   Default case                           NO 3D temperature data field
284   !!----------------------------------------------------------------------
285   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .FALSE.   !: temperature data flag
286CONTAINS
287   SUBROUTINE dta_tem( kt )        ! Empty routine
288      WRITE(*,*) 'dta_tem: You should not have seen this print! error?', kt
289   END SUBROUTINE dta_tem
290#endif
291   !!======================================================================
292END MODULE dtatem
Note: See TracBrowser for help on using the repository browser.