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 branches/DEV_r1784_3DF/NEMO/OPA_SRC/DTA – NEMO

source: branches/DEV_r1784_3DF/NEMO/OPA_SRC/DTA/dtatem.F90 @ 1856

Last change on this file since 1856 was 1856, checked in by smasson, 14 years ago

fldread_3D: small bugfix and style

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
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   !!---l-------------------------------------------------------------------
12   !! * Modules used
13   USE oce             ! ocean dynamics and tracers
14   USE dom_oce         ! ocean space and time domain
15   USE fldread         ! read input fields
16   USE in_out_manager  ! I/O manager
17   USE phycst          ! physical constants
18#if defined key_orca_lev10
19   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
20#endif
21   IMPLICIT NONE
22   PRIVATE
23
24   !! * Routine accessibility
25   PUBLIC dta_tem   ! called by step.F90 and inidta.F90
26
27   !! * Shared module variables
28   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .TRUE.   !: temperature data flag
29   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::  t_dta    !: temperature data at given time-step
30
31   !! * Module variables
32   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tem      ! structure of input SST (file informations, fields read)
33
34   !! * Substitutions
35#  include "domzgr_substitute.h90"
36   !!----------------------------------------------------------------------
37   !!   OPA 9.0 , LOCEAN-IPSL (2005)
38   !! $Id$
39   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
40   !!----------------------------------------------------------------------
41
42CONTAINS
43
44   !!----------------------------------------------------------------------
45   !!   Default case                                            NetCDF file
46   !!----------------------------------------------------------------------
47
48   SUBROUTINE dta_tem( kt )
49      !!----------------------------------------------------------------------
50      !!                   ***  ROUTINE dta_tem  ***
51      !!                   
52      !! ** Purpose :   Reads monthly temperature data
53      !!
54      !! ** Method  :   Read on unit numtdt the interpolated temperature
55      !!      onto the model grid.
56      !!      Data begin at january.
57      !!      The value is centered at the middle of month.
58      !!      In the opa model, kt=1 agree with january 1.
59      !!      At each time step, a linear interpolation is applied between
60      !!      two monthly values.
61      !!      Read on unit numtdt
62      !!
63      !! ** Action  :   define t_dta array at time-step kt
64      !!
65      !! History :
66      !!        !  91-03  ()  Original code
67      !!        !  92-07  (M. Imbard)
68      !!        !  99-10  (M.A. Foujols, M. Imbard)  NetCDF FORMAT
69      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
70      !!----------------------------------------------------------------------
71      !! * Arguments
72      INTEGER, INTENT( in ) ::   kt     ! ocean time-step
73
74      !! * Local declarations
75      INTEGER ::   ji, jj, jk, jl, jkk            ! dummy loop indicies
76      INTEGER ::   imois, iman, i15 , ik          ! temporary integers
77      INTEGER ::   ierror
78#if defined key_tradmp
79      INTEGER ::   il0, il1, ii0, ii1, ij0, ij1   ! temporary integers
80#endif
81      REAL(wp)::   zxy, zl
82#if defined key_orca_lev10
83      INTEGER ::   ikr, ikw, ikt, jjk 
84      REAL(wp)::   zfac
85#endif
86      REAL(wp), DIMENSION(jpk) ::   ztemdta            ! auxiliary array for interpolation
87      CHARACTER(len=100)       ::   cn_dir             ! Root directory for location of ssr files
88      TYPE(FLD_N)              ::   sn_tem
89      LOGICAL , SAVE           ::   linit_tem = .FALSE.
90      !!----------------------------------------------------------------------
91      NAMELIST/namdta_tem/cn_dir,sn_tem
92 
93      ! 1. Initialization
94      ! -----------------------
95     
96      IF( kt == nit000 .AND. (.NOT. linit_tem ) ) THEN
97
98         !                   ! set file information
99         cn_dir = './'       ! directory in which the model is executed
100         ! ... default values (NB: frequency positive => hours, negative => months)
101         !            !   file    ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   !
102         !            !   name    !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      !
103         sn_tem = FLD_N( 'temperature',  -1.  ,  'votemper',  .false.   , .true.  ,  'yearly'  , ''       , ''         )
104
105         REWIND( numnam )            ! ... read in namlist namdta_tem
106         READ( numnam, namdta_tem ) 
107
108         IF(lwp) THEN                ! control print
109            WRITE(numout,*)
110            WRITE(numout,*) 'dta_tem : Temperature Climatology '
111            WRITE(numout,*) '~~~~~~~ '
112         ENDIF
113         ALLOCATE( sf_tem(1), STAT=ierror )
114         IF( ierror > 0 ) THEN
115             CALL ctl_stop( 'dta_tem: unable to allocate sf_tem structure' )   ;   RETURN
116         ENDIF
117
118#if defined key_orca_lev10
119         ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpkdta  ) )
120         ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpkdta,2) )
121#else
122         ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpk  ) )
123         ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpk,2) )
124#endif
125         ! fill sf_tem with sn_tem and control print
126         CALL fld_fill( sf_tem, (/ sn_tem /), cn_dir, 'dta_tem', 'Temperature data', 'namdta_tem' )
127         linit_tem = .TRUE.
128
129      ENDIF
130     
131      ! 2. Read monthly file
132      ! -------------------
133         
134      CALL fld_read( kt, 1, sf_tem )
135       
136      IF( lwp .AND. kt==nn_it000 )THEN
137         WRITE(numout,*)
138         WRITE(numout,*) ' read Levitus temperature ok'
139         WRITE(numout,*)
140      ENDIF
141         
142#if defined key_tradmp
143      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN
144           
145         !                                        ! =======================
146         !                                        !  ORCA_R2 configuration
147         !                                        ! =======================
148         ij0 = 101   ;   ij1 = 109
149         ii0 = 141   ;   ii1 = 155
150         DO jj = mj0(ij0), mj1(ij1)                      ! Reduced temperature in the Alboran Sea
151            DO ji = mi0(ii0), mi1(ii1)
152               sf_tem(1)%fnow(ji,jj, 13:13 ) = sf_tem(1)%fnow(ji,jj, 13:13 ) - 0.20
153               sf_tem(1)%fnow(ji,jj, 14:15 ) = sf_tem(1)%fnow(ji,jj, 14:15 ) - 0.35 
154               sf_tem(1)%fnow(ji,jj, 16:25 ) = sf_tem(1)%fnow(ji,jj, 16:25 ) - 0.40
155            END DO
156         END DO
157           
158         IF( n_cla == 1 ) THEN 
159            !                                         ! New temperature profile at Gibraltar
160            il0 = 138   ;   il1 = 138
161            ij0 = 101   ;   ij1 = 102
162            ii0 = 139   ;   ii1 = 139
163            DO jl = mi0(il0), mi1(il1)
164               DO jj = mj0(ij0), mj1(ij1)
165                  DO ji = mi0(ii0), mi1(ii1)
166                     sf_tem(1)%fnow(ji,jj,:) = sf_tem(1)%fnow(jl,jj,:)
167                  END DO
168               END DO
169            END DO
170            !                                         ! New temperature profile at Bab el Mandeb
171            il0 = 164   ;   il1 = 164
172            ij0 =  87   ;   ij1 =  88
173            ii0 = 161   ;   ii1 = 163
174            DO jl = mi0(il0), mi1(il1)
175               DO jj = mj0(ij0), mj1(ij1)
176                  DO ji = mi0(ii0), mi1(ii1)
177                     sf_tem(1)%fnow(ji,jj,:) = sf_tem(1)%fnow(jl,jj,:)
178                  END DO
179               END DO
180            END DO
181            !
182         ELSE
183            !                                         ! Reduced temperature at Red Sea
184            ij0 =  87   ;   ij1 =  96
185            ii0 = 148   ;   ii1 = 160
186            sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 ) = 7.0
187            sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5
188            sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0
189         ENDIF
190            !
191      ENDIF
192#endif
193         
194#if defined key_orca_lev10
195      DO jjk = 1, 5
196         t_dta(:,:,jjk) = sf_tem(1)%fnow(:,:,1)
197      END DO
198      DO jk = 1, jpk-20,10
199         ik = jk+5
200         ikr =  INT(jk/10) + 1
201         ikw =  (ikr-1) *10 + 1
202         ikt =  ikw + 5
203         DO jjk=ikt,ikt+9
204            zfac = ( gdept_0(jjk   ) - gdepw_0(ikt) ) / ( gdepw_0(ikt+10) - gdepw_0(ikt) )
205            t_dta(:,:,jjk) = sf_tem(1)%fnow(:,:,ikr) + ( sf_tem(1)%fnow(:,:,ikr+1) - sf_tem(1)%fnow(:,:,ikr) ) * zfac
206         END DO
207      END DO
208      DO jjk = jpk-5, jpk
209         t_dta(:,:,jjk) = sf_tem(1)%fnow(:,:,jpkdta-1)
210      END DO
211      ! fill the overlap areas
212      CALL lbc_lnk (t_dta(:,:,:),'Z',-999.,'no0')
213#else
214      t_dta(:,:,:) = sf_tem(1)%fnow(:,:,:) 
215#endif
216         
217      IF( ln_sco ) THEN
218         DO jj = 1, jpj                  ! interpolation of temperatures
219            DO ji = 1, jpi
220               DO jk = 1, jpk
221                  zl=fsdept_0(ji,jj,jk)
222                  IF(zl < gdept_0(1))   ztemdta(jk) =  t_dta(ji,jj,1)
223                  IF(zl > gdept_0(jpk)) ztemdta(jk) =  t_dta(ji,jj,jpkm1) 
224                  DO jkk = 1, jpkm1
225                     IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN
226                        ztemdta(jk) = t_dta(ji,jj,jkk)                                 &
227                                  &    + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk))  &
228                                  &    * (t_dta(ji,jj,jkk+1) - t_dta(ji,jj,jkk))
229                     ENDIF
230                  END DO
231               END DO
232               DO jk = 1, jpkm1
233                  t_dta(ji,jj,jk) = ztemdta(jk)
234               END DO
235               t_dta(ji,jj,jpk) = 0.0
236            END DO
237         END DO
238           
239         IF( lwp .AND. kt==nn_it000 )THEN
240            WRITE(numout,*)
241            WRITE(numout,*) ' Levitus temperature data interpolated to s-coordinate'
242            WRITE(numout,*)
243         ENDIF
244           
245      ELSE
246         !                                  ! Mask
247         t_dta(:,:,:  ) = t_dta(:,:,:) * tmask(:,:,:)
248         t_dta(:,:,jpk) = 0.
249         IF( ln_zps ) THEN                ! z-coord. with partial steps
250            DO jj = 1, jpj                ! interpolation of temperature at the last level
251               DO ji = 1, jpi
252                  ik = mbathy(ji,jj) - 1
253                  IF( ik > 2 ) THEN
254                     zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) )
255                     t_dta(ji,jj,ik) = (1.-zl) * t_dta(ji,jj,ik) + zl * t_dta(ji,jj,ik-1)
256                  ENDIF
257            END DO
258         END DO
259      ENDIF
260
261   ENDIF
262         
263   IF( lwp .AND. kt==nn_it000 ) THEN
264      WRITE(numout,*) ' temperature Levitus '
265      WRITE(numout,*)
266      WRITE(numout,*)'  level = 1'
267      CALL prihre( t_dta(:,:,1    ), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
268      WRITE(numout,*)'  level = ', jpk/2
269      CALL prihre( t_dta(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
270      WRITE(numout,*)'  level = ', jpkm1
271      CALL prihre( t_dta(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
272   ENDIF
273
274   END SUBROUTINE dta_tem
275
276#else
277   !!----------------------------------------------------------------------
278   !!   Default case                           NO 3D temperature data field
279   !!----------------------------------------------------------------------
280   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .FALSE.   !: temperature data flag
281CONTAINS
282   SUBROUTINE dta_tem( kt )        ! Empty routine
283      WRITE(*,*) 'dta_tem: You should not have seen this print! error?', kt
284   END SUBROUTINE dta_tem
285#endif
286   !!======================================================================
287END MODULE dtatem
Note: See TracBrowser for help on using the repository browser.