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

Last change on this file since 4409 was 4409, checked in by trackstand2, 10 years ago

Changes to allow jpk to be modified to deepest level within a subdomain. jpkorig holds original value.

  • 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
[4409]98                                ALLOCATE( s_dta(jpi,jpj,jpkorig)           , STAT=ierr  )
[2715]99         IF( ierr > 0              )   CALL ctl_stop( 'STOP', 'dta_sal: unable to allocate s_dta array' )
100                                   ! Allocate sf_tem structure
101                                ierr2 = 0
[4409]102                                ALLOCATE( sf_sal(1)                        , STAT=ierr0 )
103                                ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpkorig)  , STAT=ierr1 )
104         IF( sn_sal%ln_tint )   ALLOCATE( sf_sal(1)%fdta(jpi,jpj,jpkorig,2), STAT=ierr2 )
[2715]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.