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

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DTA/dtasal.F90 @ 2392

Last change on this file since 2392 was 2392, checked in by gm, 13 years ago

v3.3beta: Cross Land Advection (ticket #127) full rewriting + MPP bug corrections

  • Property svn:keywords set to Id
File size: 10.9 KB
RevLine 
[3]1MODULE dtasal
2   !!======================================================================
3   !!                     ***  MODULE  dtasal  ***
4   !! Ocean data  :  read ocean salinity data from monthly atlas data
5   !!=====================================================================
[2392]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
[1951]20   USE fldread         ! read input fields
[3]21   USE in_out_manager  ! I/O manager
[473]22   USE phycst          ! physical constants
23#if defined key_orca_lev10
24   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
25#endif
[3]26
27   IMPLICIT NONE
28   PRIVATE
29
[2392]30   PUBLIC   dta_sal   ! called by step.F90 and inidta.F90
[3]31   
[16]32   LOGICAL , PUBLIC, PARAMETER ::   lk_dtasal = .TRUE.    !: salinity data flag
[1951]33   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   s_dta    !: salinity data at given time-step
[3]34
[1951]35   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sal       ! structure of input SST (file informations, fields read)
[3]36
37   !! * Substitutions
38#  include "domzgr_substitute.h90"
39   !!----------------------------------------------------------------------
[2287]40   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
[1152]41   !! $Id$
[2392]42   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
[3]43   !!----------------------------------------------------------------------
44CONTAINS
45
46   SUBROUTINE dta_sal( kt )
[1951]47      !!----------------------------------------------------------------------
48      !!                   ***  ROUTINE dta_sal  ***
49      !!       
50      !! ** Purpose :   Reads monthly salinity data
51      !!             
52      !! ** Method  : - Read on unit numsdt the monthly salinity data interpo-
[2392]53      !!                lated onto the model grid.
[1951]54      !!              - At each time step, a linear interpolation is applied
[2392]55      !!                between two monthly values.
[1951]56      !!----------------------------------------------------------------------
57      INTEGER, INTENT(in) ::   kt             ! ocean time step
[2392]58      !
[1951]59      INTEGER ::   ji, jj, jk, jl, jkk            ! dummy loop indicies
[2104]60      INTEGER ::   ik, ierror                     ! temporary integers
[1951]61#if defined key_tradmp
62      INTEGER ::   il0, il1, ii0, ii1, ij0, ij1   ! temporary integers
63#endif
[2104]64      REAL(wp)::   zl
[473]65#if defined key_orca_lev10
[1951]66      INTEGER ::   ikr, ikw, ikt, jjk 
67      REAL(wp)::   zfac
[434]68#endif
[2104]69      REAL(wp), DIMENSION(jpk) :: zsaldta         ! auxiliary array for interpolation
[1951]70      CHARACTER(len=100)       :: cn_dir          ! Root directory for location of ssr files
71      TYPE(FLD_N)              :: sn_sal
72      LOGICAL , SAVE           :: linit_sal = .FALSE.
[2392]73      !!
74      NAMELIST/namdta_sal/   cn_dir, sn_sal
[1951]75      !!----------------------------------------------------------------------
[473]76     
[1951]77      ! 1. Initialization
78      ! -----------------------
[473]79     
[1951]80      IF( kt == nit000 .AND. ( .NOT. linit_sal ) ) THEN
[473]81       
[1951]82         !                         ! set file information
83         cn_dir = './'             ! directory in which the model is executed
84         ! ... default values (NB: frequency positive => hours, negative => months)
[2392]85         !            !   file    ! frequency ! variable ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   !
86         !            !   name    !  (hours)  !  name    !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      !
87         sn_sal = FLD_N( 'salinity',  -1.     ,'vosaline',  .false.   , .true.  ,  'monthly'  , ''       , ''         )
[1951]88
[2392]89         REWIND ( numnam )         ! read in namlist namdta_sal
[1951]90         READ( numnam, namdta_sal ) 
91
92         IF(lwp) THEN              ! control print
93            WRITE(numout,*)
94            WRITE(numout,*) 'dta_sal : Salinity Climatology '
95            WRITE(numout,*) '~~~~~~~ '
96         ENDIF
97         ALLOCATE( sf_sal(1), STAT=ierror )
98         IF( ierror > 0 ) THEN
99             CALL ctl_stop( 'dta_sal: unable to allocate sf_sal structure' )   ;   RETURN
100         ENDIF
[2236]101
[1951]102#if defined key_orca_lev10
[2236]103                                ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpkdta)   )
104         IF( sn_sal%ln_tint )   ALLOCATE( sf_sal(1)%fdta(jpi,jpj,jpkdta,2) )
[1951]105#else
[2236]106                                ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpk)   )
107         IF( sn_sal%ln_tint )   ALLOCATE( sf_sal(1)%fdta(jpi,jpj,jpk,2) )
[1951]108#endif
[2392]109         !                         ! fill sf_sal with sn_sal and control print
[1951]110         CALL fld_fill( sf_sal, (/ sn_sal /), cn_dir, 'dta_sal', 'Salinity data', 'namdta_sal' )
111         linit_sal = .TRUE.       
112      ENDIF
[473]113     
[1951]114      ! 2. Read monthly file
115      ! -------------------
[473]116     
[1951]117      CALL fld_read( kt, 1, sf_sal )
118
[2236]119      IF( lwp .AND. kt == nit000 ) THEN
[1951]120         WRITE(numout,*)
121         WRITE(numout,*) ' read Levitus salinity ok'
122         WRITE(numout,*)
123      ENDIF
124
[434]125#if defined key_tradmp
[2392]126      IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN     !  ORCA_R2 configuration
127         !
[1951]128         ij0 = 101   ;   ij1 = 109
129         ii0 = 141   ;   ii1 = 155   
130         DO jj = mj0(ij0), mj1(ij1)                  ! Reduced salinity in the Alboran Sea
131            DO ji = mi0(ii0), mi1(ii1)
132               sf_sal(1)%fnow(ji,jj,13:13) = sf_sal(1)%fnow(ji,jj,13:13) - 0.15
133               sf_sal(1)%fnow(ji,jj,14:15) = sf_sal(1)%fnow(ji,jj,14:15) - 0.25
134               sf_sal(1)%fnow(ji,jj,16:17) = sf_sal(1)%fnow(ji,jj,16:17) - 0.30
135               sf_sal(1)%fnow(ji,jj,18:25) = sf_sal(1)%fnow(ji,jj,18:25) - 0.35
136            END DO
137         END DO
[2392]138         !
139         IF( nn_cla == 1 ) THEN 
[1951]140            !                                         ! New salinity profile at Gibraltar
141            il0 = 138   ;   il1 = 138   
142            ij0 = 101   ;   ij1 = 102
143            ii0 = 139   ;   ii1 = 139   
144            DO jl = mi0(il0), mi1(il1)
145               DO jj = mj0(ij0), mj1(ij1)
146                  DO ji = mi0(ii0), mi1(ii1)
147                        sf_sal(1)%fnow(ji,jj,:) = sf_sal(1)%fnow(jl,jj,:)
148                  END DO
149               END DO
150            END DO
151            !                                         ! New salinity profile at Bab el Mandeb
152            il0 = 164   ;   il1 = 164   
153            ij0 =  87   ;   ij1 =  88
154            ii0 = 161   ;   ii1 = 163   
155            DO jl = mi0(il0), mi1(il1)
156               DO jj = mj0(ij0), mj1(ij1)
157                  DO ji = mi0(ii0), mi1(ii1)
158                     sf_sal(1)%fnow(ji,jj,:) = sf_sal(1)%fnow(jl,jj,:)
159                  END DO
160               END DO
161            END DO
162            !
163         ENDIF
164            !
165      ENDIF
[459]166#endif   
[473]167       
168#if defined key_orca_lev10
[1951]169      DO jjk = 1, 5
170         s_dta(:,:,jjk) = sf_sal(1)%fnow(:,:,1)
171      ENDDO
172      DO jk = 1, jpk-20,10
173         ikr =  INT(jk/10) + 1
174         ikw =  (ikr-1) *10 + 1
175         ikt =  ikw + 5
176         DO jjk=ikt,ikt+9
177            zfac = ( gdept_0(jjk   ) - gdepw_0(ikt) ) / ( gdepw_0(ikt+10) - gdepw_0(ikt) )
178            s_dta(:,:,jjk) = sf_sal(1)%fnow(:,:,ikr) + ( sf_sal(1)%fnow(:,:,ikr+1) - sf_sal(1)%fnow(:,:,ikr) ) * zfac
179         END DO
180      END DO
181      DO jjk = jpk-5, jpk
182         s_dta(:,:,jjk) = sf_sal(1)%fnow(:,:,jpkdta-1)
183      END DO
184      ! fill the overlap areas
185      CALL lbc_lnk (s_dta(:,:,:),'Z',-999.,'no0')       
186#else
187      s_dta(:,:,:)=sf_sal(1)%fnow(:,:,:)
[473]188#endif
189       
[1951]190      IF( ln_sco ) THEN
191         DO jj = 1, jpj                  ! interpolation of salinites
192            DO ji = 1, jpi
193               DO jk = 1, jpk
194                  zl=fsdept_0(ji,jj,jk)
195                  IF(zl < gdept_0(1)  ) zsaldta(jk) =  s_dta(ji,jj,1    ) 
196                  IF(zl > gdept_0(jpk)) zsaldta(jk) =  s_dta(ji,jj,jpkm1) 
197                  DO jkk = 1, jpkm1
198                     IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN
199                          zsaldta(jk) = s_dta(ji,jj,jkk)                                 &
200                                     &           + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk))      &
201                                     &                              *(s_dta(ji,jj,jkk+1) - s_dta(ji,jj,jkk))
202                     ENDIF
203                  END DO
204               END DO
205               DO jk = 1, jpkm1
206                  s_dta(ji,jj,jk) = zsaldta(jk) 
207               END DO
208               s_dta(ji,jj,jpk) = 0.0 
209            END DO
210         END DO
[473]211           
[1951]212         IF( lwp .AND. kt==nn_it000 ) THEN
213            WRITE(numout,*)
214            WRITE(numout,*) ' Levitus salinity data interpolated to s-coordinate'
215            WRITE(numout,*)
216         ENDIF
217
218      ELSE
219         !                                  ! Mask
220         s_dta(:,:,:) = s_dta(:,:,:) * tmask(:,:,:)
[2392]221         s_dta(:,:,jpk) = 0.e0
[1951]222         IF( ln_zps ) THEN               ! z-coord. partial steps
223            DO jj = 1, jpj               ! interpolation of salinity at the last ocean level (i.e. the partial step)
224               DO ji = 1, jpi
225                  ik = mbathy(ji,jj) - 1
226                  IF( ik > 2 ) THEN
227                     zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) )
228                     s_dta(ji,jj,ik) = (1.-zl) * s_dta(ji,jj,ik) + zl * s_dta(ji,jj,ik-1)
229                  ENDIF
230               END DO
231            END DO
232         ENDIF
233      ENDIF
[473]234       
[2236]235      IF( lwp .AND. kt == nit000 ) THEN
[1951]236         WRITE(numout,*)' salinity Levitus '
237         WRITE(numout,*)
238         WRITE(numout,*)'  level = 1'
239         CALL prihre(s_dta(:,:,1),    jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
240         WRITE(numout,*)'  level = ',jpk/2
241         CALL prihre(s_dta(:,:,jpk/2),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)           
242         WRITE(numout,*) '  level = ',jpkm1
243         CALL prihre(s_dta(:,:,jpkm1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
244      ENDIF
[2392]245      !
[3]246   END SUBROUTINE dta_sal
247
248#else
249   !!----------------------------------------------------------------------
250   !!   Default option:                                    NO salinity data
251   !!----------------------------------------------------------------------
[16]252   LOGICAL , PUBLIC, PARAMETER ::   lk_dtasal = .FALSE.   !: salinity data flag
[3]253CONTAINS
254   SUBROUTINE dta_sal( kt )        ! Empty routine
[16]255      WRITE(*,*) 'dta_sal: You should not have seen this print! error?', kt
[3]256   END SUBROUTINE dta_sal
257#endif
258   !!======================================================================
259END MODULE dtasal
Note: See TracBrowser for help on using the repository browser.