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

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

dynamic mem: #785 ; move dyn allocation from nemogcm to module when possible (continuation)
  • 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, ALLOCATABLE, DIMENSION(:,:,:) ::   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 4.0 , NEMO Consortium (2011)
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, ierr0, ierr1, ierr2   ! local integers
64#if defined key_tradmp
65      INTEGER ::   il0, il1, ii0, ii1, ij0, ij1   ! local 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=ierr0 )
98                                ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpk)  , STAT=ierr1 )
99         IF( sn_tem%ln_tint )   ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpk,2), STAT=ierr2 )
100         IF( ierr0+ierr1+ierr2 > 0 )   CALL ctl_stop( 'STOP', 'dta_sal: unable to allocate sf_sal structure' )
101         !                         ! fill sf_tem with sn_tem and control print
102         CALL fld_fill( sf_tem, (/ sn_tem /), cn_dir, 'dta_tem', 'Temperature data', 'namdta_tem' )
103         linit_tem = .TRUE.
104         !
105      ENDIF
106     
107      ! 2. Read monthly file
108      ! -------------------
109         
110      CALL fld_read( kt, 1, sf_tem )
111       
112      IF( lwp .AND. kt == nit000 )THEN
113         WRITE(numout,*)
114         WRITE(numout,*) ' read Levitus temperature ok'
115         WRITE(numout,*)
116      ENDIF
117         
118#if defined key_tradmp
119      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN      !  ORCA_R2 configuration
120         !
121         ij0 = 101   ;   ij1 = 109
122         ii0 = 141   ;   ii1 = 155
123         DO jj = mj0(ij0), mj1(ij1)                      ! Reduced temperature in the Alboran Sea
124            DO ji = mi0(ii0), mi1(ii1)
125               sf_tem(1)%fnow(ji,jj, 13:13 ) = sf_tem(1)%fnow(ji,jj, 13:13 ) - 0.20
126               sf_tem(1)%fnow(ji,jj, 14:15 ) = sf_tem(1)%fnow(ji,jj, 14:15 ) - 0.35 
127               sf_tem(1)%fnow(ji,jj, 16:25 ) = sf_tem(1)%fnow(ji,jj, 16:25 ) - 0.40
128            END DO
129         END DO
130         !
131         IF( nn_cla == 1 ) THEN 
132            !                                         ! New temperature profile at Gibraltar
133            il0 = 138   ;   il1 = 138
134            ij0 = 101   ;   ij1 = 102
135            ii0 = 139   ;   ii1 = 139
136            DO jl = mi0(il0), mi1(il1)
137               DO jj = mj0(ij0), mj1(ij1)
138                  DO ji = mi0(ii0), mi1(ii1)
139                     sf_tem(1)%fnow(ji,jj,:) = sf_tem(1)%fnow(jl,jj,:)
140                  END DO
141               END DO
142            END DO
143            !                                         ! New temperature profile at Bab el Mandeb
144            il0 = 164   ;   il1 = 164
145            ij0 =  87   ;   ij1 =  88
146            ii0 = 161   ;   ii1 = 163
147            DO jl = mi0(il0), mi1(il1)
148               DO jj = mj0(ij0), mj1(ij1)
149                  DO ji = mi0(ii0), mi1(ii1)
150                     sf_tem(1)%fnow(ji,jj,:) = sf_tem(1)%fnow(jl,jj,:)
151                  END DO
152               END DO
153            END DO
154         ELSE
155            !                                         ! Reduced temperature at Red Sea
156            ij0 =  87   ;   ij1 =  96
157            ii0 = 148   ;   ii1 = 160
158            sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 ) = 7.0
159            sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5
160            sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0
161         ENDIF
162            !
163      ENDIF
164#endif
165         
166      t_dta(:,:,:) = sf_tem(1)%fnow(:,:,:) 
167         
168      IF( ln_sco ) THEN
169         DO jj = 1, jpj                  ! interpolation of temperatures
170            DO ji = 1, jpi
171               DO jk = 1, jpk
172                  zl=fsdept_0(ji,jj,jk)
173                  IF(zl < gdept_0(1))   ztemdta(jk) =  t_dta(ji,jj,1)
174                  IF(zl > gdept_0(jpk)) ztemdta(jk) =  t_dta(ji,jj,jpkm1) 
175                  DO jkk = 1, jpkm1
176                     IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN
177                        ztemdta(jk) = t_dta(ji,jj,jkk)                                 &
178                                  &    + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk))  &
179                                  &    * (t_dta(ji,jj,jkk+1) - t_dta(ji,jj,jkk))
180                     ENDIF
181                  END DO
182               END DO
183               DO jk = 1, jpkm1
184                  t_dta(ji,jj,jk) = ztemdta(jk)
185               END DO
186               t_dta(ji,jj,jpk) = 0.0
187            END DO
188         END DO
189           
190         IF( lwp .AND. kt == nit000 )THEN
191            WRITE(numout,*)
192            WRITE(numout,*) ' Levitus temperature data interpolated to s-coordinate'
193            WRITE(numout,*)
194         ENDIF
195           
196      ELSE
197         !                                  ! Mask
198         t_dta(:,:,:  ) = t_dta(:,:,:) * tmask(:,:,:)
199         t_dta(:,:,jpk) = 0.
200         IF( ln_zps ) THEN                ! z-coord. with partial steps
201            DO jj = 1, jpj                ! interpolation of temperature at the last level
202               DO ji = 1, jpi
203                  ik = mbkt(ji,jj)
204                  IF( ik > 1 ) THEN
205                     zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) )
206                     t_dta(ji,jj,ik) = (1.-zl) * t_dta(ji,jj,ik) + zl * t_dta(ji,jj,ik-1)
207                  ENDIF
208               END DO
209            END DO
210         ENDIF
211         !
212      ENDIF
213         
214      IF( lwp .AND. kt == nit000 ) THEN
215         WRITE(numout,*) ' temperature Levitus '
216         WRITE(numout,*)
217         WRITE(numout,*)'  level = 1'
218         CALL prihre( t_dta(:,:,1    ), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
219         WRITE(numout,*)'  level = ', jpk/2
220         CALL prihre( t_dta(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
221         WRITE(numout,*)'  level = ', jpkm1
222         CALL prihre( t_dta(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
223      ENDIF
224      !
225   END SUBROUTINE dta_tem
226
227#else
228   !!----------------------------------------------------------------------
229   !!   Default case                           NO 3D temperature data field
230   !!----------------------------------------------------------------------
231   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .FALSE.   !: temperature data flag
232CONTAINS
233   SUBROUTINE dta_tem( kt )        ! Empty routine
234      WRITE(*,*) 'dta_tem: You should not have seen this print! error?', kt
235   END SUBROUTINE dta_tem
236#endif
237   !!======================================================================
238END MODULE dtatem
Note: See TracBrowser for help on using the repository browser.