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

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

nemo_v1_update_046 : CT : - light modifications related to the way to make SST/SSS damping

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