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

Last change on this file since 2513 was 2450, checked in by gm, 13 years ago

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