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

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

RB:nemo_v1_update_038: first integration of Agrif :

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