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.
dtasal.F90 in trunk/NEMO/OPA_SRC/DTA – NEMO

source: trunk/NEMO/OPA_SRC/DTA/dtasal.F90 @ 459

Last change on this file since 459 was 459, checked in by opalod, 18 years ago

nemo_v1_update_050:RB: update dtasal and dtatem according to the new coordinate definition
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 11.2 KB
Line 
1MODULE dtasal
2   !!======================================================================
3   !!                     ***  MODULE  dtasal  ***
4   !! Ocean data  :  read ocean salinity data from monthly atlas data
5   !!=====================================================================
6#if defined key_dtasal   ||   defined key_esopa
7   !!----------------------------------------------------------------------
8   !!   'key_dtasal'                                          salinity data
9   !!----------------------------------------------------------------------
10   !!   dta_sal      : read ocean salinity data
11   !!----------------------------------------------------------------------
12   !! * Modules used
13   USE oce             ! ocean dynamics and tracers
14   USE dom_oce         ! ocean space and time domain
15   USE in_out_manager  ! I/O manager
16   USE daymod          ! calendar
17
18   IMPLICIT NONE
19   PRIVATE
20
21   !! * Routine accessibility
22   PUBLIC dta_sal   ! called by step.F90 and inidta.F90
23   
24   !! * Shared module variables
25   LOGICAL , PUBLIC, PARAMETER ::   lk_dtasal = .TRUE.    !: salinity data flag
26   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !:
27      s_dta       !: salinity data at given time-step
28
29   !! * Module variables
30   INTEGER ::   &
31      nlecsa = 0,   &  ! switch for the first read
32      nsal1     ,   &  ! first record used
33      nsal2            ! second record used
34   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   &
35      saldta    ! salinity data at two consecutive times
36
37   !! * Substitutions
38#  include "domzgr_substitute.h90"
39   !!----------------------------------------------------------------------
40   !!   OPA 9.0 , LOCEAN-IPSL (2005)
41   !! $Header$
42   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
43   !!----------------------------------------------------------------------
44
45CONTAINS
46
47   !!----------------------------------------------------------------------
48   !!   Default option:                                         NetCDF file
49   !!----------------------------------------------------------------------
50
51   SUBROUTINE dta_sal( kt )
52      !!----------------------------------------------------------------------
53      !!                   ***  ROUTINE dta_sal  ***
54      !!       
55      !! ** Purpose :   Reads monthly salinity data
56      !!             
57      !! ** Method  : - Read on unit numsdt the monthly salinity data interpo-
58      !!     lated onto the model grid.
59      !!              - At each time step, a linear interpolation is applied
60      !!     between two monthly values.
61      !!
62      !! History :
63      !!        !  91-03  ()  Original code
64      !!        !  92-07  (M. Imbard)
65      !!   9.0  !  02-06  (G. Madec)  F90: Free form and module
66      !!----------------------------------------------------------------------
67      !! * Modules used
68      USE ioipsl
69
70      !! * Arguments
71      INTEGER, INTENT(in) ::   kt             ! ocean time step
72
73      !! * Local declarations
74      CHARACTER (len=32) ::   clname
75
76      INTEGER, PARAMETER ::   jpmois = 12, jpf = 1
77      INTEGER ::   ji, jj, jl, jkk  ! dummy loop indicies
78      REAL(wp), DIMENSION(jpk,2) ::   &
79         zsaldta            ! auxiliary array for interpolation
80
81      INTEGER ::   &
82         imois, iman, ik, i15,       &  ! temporary integers
83         ipi, ipj, ipk, itime           !    "          "
84#if defined key_tradmp
85      INTEGER ::   &
86         jk, il0, il1,               &  ! temporary integers
87         ii0, ii1, ij0, ij1             !    "          "
88#endif
89      INTEGER, DIMENSION(jpmois) ::   istep
90      REAL(wp) ::   &
91         zxy, zl, zdate0
92      REAL(wp), DIMENSION(jpi,jpj) ::   zlon, zlat
93      REAL(wp), DIMENSION(jpk) ::   zlev
94      !!----------------------------------------------------------------------
95
96     ! 0. Initialization
97     ! -----------------
98
99     iman  = jpmois
100     i15   = nday / 16
101
102     imois = nmonth + i15 - 1
103     IF( imois == 0 ) imois = iman
104
105     itime = jpmois
106     ipi=jpiglo
107     ipj=jpjglo
108     ipk = jpk
109
110     ! 1. First call kt=nit000
111     ! -----------------------
112
113     IF( kt == nit000 .AND. nlecsa == 0 ) THEN
114   nsal1 = 0
115   IF(lwp) THEN
116      WRITE(numout,*)
117      WRITE(numout,*) ' dta_sal : monthly salinity data in NetCDF file'
118      WRITE(numout,*) ' ~~~~~~~'
119      WRITE(numout,*)
120   ENDIF
121
122   ! open file
123
124   clname = 'data_1m_salinity_nomask'
125#if defined key_agrif
126   if ( .NOT. Agrif_Root() ) then
127      clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname)
128   endif
129#endif             
130   CALL flinopen(TRIM(clname),mig(1),nlci,mjg(1),nlcj,.FALSE.   &
131        ,ipi,ipj,ipk,zlon,zlat,zlev,itime,istep,zdate0,rdt,numsdt)
132
133   ! title, dimensions and tests
134
135   IF( itime /= jpmois ) THEN
136      IF(lwp) THEN
137         WRITE(numout,*)
138         WRITE(numout,*) 'problem with time coordinates'
139         WRITE(numout,*) ' itime ',itime,' jpmois ',jpmois
140      ENDIF
141      STOP 'dta_sal'
142   ENDIF
143   IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN
144      IF(lwp) THEN
145         WRITE(numout,*)
146         WRITE(numout,*) 'problem with dimensions'
147         WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta
148         WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta
149         WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk
150      ENDIF
151      STOP 'dta_sal'
152   ENDIF
153   IF(lwp)WRITE(numout,*) itime,istep,zdate0,rdt,numsdt
154
155     ENDIF
156
157
158     ! 2. Read monthly file
159     ! -------------------
160
161     IF( ( kt == nit000 .AND. nlecsa == 0) .OR. imois /= nsal1 ) THEN
162   nlecsa = 1
163
164   ! 2.1 Calendar computation
165
166   nsal1 = imois        ! first file record used
167   nsal2 = nsal1 + 1    ! last  file record used
168   nsal1 = MOD( nsal1, iman )
169   IF( nsal1 == 0 ) nsal1 = iman
170   nsal2 = MOD( nsal2, iman )
171   IF( nsal2 == 0 ) nsal2 = iman
172   IF(lwp) WRITE(numout,*) 'first record file used nsal1 ', nsal1
173   IF(lwp) WRITE(numout,*) 'last  record file used nsal2 ', nsal2
174
175   ! 2.3 Read monthly salinity data Levitus
176
177   CALL flinget(numsdt,'vosaline',jpidta,jpjdta,jpk,jpmois,nsal1,   &
178     nsal1,mig(1),nlci,mjg(1),nlcj,saldta(1:nlci,1:nlcj,1:jpk,1))
179
180   CALL flinget(numsdt,'vosaline',jpidta,jpjdta,jpk,jpmois,nsal2,   &
181     nsal2,mig(1),nlci,mjg(1),nlcj,saldta(1:nlci,1:nlcj,1:jpk,2))
182
183
184   IF(lwp) THEN
185      WRITE(numout,*)
186      WRITE(numout,*) ' read Levitus salinity ok'
187      WRITE(numout,*)
188   ENDIF
189
190#if defined key_tradmp
191   IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN
192
193      !                                        ! =======================
194      !                                        !  ORCA_R2 configuration
195      !                                        ! =======================
196      ij0 = 101   ;   ij1 = 109
197      ii0 = 141   ;   ii1 = 155   
198      DO jj = mj0(ij0), mj1(ij1)                      ! Reduced salinity in the Alboran Sea
199         DO ji = mi0(ii0), mi1(ii1)
200       DO jk = 13, 13
201          saldta(ji,jj,jk,:) = saldta(ji,jj,jk,:) - 0.15
202       END DO
203       DO jk = 14, 15
204          saldta(ji,jj,jk,:) = saldta(ji,jj,jk,:) - 0.25
205       END DO
206       DO jk = 16, 17
207          saldta(ji,jj,jk,:) = saldta(ji,jj,jk,:) - 0.30
208       END DO
209       DO jk = 18, 25
210          saldta(ji,jj,jk,:) = saldta(ji,jj,jk,:) - 0.35
211       END DO
212         END DO
213      END DO
214      IF( n_cla == 1 ) THEN 
215         !                                         ! New salinity profile at Gibraltar
216         il0 = 138   ;   il1 = 138   
217         ij0 = 101   ;   ij1 = 101
218         ii0 = 139   ;   ii1 = 139   
219         saldta( mi0(ii0):mi1(ii1), mj0(ij0):mj1(ij1) , : , : ) =   &
220       &                                    saldta( mi0(il0):mi1(il1) , mj0(ij0):mj1(ij1) , : , : )
221         ij0 = 101   ;   ij1 = 101
222         saldta( mi0(ii0):mi1(ii1), mj0(ij0):mj1(ij1) , : , : ) =   &
223       &                                    saldta( mi0(il0):mi1(il1) , mj0(ij0):mj1(ij1) , : , : )
224         il0 = 138   ;   il1 = 138   
225         ij0 = 101   ;   ij1 = 102
226         ii0 = 139   ;   ii1 = 139   
227         DO jl = mi0(il0), mi1(il1)                ! New salinity profile at Gibraltar
228       DO jj = mj0(ij0), mj1(ij1)
229          DO ji = mi0(ii0), mi1(ii1)
230             saldta(ji,jj,:,:) = saldta(jl,jj,:,:)
231          END DO
232       END DO
233         END DO
234
235         il0 = 164   ;   il1 = 164   
236         ij0 =  88   ;   ij1 =  88
237         ii0 = 161   ;   ii1 = 163   
238         DO jl = mi0(il0), mi1(il1)                ! New salinity profile at Bab el Mandeb
239       DO jj = mj0(ij0), mj1(ij1)
240          DO ji = mi0(ii0), mi1(ii1)
241             saldta(ji,jj,:,:) = saldta(jl,jj,:,:)
242          END DO
243       END DO
244       ij0 =  87   ;   ij1 =  87
245       DO jj = mj0(ij0), mj1(ij1)
246          DO ji = mi0(ii0), mi1(ii1)
247             saldta(ji,jj,:,:) = saldta(jl,jj,:,:)
248          END DO
249       END DO
250         END DO
251
252      ENDIF
253
254   ENDIF
255#endif   
256
257     IF( ln_sco ) THEN
258     DO jl = 1, 2
259   DO jj = 1, jpj                  ! interpolation of salinites
260      DO ji = 1, jpi
261         DO jk = 1, jpk
262        zl=fsdept(ji,jj,jk)
263        IF(zl <  gdept_0(1)) zsaldta(jk,jl) =  saldta(ji,jj,1,jl)
264        IF(zl >  gdept_0(jpk)) zsaldta(jk,jl) =  saldta(ji,jj,jpkm1,jl)
265        DO jkk = 1, jpkm1
266            IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN
267           zsaldta(jk,jl) = saldta(ji,jj,jkk,jl)                                  &
268              &           + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk))       &
269              &                              *(saldta(ji,jj,jkk+1,jl) - saldta(ji,jj,jkk,jl))
270            ENDIF
271        END DO
272         END DO
273         DO jk = 1, jpkm1
274             saldta(ji,jj,jk,jl) = zsaldta(jk,jl)
275         END DO
276             saldta(ji,jj,jpk,jl) = 0.0
277      END DO
278   END DO
279     END DO
280
281     IF(lwp) WRITE(numout,*)
282     IF(lwp) WRITE(numout,*) ' Levitus salinity data interpolated to s-coordinate'
283     IF(lwp) WRITE(numout,*)
284
285     ELSE
286     !                                     ! Mask
287     DO jl = 1, 2
288   saldta(:,:,:,jl) = saldta(:,:,:,jl)*tmask(:,:,:)
289   saldta(:,:,jpk,jl) = 0.
290   IF( ln_zps ) THEN                   ! z-coord. partial steps
291      DO jj = 1, jpj                           ! interpolation of salinity at the last ocean level (i.e. the partial step)
292         DO ji = 1, jpi
293       ik = mbathy(ji,jj) - 1
294       IF( ik > 2 ) THEN
295          zl = ( gdept_0(ik) - fsdept(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) )
296          saldta(ji,jj,ik,jl) = (1.-zl) * saldta(ji,jj,ik,jl) +zl * saldta(ji,jj,ik-1,jl)
297       ENDIF
298         END DO
299      END DO
300   ENDIF
301     END DO
302     ENDIF
303
304
305   IF(lwp) THEN
306      WRITE(numout,*)' salinity Levitus month ',nsal1,nsal2
307      WRITE(numout,*)
308      WRITE(numout,*) ' Levitus month = ',nsal1,'  level = 1'
309      CALL prihre(saldta(:,:,1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
310      WRITE(numout,*) ' Levitus month = ',nsal1,'  level = ',jpk/2
311      CALL prihre(saldta(:,:,jpk/2,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
312      WRITE(numout,*) ' Levitus month = ',nsal1,'  level = ',jpkm1
313      CALL prihre(saldta(:,:,jpkm1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
314   ENDIF
315     ENDIF
316
317
318     ! 3. At every time step compute salinity data
319     ! -------------------------------------------
320
321     zxy = FLOAT(nday + 15 - 30*i15)/30.
322     s_dta(:,:,:) = ( 1.- zxy ) * saldta(:,:,:,1) + zxy * saldta(:,:,:,2)
323
324   END SUBROUTINE dta_sal
325
326#else
327   !!----------------------------------------------------------------------
328   !!   Default option:                                    NO salinity data
329   !!----------------------------------------------------------------------
330   LOGICAL , PUBLIC, PARAMETER ::   lk_dtasal = .FALSE.   !: salinity data flag
331CONTAINS
332   SUBROUTINE dta_sal( kt )        ! Empty routine
333      WRITE(*,*) 'dta_sal: You should not have seen this print! error?', kt
334   END SUBROUTINE dta_sal
335#endif
336   !!======================================================================
337END MODULE dtasal
Note: See TracBrowser for help on using the repository browser.