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

Last change on this file since 1806 was 1806, checked in by cbricaud, 14 years ago

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