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

source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DTA/dtasal.F90 @ 3211

Last change on this file since 3211 was 3211, checked in by spickles2, 12 years ago

Stephen Pickles, 11 Dec 2011

Commit to bring the rest of the DCSE NEMO development branch
in line with the latest development version. This includes
array index re-ordering of all OPA_SRC/.
  • Property svn:keywords set to Id
File size: 10.7 KB
Line 
1MODULE dtasal
2   !!======================================================================
3   !!                     ***  MODULE  dtasal  ***
4   !! Ocean data  :  read ocean salinity 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_dtasal   ||   defined key_esopa
13   !!----------------------------------------------------------------------
14   !!   'key_dtasal'                                          salinity data
15   !!----------------------------------------------------------------------
16   !!   dta_sal      : read ocean salinity data
17   !!----------------------------------------------------------------------
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_sal    ! called by step.F90 and inidta.F90
29
30   LOGICAL , PUBLIC, PARAMETER                     ::   lk_dtasal = .TRUE. !: salinity data flag
31   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) ::   s_dta              !: salinity data at given time-step
32
33   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sal   ! structure of input SST (file informations, fields read)
34
35   !! * Control permutation of array indices
36#  include "dtasal_ftrans.h90"
37#  include "oce_ftrans.h90"
38#  include "dom_oce_ftrans.h90"
39
40   !! * Substitutions
41#  include "domzgr_substitute.h90"
42   !!----------------------------------------------------------------------
43   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
44   !! $Id$
45   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
46   !!----------------------------------------------------------------------
47CONTAINS
48
49   SUBROUTINE dta_sal( kt )
50      !!----------------------------------------------------------------------
51      !!                   ***  ROUTINE dta_sal  ***
52      !!       
53      !! ** Purpose :   Reads monthly salinity data
54      !!             
55      !! ** Method  : - Read on unit numsdt the monthly salinity data interpo-
56      !!                lated onto the model grid.
57      !!              - At each time step, a linear interpolation is applied
58      !!                between two monthly values.
59      !!----------------------------------------------------------------------
60      INTEGER, INTENT(in) ::   kt   ! ocean time step
61      !
62      INTEGER ::   ji, jj, jk, jl, jkk       ! local loop indicies
63      INTEGER ::   ik, ierr, 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) :: zsaldta         ! auxiliary array for interpolation
69      CHARACTER(len=100)       :: cn_dir          ! Root directory for location of ssr files
70      TYPE(FLD_N)              :: sn_sal
71      LOGICAL , SAVE           :: linit_sal = .FALSE.
72      !!
73      NAMELIST/namdta_sal/   cn_dir, sn_sal
74      !!----------------------------------------------------------------------
75     
76      ! 1. Initialization
77      ! -----------------------
78     
79      IF( kt == nit000 .AND. ( .NOT. linit_sal ) ) THEN
80       
81         !                         ! set file information
82         cn_dir = './'             ! directory in which the model is executed
83         ! ... default values (NB: frequency positive => hours, negative => months)
84         !            !   file    ! frequency ! variable ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   !
85         !            !   name    !  (hours)  !  name    !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      !
86         sn_sal = FLD_N( 'salinity',  -1.     ,'vosaline',  .false.   , .true.  ,  'monthly'  , ''       , ''         )
87
88         REWIND ( numnam )         ! read in namlist namdta_sal
89         READ( numnam, namdta_sal ) 
90
91         IF(lwp) THEN              ! control print
92            WRITE(numout,*)
93            WRITE(numout,*) 'dta_sal : Salinity Climatology '
94            WRITE(numout,*) '~~~~~~~ '
95         ENDIF
96
97                                   ! Allocate salinity data array
98                                ALLOCATE( s_dta(jpi,jpj,jpk)           , STAT=ierr  )
99         IF( ierr > 0              )   CALL ctl_stop( 'STOP', 'dta_sal: unable to allocate s_dta array' )
100                                   ! Allocate sf_tem structure
101                                ierr2 = 0
102                                ALLOCATE( sf_sal(1)                    , STAT=ierr0 )
103                                ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpk)  , STAT=ierr1 )
104         IF( sn_sal%ln_tint )   ALLOCATE( sf_sal(1)%fdta(jpi,jpj,jpk,2), STAT=ierr2 )
105         IF( ierr0+ierr1+ierr2 > 0 )   CALL ctl_stop( 'STOP', 'dta_sal: unable to allocate sf_sal structure' )
106         !                         ! fill sf_sal with sn_sal and control print
107         CALL fld_fill( sf_sal, (/ sn_sal /), cn_dir, 'dta_sal', 'Salinity data', 'namdta_sal' )
108         linit_sal = .TRUE.       
109      ENDIF
110     
111      ! 2. Read monthly file
112      ! -------------------
113     
114      CALL fld_read( kt, 1, sf_sal )
115
116      IF( lwp .AND. kt == nit000 ) THEN
117         WRITE(numout,*)
118         WRITE(numout,*) ' read Levitus salinity ok'
119         WRITE(numout,*)
120      ENDIF
121
122#if defined key_tradmp
123      IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN     !  ORCA_R2 configuration
124         !
125         ij0 = 101   ;   ij1 = 109
126         ii0 = 141   ;   ii1 = 155   
127         DO jj = mj0(ij0), mj1(ij1)                  ! Reduced salinity in the Alboran Sea
128            DO ji = mi0(ii0), mi1(ii1)
129               sf_sal(1)%fnow(ji,jj,13:13) = sf_sal(1)%fnow(ji,jj,13:13) - 0.15
130               sf_sal(1)%fnow(ji,jj,14:15) = sf_sal(1)%fnow(ji,jj,14:15) - 0.25
131               sf_sal(1)%fnow(ji,jj,16:17) = sf_sal(1)%fnow(ji,jj,16:17) - 0.30
132               sf_sal(1)%fnow(ji,jj,18:25) = sf_sal(1)%fnow(ji,jj,18:25) - 0.35
133            END DO
134         END DO
135         !
136         IF( nn_cla == 1 ) THEN 
137            !                                         ! New salinity profile at Gibraltar
138            il0 = 138   ;   il1 = 138   
139            ij0 = 101   ;   ij1 = 102
140            ii0 = 139   ;   ii1 = 139   
141            DO jl = mi0(il0), mi1(il1)
142               DO jj = mj0(ij0), mj1(ij1)
143                  DO ji = mi0(ii0), mi1(ii1)
144                        sf_sal(1)%fnow(ji,jj,:) = sf_sal(1)%fnow(jl,jj,:)
145                  END DO
146               END DO
147            END DO
148            !                                         ! New salinity profile at Bab el Mandeb
149            il0 = 164   ;   il1 = 164   
150            ij0 =  87   ;   ij1 =  88
151            ii0 = 161   ;   ii1 = 163   
152            DO jl = mi0(il0), mi1(il1)
153               DO jj = mj0(ij0), mj1(ij1)
154                  DO ji = mi0(ii0), mi1(ii1)
155                     sf_sal(1)%fnow(ji,jj,:) = sf_sal(1)%fnow(jl,jj,:)
156                  END DO
157               END DO
158            END DO
159            !
160         ENDIF
161            !
162      ENDIF
163#endif   
164       
165#if defined key_z_first
166      !! DCSE_NEMO: Beware! These arrays will not be conformable after permuting indices of t_dta
167      DO jk = 1, jpk
168         DO jj = 1, jpj
169            DO ji = 1, jpi
170               s_dta(ji,jj,jk) = sf_sal(1)%fnow(ji,jj,jk)
171            END DO
172         END DO
173      END DO
174#else
175      s_dta(:,:,:) = sf_sal(1)%fnow(:,:,:)
176#endif
177       
178      IF( ln_sco ) THEN
179         DO jj = 1, jpj                  ! interpolation of salinities
180            DO ji = 1, jpi
181               DO jk = 1, jpk
182                  zl=fsdept_0(ji,jj,jk)
183                  IF(zl < gdept_0(1)  ) zsaldta(jk) =  s_dta(ji,jj,1    ) 
184                  IF(zl > gdept_0(jpk)) zsaldta(jk) =  s_dta(ji,jj,jpkm1) 
185                  DO jkk = 1, jpkm1
186                     IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN
187                          zsaldta(jk) = s_dta(ji,jj,jkk)                                 &
188                                     &           + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk))      &
189                                     &                              *(s_dta(ji,jj,jkk+1) - s_dta(ji,jj,jkk))
190                     ENDIF
191                  END DO
192               END DO
193               DO jk = 1, jpkm1
194                  s_dta(ji,jj,jk) = zsaldta(jk) 
195               END DO
196               s_dta(ji,jj,jpk) = 0.0 
197            END DO
198         END DO
199           
200         IF( lwp .AND. kt==nn_it000 ) THEN
201            WRITE(numout,*)
202            WRITE(numout,*) ' Levitus salinity data interpolated to s-coordinate'
203            WRITE(numout,*)
204         ENDIF
205
206      ELSE
207         !                                  ! Mask
208         s_dta(:,:,:) = s_dta(:,:,:) * tmask(:,:,:)
209         s_dta(:,:,jpk) = 0.e0
210         IF( ln_zps ) THEN               ! z-coord. partial steps
211            DO jj = 1, jpj               ! interpolation of salinity at the last ocean level (i.e. the partial step)
212               DO ji = 1, jpi
213                  ik = mbkt(ji,jj)
214                  IF( ik > 1 ) THEN
215                     zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) )
216                     s_dta(ji,jj,ik) = (1.-zl) * s_dta(ji,jj,ik) + zl * s_dta(ji,jj,ik-1)
217                  ENDIF
218               END DO
219            END DO
220         ENDIF
221      ENDIF
222       
223      IF( lwp .AND. kt == nit000 ) THEN
224         WRITE(numout,*)' salinity Levitus '
225         WRITE(numout,*)
226         WRITE(numout,*)'  level = 1'
227         CALL prihre(s_dta(:,:,1),    jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
228         WRITE(numout,*)'  level = ',jpk/2
229         CALL prihre(s_dta(:,:,jpk/2),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)           
230         WRITE(numout,*) '  level = ',jpkm1
231         CALL prihre(s_dta(:,:,jpkm1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
232      ENDIF
233      !
234   END SUBROUTINE dta_sal
235
236#else
237   !!----------------------------------------------------------------------
238   !!   Default option:                                    NO salinity data
239   !!----------------------------------------------------------------------
240   LOGICAL , PUBLIC, PARAMETER ::   lk_dtasal = .FALSE.   !: salinity data flag
241CONTAINS
242   SUBROUTINE dta_sal( kt )        ! Empty routine
243      WRITE(*,*) 'dta_sal: You should not have seen this print! error?', kt
244   END SUBROUTINE dta_sal
245#endif
246   !!======================================================================
247END MODULE dtasal
Note: See TracBrowser for help on using the repository browser.