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

source: branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/DTA/dtatem.F90 @ 2200

Last change on this file since 2200 was 2104, checked in by cetlod, 14 years ago

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