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.
dtatsd.F90 in branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90 @ 11101

Last change on this file since 11101 was 11101, checked in by frrh, 5 years ago

Merge changes from Met Office GMED ticket 450 to reduce unnecessary
text output from NEMO.
This output, which is typically not switchable, is rarely of interest
in normal (non-debugging) runs and simply redunantley consumes extra
file space.
Further, the presence of this text output has been shown to
significantly degrade performance of models which are run during
Met Office HPC RAID (disk) checks.
The new code introduces switches which are configurable via the
changes made in the associated Met Office MOCI ticket 399.
File size: 16.0 KB
RevLine 
[3132]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 + suppression of 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 dom_oce         ! ocean space and time domain
19   USE fldread         ! read input fields
20   USE in_out_manager  ! I/O manager
21   USE phycst          ! physical constants
22   USE lib_mpp         ! MPP library
[3186]23   USE wrk_nemo        ! Memory allocation
[3162]24   USE timing          ! Timing
[3132]25
26   IMPLICIT NONE
27   PRIVATE
28
29   PUBLIC   dta_tsd_init   ! called by opa.F90
30   PUBLIC   dta_tsd        ! called by istate.F90 and tradmp.90
31
[4147]32   LOGICAL , PUBLIC ::   ln_tsd_init      !: T & S data flag
33   LOGICAL , PUBLIC ::   ln_tsd_tradmp    !: internal damping toward input data flag
[3132]34
35   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tsd   ! structure of input SST (file informations, fields read)
36
37   !! * Substitutions
38#  include "domzgr_substitute.h90"
39   !!----------------------------------------------------------------------
40   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
[6486]41   !! $Id$
[3132]42   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
43   !!----------------------------------------------------------------------
44CONTAINS
45
46   SUBROUTINE dta_tsd_init( ld_tradmp )
47      !!----------------------------------------------------------------------
48      !!                   ***  ROUTINE dta_tsd_init  ***
49      !!                   
50      !! ** Purpose :   initialisation of T & S input data
51      !!
52      !! ** Method  : - Read namtsd namelist
53      !!              - allocates T & S data structure
54      !!----------------------------------------------------------------------
55      LOGICAL, INTENT(in), OPTIONAL ::   ld_tradmp   ! force the initialization when tradp is used
56      !
57      INTEGER ::   ierr0, ierr1, ierr2, ierr3   ! temporary integers
58      !
59      CHARACTER(len=100)            ::   cn_dir          ! Root directory for location of ssr files
60      TYPE(FLD_N), DIMENSION( jpts) ::   slf_i           ! array of namelist informations on the fields to read
61      TYPE(FLD_N)                   ::   sn_tem, sn_sal
62      !!
63      NAMELIST/namtsd/   ln_tsd_init, ln_tsd_tradmp, cn_dir, sn_tem, sn_sal
[4147]64      INTEGER  ::   ios
[3132]65      !!----------------------------------------------------------------------
[3162]66      !
67      IF( nn_timing == 1 )  CALL timing_start('dta_tsd_init')
68      !
[3266]69      !  Initialisation
70      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0
71      !
[4147]72      REWIND( numnam_ref )              ! Namelist namtsd in reference namelist :
73      READ  ( numnam_ref, namtsd, IOSTAT = ios, ERR = 901)
74901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtsd in reference namelist', lwp )
[3132]75
[4147]76      REWIND( numnam_cfg )              ! Namelist namtsd in configuration namelist : Parameters of the run
77      READ  ( numnam_cfg, namtsd, IOSTAT = ios, ERR = 902 )
78902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtsd in configuration namelist', lwp )
[11101]79      IF(lwm .AND. nprint > 2) WRITE ( numond, namtsd )
[3132]80
81      IF( PRESENT( ld_tradmp ) )   ln_tsd_tradmp = .TRUE.     ! forces the initialization when tradmp is used
82     
83      IF(lwp) THEN                  ! control print
84         WRITE(numout,*)
85         WRITE(numout,*) 'dta_tsd_init : Temperature & Salinity data '
86         WRITE(numout,*) '~~~~~~~~~~~~ '
87         WRITE(numout,*) '   Namelist namtsd'
88         WRITE(numout,*) '      Initialisation of ocean T & S with T &S input data   ln_tsd_init   = ', ln_tsd_init
89         WRITE(numout,*) '      damping of ocean T & S toward T &S input data        ln_tsd_tradmp = ', ln_tsd_tradmp
90         WRITE(numout,*)
91         IF( .NOT.ln_tsd_init .AND. .NOT.ln_tsd_tradmp ) THEN
92            WRITE(numout,*)
93            WRITE(numout,*) '   T & S data not used'
94         ENDIF
[11101]95         IF(lflush) CALL flush(numout)
[3132]96      ENDIF
97      !
98      IF( ln_rstart .AND. ln_tsd_init ) THEN
99         CALL ctl_warn( 'dta_tsd_init: ocean restart and T & S data intialisation, ',   &
100            &           'we keep the restart T & S values and set ln_tsd_init to FALSE' )
101         ln_tsd_init = .FALSE.
102      ENDIF
103      !
104      !                             ! allocate the arrays (if necessary)
105      IF(  ln_tsd_init .OR. ln_tsd_tradmp  ) THEN
106         !
107         ALLOCATE( sf_tsd(jpts), STAT=ierr0 )
108         IF( ierr0 > 0 ) THEN
109            CALL ctl_stop( 'dta_tsd_init: unable to allocate sf_tsd structure' )   ;   RETURN
110         ENDIF
111         !
112                                ALLOCATE( sf_tsd(jp_tem)%fnow(jpi,jpj,jpk)   , STAT=ierr0 )
113         IF( sn_tem%ln_tint )   ALLOCATE( sf_tsd(jp_tem)%fdta(jpi,jpj,jpk,2) , STAT=ierr1 )
114                                ALLOCATE( sf_tsd(jp_sal)%fnow(jpi,jpj,jpk)   , STAT=ierr2 )
115         IF( sn_sal%ln_tint )   ALLOCATE( sf_tsd(jp_sal)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )
116         !
117         IF( ierr0 + ierr1 + ierr2 + ierr3 > 0 ) THEN
118            CALL ctl_stop( 'dta_tsd : unable to allocate T & S data arrays' )   ;   RETURN
119         ENDIF
120         !                         ! fill sf_tsd with sn_tem & sn_sal and control print
121         slf_i(jp_tem) = sn_tem   ;   slf_i(jp_sal) = sn_sal
122         CALL fld_fill( sf_tsd, slf_i, cn_dir, 'dta_tsd', 'Temperature & Salinity data', 'namtsd' )
123         !
124      ENDIF
125      !
[3162]126      IF( nn_timing == 1 )  CALL timing_stop('dta_tsd_init')
127      !
[3132]128   END SUBROUTINE dta_tsd_init
129
130
131   SUBROUTINE dta_tsd( kt, ptsd )
132      !!----------------------------------------------------------------------
133      !!                   ***  ROUTINE dta_tsd  ***
134      !!                   
135      !! ** Purpose :   provides T and S data at kt
136      !!
137      !! ** Method  : - call fldread routine
138      !!              - ORCA_R2: add some hand made alteration to read data 
139      !!              - 'key_orca_lev10' interpolates on 10 times more levels
140      !!              - s- or mixed z-s coordinate: vertical interpolation on model mesh
141      !!              - ln_tsd_tradmp=F: deallocates the T-S data structure
142      !!                as T-S data are no are used
143      !!
144      !! ** Action  :   ptsd   T-S data on medl mesh and interpolated at time-step kt
145      !!----------------------------------------------------------------------
146      INTEGER                              , INTENT(in   ) ::   kt     ! ocean time-step
147      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   ptsd   ! T & S data
148      !
149      INTEGER ::   ji, jj, jk, jl, jkk   ! dummy loop indicies
150      INTEGER ::   ik, il0, il1, ii0, ii1, ij0, ij1   ! local integers
151      REAL(wp)::   zl, zi
[3162]152      REAL(wp), POINTER, DIMENSION(:) ::  ztp, zsp   ! 1D workspace
[3132]153      !!----------------------------------------------------------------------
154      !
[3162]155      IF( nn_timing == 1 )  CALL timing_start('dta_tsd')
156      !
[3132]157      CALL fld_read( kt, 1, sf_tsd )      !==   read T & S data at kt time step   ==!
158      !
159      !
160      !                                   !==   ORCA_R2 configuration and T & S damping   ==!
161      IF( cp_cfg == "orca" .AND. jp_cfg == 2 .AND. ln_tsd_tradmp ) THEN    ! some hand made alterations
162         !
163         ij0 = 101   ;   ij1 = 109                       ! Reduced T & S in the Alboran Sea
164         ii0 = 141   ;   ii1 = 155
165         DO jj = mj0(ij0), mj1(ij1)
166            DO ji = mi0(ii0), mi1(ii1)
167               sf_tsd(jp_tem)%fnow(ji,jj,13:13) = sf_tsd(jp_tem)%fnow(ji,jj,13:13) - 0.20_wp
168               sf_tsd(jp_tem)%fnow(ji,jj,14:15) = sf_tsd(jp_tem)%fnow(ji,jj,14:15) - 0.35_wp
169               sf_tsd(jp_tem)%fnow(ji,jj,16:25) = sf_tsd(jp_tem)%fnow(ji,jj,16:25) - 0.40_wp
170               !
171               sf_tsd(jp_sal)%fnow(ji,jj,13:13) = sf_tsd(jp_sal)%fnow(ji,jj,13:13) - 0.15_wp
172               sf_tsd(jp_sal)%fnow(ji,jj,14:15) = sf_tsd(jp_sal)%fnow(ji,jj,14:15) - 0.25_wp
173               sf_tsd(jp_sal)%fnow(ji,jj,16:17) = sf_tsd(jp_sal)%fnow(ji,jj,16:17) - 0.30_wp
174               sf_tsd(jp_sal)%fnow(ji,jj,18:25) = sf_tsd(jp_sal)%fnow(ji,jj,18:25) - 0.35_wp
175            END DO
176         END DO
177         IF( nn_cla == 1 ) THEN                          ! Cross Land advection
178            il0 = 138   ;   il1 = 138                          ! set T & S profile at Gibraltar Strait
179            ij0 = 101   ;   ij1 = 102
180            ii0 = 139   ;   ii1 = 139
181            DO jl = mi0(il0), mi1(il1)
182               DO jj = mj0(ij0), mj1(ij1)
183                  DO ji = mi0(ii0), mi1(ii1)
184                     sf_tsd(jp_tem)%fnow(ji,jj,:) = sf_tsd(jp_tem)%fnow(jl,jj,:)
185                     sf_tsd(jp_sal)%fnow(ji,jj,:) = sf_tsd(jp_sal)%fnow(jl,jj,:)
186                  END DO
187               END DO
188            END DO
189            il0 = 164   ;   il1 = 164                          ! set T & S profile at Bab el Mandeb Strait
190            ij0 =  87   ;   ij1 =  88
191            ii0 = 161   ;   ii1 = 163
192            DO jl = mi0(il0), mi1(il1)
193               DO jj = mj0(ij0), mj1(ij1)
194                  DO ji = mi0(ii0), mi1(ii1)
195                     sf_tsd(jp_tem)%fnow(ji,jj,:) = sf_tsd(jp_tem)%fnow(jl,jj,:)
196                     sf_tsd(jp_sal)%fnow(ji,jj,:) = sf_tsd(jp_sal)%fnow(jl,jj,:)
197                  END DO
198               END DO
199            END DO
200         ELSE                                            ! No Cross Land advection
201            ij0 =  87   ;   ij1 =  96                          ! Reduced temperature in Red Sea
202            ii0 = 148   ;   ii1 = 160
203            sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 ) = 7.0_wp
204            sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5_wp
205            sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0_wp
206         ENDIF
207      ENDIF
208      !
209      ptsd(:,:,:,jp_tem) = sf_tsd(jp_tem)%fnow(:,:,:)    ! NO mask
210      ptsd(:,:,:,jp_sal) = sf_tsd(jp_sal)%fnow(:,:,:) 
211      !
212      IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==!
213         !
[3162]214         CALL wrk_alloc( jpk, ztp, zsp )
215         !
[3132]216         IF( kt == nit000 .AND. lwp )THEN
217            WRITE(numout,*)
218            WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh'
[11101]219            IF(lflush) CALL flush(numout)
[3132]220         ENDIF
221         !
222         DO jj = 1, jpj                         ! vertical interpolation of T & S
223            DO ji = 1, jpi
224               DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points
[4292]225                  zl = gdept_0(ji,jj,jk)
226                  IF(     zl < gdept_1d(1  ) ) THEN          ! above the first level of data
[3132]227                     ztp(jk) =  ptsd(ji,jj,1    ,jp_tem)
228                     zsp(jk) =  ptsd(ji,jj,1    ,jp_sal)
[4292]229                  ELSEIF( zl > gdept_1d(jpk) ) THEN          ! below the last level of data
[3132]230                     ztp(jk) =  ptsd(ji,jj,jpkm1,jp_tem)
231                     zsp(jk) =  ptsd(ji,jj,jpkm1,jp_sal)
232                  ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1
233                     DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1)
[4292]234                        IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN
235                           zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk))
[3132]236                           ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi 
237                           zsp(jk) = ptsd(ji,jj,jkk,jp_sal) + ( ptsd(ji,jj,jkk+1,jp_sal) - ptsd(ji,jj,jkk,jp_sal) ) * zi
238                        ENDIF
239                     END DO
240                  ENDIF
241               END DO
242               DO jk = 1, jpkm1
243                  ptsd(ji,jj,jk,jp_tem) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord
244                  ptsd(ji,jj,jk,jp_sal) = zsp(jk) * tmask(ji,jj,jk)
245               END DO
246               ptsd(ji,jj,jpk,jp_tem) = 0._wp
247               ptsd(ji,jj,jpk,jp_sal) = 0._wp
248            END DO
249         END DO
250         !
[3162]251         CALL wrk_dealloc( jpk, ztp, zsp )
252         !
[3132]253      ELSE                                !==   z- or zps- coordinate   ==!
254         !                             
255         ptsd(:,:,:,jp_tem) = ptsd(:,:,:,jp_tem) * tmask(:,:,:)    ! Mask
256         ptsd(:,:,:,jp_sal) = ptsd(:,:,:,jp_sal) * tmask(:,:,:)
257         !
258         IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level
259            DO jj = 1, jpj
260               DO ji = 1, jpi
261                  ik = mbkt(ji,jj) 
262                  IF( ik > 1 ) THEN
[4292]263                     zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
[3132]264                     ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik-1,jp_tem)
265                     ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik-1,jp_sal)
266                  ENDIF
[4990]267                  ik = mikt(ji,jj)
268                  IF( ik > 1 ) THEN
269                     zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 
270                     ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik+1,jp_tem)
271                     ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik+1,jp_sal)
272                  END IF
[3132]273               END DO
274            END DO
275         ENDIF
276         !
277      ENDIF
278      !
[11101]279      IF( lwp .AND. kt == nit000 .AND. nprint > 1) THEN
[3132]280         WRITE(numout,*) ' temperature Levitus '
281         WRITE(numout,*)
282         WRITE(numout,*)'  level = 1'
283         CALL prihre( ptsd(:,:,1    ,jp_tem), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
284         WRITE(numout,*)'  level = ', jpk/2
285         CALL prihre( ptsd(:,:,jpk/2,jp_tem), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
286         WRITE(numout,*)'  level = ', jpkm1
287         CALL prihre( ptsd(:,:,jpkm1,jp_tem), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
288         WRITE(numout,*)
289         WRITE(numout,*) ' salinity Levitus '
290         WRITE(numout,*)
291         WRITE(numout,*)'  level = 1'
292         CALL prihre( ptsd(:,:,1    ,jp_sal), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
293         WRITE(numout,*)'  level = ', jpk/2
294         CALL prihre( ptsd(:,:,jpk/2,jp_sal), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
295         WRITE(numout,*)'  level = ', jpkm1
296         CALL prihre( ptsd(:,:,jpkm1,jp_sal), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
297         WRITE(numout,*)
[11101]298         IF(lflush) CALL flush(numout)
[3132]299      ENDIF
300      !
301      IF( .NOT.ln_tsd_tradmp ) THEN                   !==   deallocate T & S structure   ==!
302         !                                              (data used only for initialisation)
303         IF(lwp) WRITE(numout,*) 'dta_tsd: deallocte T & S arrays as they are only use to initialize the run'
[11101]304         IF(lwp .AND. lflush) CALL flush(numout)
[3132]305                                        DEALLOCATE( sf_tsd(jp_tem)%fnow )     ! T arrays in the structure
306         IF( sf_tsd(jp_tem)%ln_tint )   DEALLOCATE( sf_tsd(jp_tem)%fdta )
307                                        DEALLOCATE( sf_tsd(jp_sal)%fnow )     ! S arrays in the structure
308         IF( sf_tsd(jp_sal)%ln_tint )   DEALLOCATE( sf_tsd(jp_sal)%fdta )
309                                        DEALLOCATE( sf_tsd              )     ! the structure itself
310      ENDIF
311      !
[3162]312      IF( nn_timing == 1 )  CALL timing_stop('dta_tsd')
313      !
[3132]314   END SUBROUTINE dta_tsd
315
316   !!======================================================================
317END MODULE dtatsd
Note: See TracBrowser for help on using the repository browser.