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

source: branches/2011/dev_r2769_LOCEAN_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DTA/dtatem.F90 @ 2770

Last change on this file since 2770 was 2715, checked in by rblod, 13 years ago

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