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

source: branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DTA/dtatem.F90 @ 2639

Last change on this file since 2639 was 2639, checked in by cetlod, 13 years ago

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