source: NEMO/branches/UKMO/NEMO_4.0_surge/src/OCE/DOM/dtatsd.F90 @ 11180

Last change on this file since 11180 was 11180, checked in by clne, 22 months ago

Initial commit of code for 2d (surge) work in NEMO4.
This is aiming to replicate the 3.6 version in branches/UKMO/dev_r5518_Surge_Modelling

File size: 13.5 KB
Line 
1MODULE dtatsd
2   !!======================================================================
3   !!                     ***  MODULE  dtatsd  ***
4   !! Ocean data  :  read ocean Temperature & Salinity Data from gridded 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   !!            3.4  ! 2010-11  (G. Madec, C. Ethe) Merge of dtatem and dtasal + remove CPP keys
12   !!----------------------------------------------------------------------
13
14   !!----------------------------------------------------------------------
15   !!   dta_tsd      : read and time interpolated ocean Temperature & Salinity Data
16   !!----------------------------------------------------------------------
17   USE oce             ! ocean dynamics and tracers
18   USE phycst          ! physical constants
19   USE dom_oce         ! ocean space and time domain
20   USE fldread         ! read input fields
21   !
22   USE in_out_manager  ! I/O manager
23   USE lib_mpp         ! MPP library
24
25   IMPLICIT NONE
26   PRIVATE
27
28   PUBLIC   dta_tsd_init   ! called by opa.F90
29   PUBLIC   dta_tsd        ! called by istate.F90 and tradmp.90
30
31   !                                  !!* namtsd  namelist : Temperature & Salinity Data *
32   LOGICAL , PUBLIC ::   ln_tsd_init   !: T & S data flag
33   LOGICAL , PUBLIC ::   ln_tsd_dmp    !: internal damping toward input data flag
34
35   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tsd   ! structure of input SST (file informations, fields read)
36
37   !!----------------------------------------------------------------------
38   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
39   !! $Id$
40   !! Software governed by the CeCILL license (see ./LICENSE)
41   !!----------------------------------------------------------------------
42CONTAINS
43
44   SUBROUTINE dta_tsd_init( ld_tradmp )
45      !!----------------------------------------------------------------------
46      !!                   ***  ROUTINE dta_tsd_init  ***
47      !!                   
48      !! ** Purpose :   initialisation of T & S input data
49      !!
50      !! ** Method  : - Read namtsd namelist
51      !!              - allocates T & S data structure
52      !!----------------------------------------------------------------------
53      LOGICAL, INTENT(in), OPTIONAL ::   ld_tradmp   ! force the initialization when tradp is used
54      !
55      INTEGER ::   ios, ierr0, ierr1, ierr2, ierr3   ! local integers
56      !!
57      CHARACTER(len=100)            ::   cn_dir          ! Root directory for location of ssr files
58      TYPE(FLD_N), DIMENSION( jpts) ::   slf_i           ! array of namelist informations on the fields to read
59      TYPE(FLD_N)                   ::   sn_tem, sn_sal
60      !!
61      NAMELIST/namtsd/   ln_tsd_init, ln_tsd_dmp, cn_dir, sn_tem, sn_sal
62      !!----------------------------------------------------------------------
63      !
64      !  Initialisation
65      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0
66      !
67      REWIND( numnam_ref )              ! Namelist namtsd in reference namelist :
68      READ  ( numnam_ref, namtsd, IOSTAT = ios, ERR = 901)
69901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtsd in reference namelist', lwp )
70      REWIND( numnam_cfg )              ! Namelist namtsd in configuration namelist : Parameters of the run
71      READ  ( numnam_cfg, namtsd, IOSTAT = ios, ERR = 902 )
72902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtsd in configuration namelist', lwp )
73      IF(lwm) WRITE ( numond, namtsd )
74
75      IF( PRESENT( ld_tradmp ) )   ln_tsd_dmp = .TRUE.     ! forces the initialization when tradmp is used
76     
77      IF(lwp) THEN                  ! control print
78         WRITE(numout,*)
79         WRITE(numout,*) 'dta_tsd_init : Temperature & Salinity data '
80         WRITE(numout,*) '~~~~~~~~~~~~ '
81         WRITE(numout,*) '   Namelist namtsd'
82         WRITE(numout,*) '      Initialisation of ocean T & S with T &S input data   ln_tsd_init = ', ln_tsd_init
83         WRITE(numout,*) '      damping of ocean T & S toward T &S input data        ln_tsd_dmp  = ', ln_tsd_dmp
84         WRITE(numout,*)
85         IF( .NOT.ln_tsd_init .AND. .NOT.ln_tsd_dmp ) THEN
86            WRITE(numout,*)
87            WRITE(numout,*) '   ===>>   T & S data not used'
88         ENDIF
89         IF( ln_2d ) WRITE(numout,*) '   2D ocean - ocean will be started at rest and T&S = arbitrary constants' 
90      ENDIF
91      !
92      IF( ln_rstart .AND. ln_tsd_init ) THEN
93         CALL ctl_warn( 'dta_tsd_init: ocean restart and T & S data intialisation, ',   &
94            &           'we keep the restart T & S values and set ln_tsd_init to FALSE' )
95         ln_tsd_init = .FALSE.
96      ENDIF
97      !
98      !                             ! allocate the arrays (if necessary)
99      IF( ln_tsd_init .OR. ln_tsd_dmp ) THEN
100         !
101         ALLOCATE( sf_tsd(jpts), STAT=ierr0 )
102         IF( ierr0 > 0 ) THEN
103            CALL ctl_stop( 'dta_tsd_init: unable to allocate sf_tsd structure' )   ;   RETURN
104         ENDIF
105         !
106                                ALLOCATE( sf_tsd(jp_tem)%fnow(jpi,jpj,jpk)   , STAT=ierr0 )
107         IF( sn_tem%ln_tint )   ALLOCATE( sf_tsd(jp_tem)%fdta(jpi,jpj,jpk,2) , STAT=ierr1 )
108                                ALLOCATE( sf_tsd(jp_sal)%fnow(jpi,jpj,jpk)   , STAT=ierr2 )
109         IF( sn_sal%ln_tint )   ALLOCATE( sf_tsd(jp_sal)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )
110         !
111         IF( ierr0 + ierr1 + ierr2 + ierr3 > 0 ) THEN
112            CALL ctl_stop( 'dta_tsd : unable to allocate T & S data arrays' )   ;   RETURN
113         ENDIF
114         !                         ! fill sf_tsd with sn_tem & sn_sal and control print
115         slf_i(jp_tem) = sn_tem   ;   slf_i(jp_sal) = sn_sal
116         CALL fld_fill( sf_tsd, slf_i, cn_dir, 'dta_tsd', 'Temperature & Salinity data', 'namtsd', no_print )
117         !
118      ENDIF
119      !
120   END SUBROUTINE dta_tsd_init
121
122
123   SUBROUTINE dta_tsd( kt, ptsd )
124      !!----------------------------------------------------------------------
125      !!                   ***  ROUTINE dta_tsd  ***
126      !!                   
127      !! ** Purpose :   provides T and S data at kt
128      !!
129      !! ** Method  : - call fldread routine
130      !!              - ORCA_R2: add some hand made alteration to read data 
131      !!              - 'key_orca_lev10' interpolates on 10 times more levels
132      !!              - s- or mixed z-s coordinate: vertical interpolation on model mesh
133      !!              - ln_tsd_dmp=F: deallocates the T-S data structure
134      !!                as T-S data are no are used
135      !!
136      !! ** Action  :   ptsd   T-S data on medl mesh and interpolated at time-step kt
137      !!----------------------------------------------------------------------
138      INTEGER                              , INTENT(in   ) ::   kt     ! ocean time-step
139      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   ptsd   ! T & S data
140      !
141      INTEGER ::   ji, jj, jk, jl, jkk   ! dummy loop indicies
142      INTEGER ::   ik, il0, il1, ii0, ii1, ij0, ij1   ! local integers
143      REAL(wp)::   zl, zi                             ! local scalars
144      REAL(wp), DIMENSION(jpk) ::  ztp, zsp   ! 1D workspace
145      !!----------------------------------------------------------------------
146      !
147      CALL fld_read( kt, 1, sf_tsd )      !==   read T & S data at kt time step   ==!
148      !
149      !
150!!gm  This should be removed from the code   ===>>>>  T & S files has to be changed
151      !
152      !                                   !==   ORCA_R2 configuration and T & S damping   ==!
153      IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN
154         IF( nn_cfg == 2 .AND. ln_tsd_dmp ) THEN    ! some hand made alterations
155            !
156            ij0 = 101   ;   ij1 = 109                       ! Reduced T & S in the Alboran Sea
157            ii0 = 141   ;   ii1 = 155
158            DO jj = mj0(ij0), mj1(ij1)
159               DO ji = mi0(ii0), mi1(ii1)
160                  sf_tsd(jp_tem)%fnow(ji,jj,13:13) = sf_tsd(jp_tem)%fnow(ji,jj,13:13) - 0.20_wp
161                  sf_tsd(jp_tem)%fnow(ji,jj,14:15) = sf_tsd(jp_tem)%fnow(ji,jj,14:15) - 0.35_wp
162                  sf_tsd(jp_tem)%fnow(ji,jj,16:25) = sf_tsd(jp_tem)%fnow(ji,jj,16:25) - 0.40_wp
163                  !
164                  sf_tsd(jp_sal)%fnow(ji,jj,13:13) = sf_tsd(jp_sal)%fnow(ji,jj,13:13) - 0.15_wp
165                  sf_tsd(jp_sal)%fnow(ji,jj,14:15) = sf_tsd(jp_sal)%fnow(ji,jj,14:15) - 0.25_wp
166                  sf_tsd(jp_sal)%fnow(ji,jj,16:17) = sf_tsd(jp_sal)%fnow(ji,jj,16:17) - 0.30_wp
167                  sf_tsd(jp_sal)%fnow(ji,jj,18:25) = sf_tsd(jp_sal)%fnow(ji,jj,18:25) - 0.35_wp
168               END DO
169            END DO
170            ij0 =  87   ;   ij1 =  96                          ! Reduced temperature in Red Sea
171            ii0 = 148   ;   ii1 = 160
172            sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 ) = 7.0_wp
173            sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5_wp
174            sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0_wp
175         ENDIF
176      ENDIF
177!!gm end
178      !
179      ptsd(:,:,:,jp_tem) = sf_tsd(jp_tem)%fnow(:,:,:)    ! NO mask
180      ptsd(:,:,:,jp_sal) = sf_tsd(jp_sal)%fnow(:,:,:) 
181      !
182      IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==!
183         !
184         IF( kt == nit000 .AND. lwp )THEN
185            WRITE(numout,*)
186            WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh'
187         ENDIF
188         !
189         DO jj = 1, jpj                         ! vertical interpolation of T & S
190            DO ji = 1, jpi
191               DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points
192                  zl = gdept_0(ji,jj,jk)
193                  IF(     zl < gdept_1d(1  ) ) THEN          ! above the first level of data
194                     ztp(jk) =  ptsd(ji,jj,1    ,jp_tem)
195                     zsp(jk) =  ptsd(ji,jj,1    ,jp_sal)
196                  ELSEIF( zl > gdept_1d(jpk) ) THEN          ! below the last level of data
197                     ztp(jk) =  ptsd(ji,jj,jpkm1,jp_tem)
198                     zsp(jk) =  ptsd(ji,jj,jpkm1,jp_sal)
199                  ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1
200                     DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1)
201                        IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN
202                           zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk))
203                           ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi 
204                           zsp(jk) = ptsd(ji,jj,jkk,jp_sal) + ( ptsd(ji,jj,jkk+1,jp_sal) - ptsd(ji,jj,jkk,jp_sal) ) * zi
205                        ENDIF
206                     END DO
207                  ENDIF
208               END DO
209               DO jk = 1, jpkm1
210                  ptsd(ji,jj,jk,jp_tem) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord
211                  ptsd(ji,jj,jk,jp_sal) = zsp(jk) * tmask(ji,jj,jk)
212               END DO
213               ptsd(ji,jj,jpk,jp_tem) = 0._wp
214               ptsd(ji,jj,jpk,jp_sal) = 0._wp
215            END DO
216         END DO
217         !
218      ELSE                                !==   z- or zps- coordinate   ==!
219         !                             
220         ptsd(:,:,:,jp_tem) = ptsd(:,:,:,jp_tem) * tmask(:,:,:)    ! Mask
221         ptsd(:,:,:,jp_sal) = ptsd(:,:,:,jp_sal) * tmask(:,:,:)
222         !
223         IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level
224            DO jj = 1, jpj
225               DO ji = 1, jpi
226                  ik = mbkt(ji,jj) 
227                  IF( ik > 1 ) THEN
228                     zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
229                     ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik-1,jp_tem)
230                     ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik-1,jp_sal)
231                  ENDIF
232                  ik = mikt(ji,jj)
233                  IF( ik > 1 ) THEN
234                     zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 
235                     ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik+1,jp_tem)
236                     ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik+1,jp_sal)
237                  END IF
238               END DO
239            END DO
240         ENDIF
241         !
242      ENDIF
243      !
244      IF( .NOT.ln_tsd_dmp ) THEN                   !==   deallocate T & S structure   ==!
245         !                                              (data used only for initialisation)
246         IF(lwp) WRITE(numout,*) 'dta_tsd: deallocte T & S arrays as they are only use to initialize the run'
247                                        DEALLOCATE( sf_tsd(jp_tem)%fnow )     ! T arrays in the structure
248         IF( sf_tsd(jp_tem)%ln_tint )   DEALLOCATE( sf_tsd(jp_tem)%fdta )
249                                        DEALLOCATE( sf_tsd(jp_sal)%fnow )     ! S arrays in the structure
250         IF( sf_tsd(jp_sal)%ln_tint )   DEALLOCATE( sf_tsd(jp_sal)%fdta )
251                                        DEALLOCATE( sf_tsd              )     ! the structure itself
252      ENDIF
253      !
254   END SUBROUTINE dta_tsd
255
256   !!======================================================================
257END MODULE dtatsd
Note: See TracBrowser for help on using the repository browser.