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

source: branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/DTA/dtatem.F90 @ 2144

Last change on this file since 2144 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
RevLine 
[3]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
[473]11   !!---l-------------------------------------------------------------------
[3]12   !! * Modules used
13   USE oce             ! ocean dynamics and tracers
14   USE dom_oce         ! ocean space and time domain
[1951]15   USE fldread         ! read input fields
[3]16   USE in_out_manager  ! I/O manager
[473]17   USE phycst          ! physical constants
18#if defined key_orca_lev10
19   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
20#endif
[3]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
[16]28   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .TRUE.   !: temperature data flag
[1951]29   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::  t_dta    !: temperature data at given time-step
[3]30
31   !! * Module variables
[1951]32   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tem      ! structure of input SST (file informations, fields read)
[3]33
34   !! * Substitutions
35#  include "domzgr_substitute.h90"
36   !!----------------------------------------------------------------------
[247]37   !!   OPA 9.0 , LOCEAN-IPSL (2005)
[1152]38   !! $Id$
[247]39   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
[3]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
[1951]75      INTEGER ::   ji, jj, jk, jl, jkk            ! dummy loop indicies
[2104]76      INTEGER ::   ik, ierror                     ! temporary integers
[1951]77#if defined key_tradmp
78      INTEGER ::   il0, il1, ii0, ii1, ij0, ij1   ! temporary integers
79#endif
[2104]80      REAL(wp)::   zl
[473]81#if defined key_orca_lev10
[1951]82      INTEGER ::   ikr, ikw, ikt, jjk 
83      REAL(wp)::   zfac
[473]84#endif
[1951]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.
[3]89      !!----------------------------------------------------------------------
[1951]90      NAMELIST/namdta_tem/cn_dir,sn_tem
91 
92      ! 1. Initialization
[473]93      ! -----------------------
94     
[1951]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
[473]128      ENDIF
129     
130      ! 2. Read monthly file
131      ! -------------------
132         
[1951]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
[473]140         
[434]141#if defined key_tradmp
[1951]142      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN
[473]143           
[1951]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
[473]154            END DO
[1951]155         END DO
[473]156           
[1951]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,:)
[473]166                  END DO
167               END DO
[1951]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,:)
[473]177                  END DO
[1273]178               END DO
[1951]179            END DO
[1273]180            !
[1951]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
[473]188         ENDIF
[1951]189            !
190      ENDIF
[473]191#endif
192         
193#if defined key_orca_lev10
[1951]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
[473]205         END DO
[1951]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(:,:,:) 
[473]214#endif
215         
[1951]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
[473]229                  END DO
230               END DO
[1951]231               DO jk = 1, jpkm1
232                  t_dta(ji,jj,jk) = ztemdta(jk)
233               END DO
234               t_dta(ji,jj,jpk) = 0.0
[473]235            END DO
[1951]236         END DO
[473]237           
[1951]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
[473]243           
[1951]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
[473]256            END DO
[1951]257         END DO
[473]258      ENDIF
[3]259
[1951]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
[3]275#else
276   !!----------------------------------------------------------------------
277   !!   Default case                           NO 3D temperature data field
278   !!----------------------------------------------------------------------
[16]279   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .FALSE.   !: temperature data flag
[3]280CONTAINS
281   SUBROUTINE dta_tem( kt )        ! Empty routine
[16]282      WRITE(*,*) 'dta_tem: You should not have seen this print! error?', kt
[3]283   END SUBROUTINE dta_tem
284#endif
285   !!======================================================================
286END MODULE dtatem
Note: See TracBrowser for help on using the repository browser.