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

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

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