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
RevLine 
[3]1MODULE dtasal
2   !!======================================================================
3   !!                     ***  MODULE  dtasal  ***
4   !! Ocean data  :  read ocean salinity data from monthly atlas data
5   !!=====================================================================
[2528]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   !!----------------------------------------------------------------------
[3]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
[2715]20   USE phycst          ! physical constants
[2528]21   USE fldread         ! read input fields
[3]22   USE in_out_manager  ! I/O manager
[2715]23   USE lib_mpp         ! MPP library
[3]24
25   IMPLICIT NONE
26   PRIVATE
27
[2715]28   PUBLIC   dta_sal    ! called by step.F90 and inidta.F90
[3]29
[2715]30   LOGICAL , PUBLIC, PARAMETER                     ::   lk_dtasal = .TRUE. !: salinity data flag
31   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) ::   s_dta              !: salinity data at given time-step
[3]32
[2715]33   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sal   ! structure of input SST (file informations, fields read)
34
[3211]35   !! * Control permutation of array indices
36#  include "dtasal_ftrans.h90"
37#  include "oce_ftrans.h90"
38#  include "dom_oce_ftrans.h90"
39
[3]40   !! * Substitutions
41#  include "domzgr_substitute.h90"
42   !!----------------------------------------------------------------------
[2715]43   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
[1152]44   !! $Id$
[2528]45   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
[3]46   !!----------------------------------------------------------------------
47CONTAINS
48
49   SUBROUTINE dta_sal( kt )
[2528]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      !!----------------------------------------------------------------------
[2715]60      INTEGER, INTENT(in) ::   kt   ! ocean time step
[2528]61      !
[2715]62      INTEGER ::   ji, jj, jk, jl, jkk       ! local loop indicies
63      INTEGER ::   ik, ierr, ierr0, ierr1, ierr2   ! local integers
[2528]64#if defined key_tradmp
[2715]65      INTEGER ::   il0, il1, ii0, ii1, ij0, ij1   ! local integers
[434]66#endif
[2528]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      !!----------------------------------------------------------------------
[473]75     
[2528]76      ! 1. Initialization
77      ! -----------------------
[473]78     
[2528]79      IF( kt == nit000 .AND. ( .NOT. linit_sal ) ) THEN
[473]80       
[2528]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
[2715]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' )
[2528]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
[473]110     
[2528]111      ! 2. Read monthly file
112      ! -------------------
[473]113     
[2528]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
[434]122#if defined key_tradmp
[2528]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
[459]163#endif   
[473]164       
[3211]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
[473]177       
[2528]178      IF( ln_sco ) THEN
[3211]179         DO jj = 1, jpj                  ! interpolation of salinities
[2528]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
[473]199           
[2528]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
[473]222       
[2528]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      !
[3]234   END SUBROUTINE dta_sal
235
236#else
237   !!----------------------------------------------------------------------
238   !!   Default option:                                    NO salinity data
239   !!----------------------------------------------------------------------
[16]240   LOGICAL , PUBLIC, PARAMETER ::   lk_dtasal = .FALSE.   !: salinity data flag
[3]241CONTAINS
242   SUBROUTINE dta_sal( kt )        ! Empty routine
[16]243      WRITE(*,*) 'dta_sal: You should not have seen this print! error?', kt
[3]244   END SUBROUTINE dta_sal
245#endif
246   !!======================================================================
247END MODULE dtasal
Note: See TracBrowser for help on using the repository browser.