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

Last change on this file since 2392 was 2392, checked in by gm, 13 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
RevLine 
[3]1MODULE dtatem
2   !!======================================================================
3   !!                     ***  MODULE  dtatem  ***
4   !! Ocean data  :  read ocean temperature data from monthly atlas data
5   !!=====================================================================
[2392]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   !!----------------------------------------------------------------------
[3]12#if defined key_dtatem   ||   defined key_esopa
13   !!----------------------------------------------------------------------
14   !!   'key_dtatem'                              3D temperature data field
15   !!----------------------------------------------------------------------
16   !!   dta_tem      : read ocean temperature data
[473]17   !!---l-------------------------------------------------------------------
[3]18   USE oce             ! ocean dynamics and tracers
19   USE dom_oce         ! ocean space and time domain
[1951]20   USE fldread         ! read input fields
[3]21   USE in_out_manager  ! I/O manager
[473]22   USE phycst          ! physical constants
23#if defined key_orca_lev10
24   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
25#endif
[3]26   IMPLICIT NONE
27   PRIVATE
28
[2392]29   PUBLIC   dta_tem    ! called by step.F90 and inidta.F90
[3]30
[16]31   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .TRUE.   !: temperature data flag
[1951]32   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::  t_dta    !: temperature data at given time-step
[3]33
[1951]34   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tem      ! structure of input SST (file informations, fields read)
[3]35
36   !! * Substitutions
37#  include "domzgr_substitute.h90"
38   !!----------------------------------------------------------------------
[2287]39   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
[1152]40   !! $Id$
[2392]41   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
[3]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
[2392]63      !
[1951]64      INTEGER ::   ji, jj, jk, jl, jkk            ! dummy loop indicies
[2104]65      INTEGER ::   ik, ierror                     ! temporary integers
[1951]66#if defined key_tradmp
67      INTEGER ::   il0, il1, ii0, ii1, ij0, ij1   ! temporary integers
68#endif
[2104]69      REAL(wp)::   zl
[473]70#if defined key_orca_lev10
[1951]71      INTEGER ::   ikr, ikw, ikt, jjk 
72      REAL(wp)::   zfac
[473]73#endif
[1951]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.
[2392]78      !!
79      NAMELIST/namdta_tem/   cn_dir, sn_tem
[3]80      !!----------------------------------------------------------------------
[1951]81 
82      ! 1. Initialization
[473]83      ! -----------------------
84     
[1951]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)
[2392]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'   , ''       , ''       )
[1951]93
[2392]94         REWIND( numnam )          ! read in namlist namdta_tem
[1951]95         READ( numnam, namdta_tem ) 
96
[2236]97         IF(lwp) THEN              ! control print
[1951]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
[2236]108                                ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpkdta)   )
109         IF( sn_tem%ln_tint )   ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpkdta,2) )
[1951]110#else
[2236]111                                ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpk)   )
112         IF( sn_tem%ln_tint )   ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpk,2) )
[1951]113#endif
[2392]114         !                         ! fill sf_tem with sn_tem and control print
[1951]115         CALL fld_fill( sf_tem, (/ sn_tem /), cn_dir, 'dta_tem', 'Temperature data', 'namdta_tem' )
116         linit_tem = .TRUE.
[2236]117         !
[473]118      ENDIF
119     
120      ! 2. Read monthly file
121      ! -------------------
122         
[1951]123      CALL fld_read( kt, 1, sf_tem )
124       
[2236]125      IF( lwp .AND. kt == nit000 )THEN
[1951]126         WRITE(numout,*)
127         WRITE(numout,*) ' read Levitus temperature ok'
128         WRITE(numout,*)
129      ENDIF
[473]130         
[434]131#if defined key_tradmp
[2392]132      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN      !  ORCA_R2 configuration
133         !
[1951]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
[473]141            END DO
[1951]142         END DO
[2392]143         !
144         IF( nn_cla == 1 ) THEN 
[1951]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,:)
[473]153                  END DO
154               END DO
[1951]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,:)
[473]164                  END DO
[1273]165               END DO
[1951]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
[473]174         ENDIF
[1951]175            !
176      ENDIF
[473]177#endif
178         
179#if defined key_orca_lev10
[1951]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
[473]191         END DO
[1951]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(:,:,:) 
[473]200#endif
201         
[1951]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
[473]215                  END DO
216               END DO
[1951]217               DO jk = 1, jpkm1
218                  t_dta(ji,jj,jk) = ztemdta(jk)
219               END DO
220               t_dta(ji,jj,jpk) = 0.0
[473]221            END DO
[1951]222         END DO
[473]223           
[2236]224         IF( lwp .AND. kt == nit000 )THEN
[1951]225            WRITE(numout,*)
226            WRITE(numout,*) ' Levitus temperature data interpolated to s-coordinate'
227            WRITE(numout,*)
228         ENDIF
[473]229           
[1951]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
[2392]242               END DO
[473]243            END DO
[2392]244         ENDIF
245         !
[473]246      ENDIF
[1951]247         
[2392]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      !
[1951]259   END SUBROUTINE dta_tem
260
[3]261#else
262   !!----------------------------------------------------------------------
263   !!   Default case                           NO 3D temperature data field
264   !!----------------------------------------------------------------------
[16]265   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .FALSE.   !: temperature data flag
[3]266CONTAINS
267   SUBROUTINE dta_tem( kt )        ! Empty routine
[16]268      WRITE(*,*) 'dta_tem: You should not have seen this print! error?', kt
[3]269   END SUBROUTINE dta_tem
270#endif
271   !!======================================================================
272END MODULE dtatem
Note: See TracBrowser for help on using the repository browser.