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

Last change on this file since 2412 was 2392, checked in by gm, 14 years ago

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