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/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DTA – NEMO

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DTA/dtatem.F90 @ 2281

Last change on this file since 2281 was 2281, checked in by smasson, 13 years ago

set proper svn properties to all files...

  • 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      INTEGER, INTENT( in ) ::   kt     ! ocean time-step
72
73      INTEGER ::   ji, jj, jk, jl, jkk            ! dummy loop indicies
74      INTEGER ::   ik, ierror                     ! temporary integers
75#if defined key_tradmp
76      INTEGER ::   il0, il1, ii0, ii1, ij0, ij1   ! temporary integers
77#endif
78      REAL(wp)::   zl
79#if defined key_orca_lev10
80      INTEGER ::   ikr, ikw, ikt, jjk 
81      REAL(wp)::   zfac
82#endif
83      REAL(wp), DIMENSION(jpk) ::   ztemdta            ! auxiliary array for interpolation
84      CHARACTER(len=100)       ::   cn_dir             ! Root directory for location of ssr files
85      TYPE(FLD_N)              ::   sn_tem
86      LOGICAL , SAVE           ::   linit_tem = .FALSE.
87      !!----------------------------------------------------------------------
88      NAMELIST/namdta_tem/cn_dir,sn_tem
89 
90      ! 1. Initialization
91      ! -----------------------
92     
93      IF( kt == nit000 .AND. (.NOT. linit_tem ) ) THEN
94
95         !                   ! set file information
96         cn_dir = './'       ! directory in which the model is executed
97         ! ... default values (NB: frequency positive => hours, negative => months)
98         !            !   file    ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   !
99         !            !   name    !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      !
100         sn_tem = FLD_N( 'temperature',  -1.  ,  'votemper',  .false.   , .true.  ,  'yearly'  , ''       , ''         )
101
102         REWIND( numnam )         ! ... read in namlist namdta_tem
103         READ( numnam, namdta_tem ) 
104
105         IF(lwp) THEN              ! control print
106            WRITE(numout,*)
107            WRITE(numout,*) 'dta_tem : Temperature Climatology '
108            WRITE(numout,*) '~~~~~~~ '
109         ENDIF
110         ALLOCATE( sf_tem(1), STAT=ierror )
111         IF( ierror > 0 ) THEN
112             CALL ctl_stop( 'dta_tem: unable to allocate sf_tem structure' )   ;   RETURN
113         ENDIF
114
115#if defined key_orca_lev10
116                                ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpkdta)   )
117         IF( sn_tem%ln_tint )   ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpkdta,2) )
118#else
119                                ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpk)   )
120         IF( sn_tem%ln_tint )   ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpk,2) )
121#endif
122         ! fill sf_tem with sn_tem and control print
123         CALL fld_fill( sf_tem, (/ sn_tem /), cn_dir, 'dta_tem', 'Temperature data', 'namdta_tem' )
124         linit_tem = .TRUE.
125         !
126      ENDIF
127     
128      ! 2. Read monthly file
129      ! -------------------
130         
131      CALL fld_read( kt, 1, sf_tem )
132       
133      IF( lwp .AND. kt == nit000 )THEN
134         WRITE(numout,*)
135         WRITE(numout,*) ' read Levitus temperature ok'
136         WRITE(numout,*)
137      ENDIF
138         
139#if defined key_tradmp
140      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN
141         !                                        ! =======================
142         !                                        !  ORCA_R2 configuration
143         !                                        ! =======================
144         ij0 = 101   ;   ij1 = 109
145         ii0 = 141   ;   ii1 = 155
146         DO jj = mj0(ij0), mj1(ij1)                      ! Reduced temperature in the Alboran Sea
147            DO ji = mi0(ii0), mi1(ii1)
148               sf_tem(1)%fnow(ji,jj, 13:13 ) = sf_tem(1)%fnow(ji,jj, 13:13 ) - 0.20
149               sf_tem(1)%fnow(ji,jj, 14:15 ) = sf_tem(1)%fnow(ji,jj, 14:15 ) - 0.35 
150               sf_tem(1)%fnow(ji,jj, 16:25 ) = sf_tem(1)%fnow(ji,jj, 16:25 ) - 0.40
151            END DO
152         END DO
153           
154         IF( n_cla == 1 ) THEN 
155            !                                         ! New temperature profile at Gibraltar
156            il0 = 138   ;   il1 = 138
157            ij0 = 101   ;   ij1 = 102
158            ii0 = 139   ;   ii1 = 139
159            DO jl = mi0(il0), mi1(il1)
160               DO jj = mj0(ij0), mj1(ij1)
161                  DO ji = mi0(ii0), mi1(ii1)
162                     sf_tem(1)%fnow(ji,jj,:) = sf_tem(1)%fnow(jl,jj,:)
163                  END DO
164               END DO
165            END DO
166            !                                         ! New temperature profile at Bab el Mandeb
167            il0 = 164   ;   il1 = 164
168            ij0 =  87   ;   ij1 =  88
169            ii0 = 161   ;   ii1 = 163
170            DO jl = mi0(il0), mi1(il1)
171               DO jj = mj0(ij0), mj1(ij1)
172                  DO ji = mi0(ii0), mi1(ii1)
173                     sf_tem(1)%fnow(ji,jj,:) = sf_tem(1)%fnow(jl,jj,:)
174                  END DO
175               END DO
176            END DO
177            !
178         ELSE
179            !                                         ! Reduced temperature at Red Sea
180            ij0 =  87   ;   ij1 =  96
181            ii0 = 148   ;   ii1 = 160
182            sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 ) = 7.0
183            sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5
184            sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0
185         ENDIF
186            !
187      ENDIF
188#endif
189         
190#if defined key_orca_lev10
191      DO jjk = 1, 5
192         t_dta(:,:,jjk) = sf_tem(1)%fnow(:,:,1)
193      END DO
194      DO jk = 1, jpk-20,10
195         ik = jk+5
196         ikr =  INT(jk/10) + 1
197         ikw =  (ikr-1) *10 + 1
198         ikt =  ikw + 5
199         DO jjk=ikt,ikt+9
200            zfac = ( gdept_0(jjk   ) - gdepw_0(ikt) ) / ( gdepw_0(ikt+10) - gdepw_0(ikt) )
201            t_dta(:,:,jjk) = sf_tem(1)%fnow(:,:,ikr) + ( sf_tem(1)%fnow(:,:,ikr+1) - sf_tem(1)%fnow(:,:,ikr) ) * zfac
202         END DO
203      END DO
204      DO jjk = jpk-5, jpk
205         t_dta(:,:,jjk) = sf_tem(1)%fnow(:,:,jpkdta-1)
206      END DO
207      ! fill the overlap areas
208      CALL lbc_lnk (t_dta(:,:,:),'Z',-999.,'no0')
209#else
210      t_dta(:,:,:) = sf_tem(1)%fnow(:,:,:) 
211#endif
212         
213      IF( ln_sco ) THEN
214         DO jj = 1, jpj                  ! interpolation of temperatures
215            DO ji = 1, jpi
216               DO jk = 1, jpk
217                  zl=fsdept_0(ji,jj,jk)
218                  IF(zl < gdept_0(1))   ztemdta(jk) =  t_dta(ji,jj,1)
219                  IF(zl > gdept_0(jpk)) ztemdta(jk) =  t_dta(ji,jj,jpkm1) 
220                  DO jkk = 1, jpkm1
221                     IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN
222                        ztemdta(jk) = t_dta(ji,jj,jkk)                                 &
223                                  &    + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk))  &
224                                  &    * (t_dta(ji,jj,jkk+1) - t_dta(ji,jj,jkk))
225                     ENDIF
226                  END DO
227               END DO
228               DO jk = 1, jpkm1
229                  t_dta(ji,jj,jk) = ztemdta(jk)
230               END DO
231               t_dta(ji,jj,jpk) = 0.0
232            END DO
233         END DO
234           
235         IF( lwp .AND. kt == nit000 )THEN
236            WRITE(numout,*)
237            WRITE(numout,*) ' Levitus temperature data interpolated to s-coordinate'
238            WRITE(numout,*)
239         ENDIF
240           
241      ELSE
242         !                                  ! Mask
243         t_dta(:,:,:  ) = t_dta(:,:,:) * tmask(:,:,:)
244         t_dta(:,:,jpk) = 0.
245         IF( ln_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_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) )
251                     t_dta(ji,jj,ik) = (1.-zl) * t_dta(ji,jj,ik) + zl * t_dta(ji,jj,ik-1)
252                  ENDIF
253            END DO
254         END DO
255      ENDIF
256
257   ENDIF
258         
259   IF( lwp .AND. kt == nit000 ) THEN
260      WRITE(numout,*) ' temperature Levitus '
261      WRITE(numout,*)
262      WRITE(numout,*)'  level = 1'
263      CALL prihre( t_dta(:,:,1    ), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
264      WRITE(numout,*)'  level = ', jpk/2
265      CALL prihre( t_dta(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
266      WRITE(numout,*)'  level = ', jpkm1
267      CALL prihre( t_dta(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
268   ENDIF
269
270   END SUBROUTINE dta_tem
271
272#else
273   !!----------------------------------------------------------------------
274   !!   Default case                           NO 3D temperature data field
275   !!----------------------------------------------------------------------
276   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .FALSE.   !: temperature data flag
277CONTAINS
278   SUBROUTINE dta_tem( kt )        ! Empty routine
279      WRITE(*,*) 'dta_tem: You should not have seen this print! error?', kt
280   END SUBROUTINE dta_tem
281#endif
282   !!======================================================================
283END MODULE dtatem
Note: See TracBrowser for help on using the repository browser.