source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DTA/dtatem.F90 @ 4409

Last change on this file since 4409 was 4409, checked in by trackstand2, 7 years ago

Changes to allow jpk to be modified to deepest level within a subdomain. jpkorig holds original value.

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