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 trunk/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

source: trunk/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90 @ 4624

Last change on this file since 4624 was 4624, checked in by acc, 10 years ago

#1305. Fix slow start-up problems on some systems by introducing and using lwm logical to restrict output of merged namelists to the first (or only) processor. lwm is true only on the first processor regardless of ln_ctl. Small changes to all flavours of nemogcm.F90 are also required to write namctl and namcfg after the call to mynode which now opens output.namelist.dyn and writes nammpp.
File size: 15.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 + 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
23   USE wrk_nemo        ! Memory allocation
24   USE timing          ! Timing
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
32   LOGICAL , PUBLIC ::   ln_tsd_init      !: T & S data flag
33   LOGICAL , PUBLIC ::   ln_tsd_tradmp    !: internal damping toward input data flag
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)
41   !! $Id: dtatem.F90 2392 2010-11-15 21:20:05Z gm $
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
64      INTEGER  ::   ios
65      !!----------------------------------------------------------------------
66      !
67      IF( nn_timing == 1 )  CALL timing_start('dta_tsd_init')
68      !
69      !  Initialisation
70      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0
71      !
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 )
75
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 )
79      IF(lwm) WRITE ( numond, namtsd )
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
95      ENDIF
96      !
97      IF( ln_rstart .AND. ln_tsd_init ) THEN
98         CALL ctl_warn( 'dta_tsd_init: ocean restart and T & S data intialisation, ',   &
99            &           'we keep the restart T & S values and set ln_tsd_init to FALSE' )
100         ln_tsd_init = .FALSE.
101      ENDIF
102      !
103      !                             ! allocate the arrays (if necessary)
104      IF(  ln_tsd_init .OR. ln_tsd_tradmp  ) THEN
105         !
106         ALLOCATE( sf_tsd(jpts), STAT=ierr0 )
107         IF( ierr0 > 0 ) THEN
108            CALL ctl_stop( 'dta_tsd_init: unable to allocate sf_tsd structure' )   ;   RETURN
109         ENDIF
110         !
111                                ALLOCATE( sf_tsd(jp_tem)%fnow(jpi,jpj,jpk)   , STAT=ierr0 )
112         IF( sn_tem%ln_tint )   ALLOCATE( sf_tsd(jp_tem)%fdta(jpi,jpj,jpk,2) , STAT=ierr1 )
113                                ALLOCATE( sf_tsd(jp_sal)%fnow(jpi,jpj,jpk)   , STAT=ierr2 )
114         IF( sn_sal%ln_tint )   ALLOCATE( sf_tsd(jp_sal)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )
115         !
116         IF( ierr0 + ierr1 + ierr2 + ierr3 > 0 ) THEN
117            CALL ctl_stop( 'dta_tsd : unable to allocate T & S data arrays' )   ;   RETURN
118         ENDIF
119         !                         ! fill sf_tsd with sn_tem & sn_sal and control print
120         slf_i(jp_tem) = sn_tem   ;   slf_i(jp_sal) = sn_sal
121         CALL fld_fill( sf_tsd, slf_i, cn_dir, 'dta_tsd', 'Temperature & Salinity data', 'namtsd' )
122         !
123      ENDIF
124      !
125      IF( nn_timing == 1 )  CALL timing_stop('dta_tsd_init')
126      !
127   END SUBROUTINE dta_tsd_init
128
129
130   SUBROUTINE dta_tsd( kt, ptsd )
131      !!----------------------------------------------------------------------
132      !!                   ***  ROUTINE dta_tsd  ***
133      !!                   
134      !! ** Purpose :   provides T and S data at kt
135      !!
136      !! ** Method  : - call fldread routine
137      !!              - ORCA_R2: add some hand made alteration to read data 
138      !!              - 'key_orca_lev10' interpolates on 10 times more levels
139      !!              - s- or mixed z-s coordinate: vertical interpolation on model mesh
140      !!              - ln_tsd_tradmp=F: deallocates the T-S data structure
141      !!                as T-S data are no are used
142      !!
143      !! ** Action  :   ptsd   T-S data on medl mesh and interpolated at time-step kt
144      !!----------------------------------------------------------------------
145      INTEGER                              , INTENT(in   ) ::   kt     ! ocean time-step
146      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   ptsd   ! T & S data
147      !
148      INTEGER ::   ji, jj, jk, jl, jkk   ! dummy loop indicies
149      INTEGER ::   ik, il0, il1, ii0, ii1, ij0, ij1   ! local integers
150      REAL(wp)::   zl, zi
151      REAL(wp), POINTER, DIMENSION(:) ::  ztp, zsp   ! 1D workspace
152      !!----------------------------------------------------------------------
153      !
154      IF( nn_timing == 1 )  CALL timing_start('dta_tsd')
155      !
156      CALL fld_read( kt, 1, sf_tsd )      !==   read T & S data at kt time step   ==!
157      !
158      !
159      !                                   !==   ORCA_R2 configuration and T & S damping   ==!
160      IF( cp_cfg == "orca" .AND. jp_cfg == 2 .AND. ln_tsd_tradmp ) THEN    ! some hand made alterations
161         !
162         ij0 = 101   ;   ij1 = 109                       ! Reduced T & S in the Alboran Sea
163         ii0 = 141   ;   ii1 = 155
164         DO jj = mj0(ij0), mj1(ij1)
165            DO ji = mi0(ii0), mi1(ii1)
166               sf_tsd(jp_tem)%fnow(ji,jj,13:13) = sf_tsd(jp_tem)%fnow(ji,jj,13:13) - 0.20_wp
167               sf_tsd(jp_tem)%fnow(ji,jj,14:15) = sf_tsd(jp_tem)%fnow(ji,jj,14:15) - 0.35_wp
168               sf_tsd(jp_tem)%fnow(ji,jj,16:25) = sf_tsd(jp_tem)%fnow(ji,jj,16:25) - 0.40_wp
169               !
170               sf_tsd(jp_sal)%fnow(ji,jj,13:13) = sf_tsd(jp_sal)%fnow(ji,jj,13:13) - 0.15_wp
171               sf_tsd(jp_sal)%fnow(ji,jj,14:15) = sf_tsd(jp_sal)%fnow(ji,jj,14:15) - 0.25_wp
172               sf_tsd(jp_sal)%fnow(ji,jj,16:17) = sf_tsd(jp_sal)%fnow(ji,jj,16:17) - 0.30_wp
173               sf_tsd(jp_sal)%fnow(ji,jj,18:25) = sf_tsd(jp_sal)%fnow(ji,jj,18:25) - 0.35_wp
174            END DO
175         END DO
176         IF( nn_cla == 1 ) THEN                          ! Cross Land advection
177            il0 = 138   ;   il1 = 138                          ! set T & S profile at Gibraltar Strait
178            ij0 = 101   ;   ij1 = 102
179            ii0 = 139   ;   ii1 = 139
180            DO jl = mi0(il0), mi1(il1)
181               DO jj = mj0(ij0), mj1(ij1)
182                  DO ji = mi0(ii0), mi1(ii1)
183                     sf_tsd(jp_tem)%fnow(ji,jj,:) = sf_tsd(jp_tem)%fnow(jl,jj,:)
184                     sf_tsd(jp_sal)%fnow(ji,jj,:) = sf_tsd(jp_sal)%fnow(jl,jj,:)
185                  END DO
186               END DO
187            END DO
188            il0 = 164   ;   il1 = 164                          ! set T & S profile at Bab el Mandeb Strait
189            ij0 =  87   ;   ij1 =  88
190            ii0 = 161   ;   ii1 = 163
191            DO jl = mi0(il0), mi1(il1)
192               DO jj = mj0(ij0), mj1(ij1)
193                  DO ji = mi0(ii0), mi1(ii1)
194                     sf_tsd(jp_tem)%fnow(ji,jj,:) = sf_tsd(jp_tem)%fnow(jl,jj,:)
195                     sf_tsd(jp_sal)%fnow(ji,jj,:) = sf_tsd(jp_sal)%fnow(jl,jj,:)
196                  END DO
197               END DO
198            END DO
199         ELSE                                            ! No Cross Land advection
200            ij0 =  87   ;   ij1 =  96                          ! Reduced temperature in Red Sea
201            ii0 = 148   ;   ii1 = 160
202            sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 ) = 7.0_wp
203            sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5_wp
204            sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0_wp
205         ENDIF
206      ENDIF
207      !
208      ptsd(:,:,:,jp_tem) = sf_tsd(jp_tem)%fnow(:,:,:)    ! NO mask
209      ptsd(:,:,:,jp_sal) = sf_tsd(jp_sal)%fnow(:,:,:) 
210      !
211      IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==!
212         !
213         CALL wrk_alloc( jpk, ztp, zsp )
214         !
215         IF( kt == nit000 .AND. lwp )THEN
216            WRITE(numout,*)
217            WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh'
218         ENDIF
219         !
220         DO jj = 1, jpj                         ! vertical interpolation of T & S
221            DO ji = 1, jpi
222               DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points
223                  zl = gdept_0(ji,jj,jk)
224                  IF(     zl < gdept_1d(1  ) ) THEN          ! above the first level of data
225                     ztp(jk) =  ptsd(ji,jj,1    ,jp_tem)
226                     zsp(jk) =  ptsd(ji,jj,1    ,jp_sal)
227                  ELSEIF( zl > gdept_1d(jpk) ) THEN          ! below the last level of data
228                     ztp(jk) =  ptsd(ji,jj,jpkm1,jp_tem)
229                     zsp(jk) =  ptsd(ji,jj,jpkm1,jp_sal)
230                  ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1
231                     DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1)
232                        IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN
233                           zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk))
234                           ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi 
235                           zsp(jk) = ptsd(ji,jj,jkk,jp_sal) + ( ptsd(ji,jj,jkk+1,jp_sal) - ptsd(ji,jj,jkk,jp_sal) ) * zi
236                        ENDIF
237                     END DO
238                  ENDIF
239               END DO
240               DO jk = 1, jpkm1
241                  ptsd(ji,jj,jk,jp_tem) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord
242                  ptsd(ji,jj,jk,jp_sal) = zsp(jk) * tmask(ji,jj,jk)
243               END DO
244               ptsd(ji,jj,jpk,jp_tem) = 0._wp
245               ptsd(ji,jj,jpk,jp_sal) = 0._wp
246            END DO
247         END DO
248         !
249         CALL wrk_dealloc( jpk, ztp, zsp )
250         !
251      ELSE                                !==   z- or zps- coordinate   ==!
252         !                             
253         ptsd(:,:,:,jp_tem) = ptsd(:,:,:,jp_tem) * tmask(:,:,:)    ! Mask
254         ptsd(:,:,:,jp_sal) = ptsd(:,:,:,jp_sal) * tmask(:,:,:)
255         !
256         IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level
257            DO jj = 1, jpj
258               DO ji = 1, jpi
259                  ik = mbkt(ji,jj) 
260                  IF( ik > 1 ) THEN
261                     zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
262                     ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik-1,jp_tem)
263                     ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik-1,jp_sal)
264                  ENDIF
265               END DO
266            END DO
267         ENDIF
268         !
269      ENDIF
270      !
271      IF( lwp .AND. kt == nit000 ) THEN
272         WRITE(numout,*) ' temperature Levitus '
273         WRITE(numout,*)
274         WRITE(numout,*)'  level = 1'
275         CALL prihre( ptsd(:,:,1    ,jp_tem), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
276         WRITE(numout,*)'  level = ', jpk/2
277         CALL prihre( ptsd(:,:,jpk/2,jp_tem), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
278         WRITE(numout,*)'  level = ', jpkm1
279         CALL prihre( ptsd(:,:,jpkm1,jp_tem), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
280         WRITE(numout,*)
281         WRITE(numout,*) ' salinity Levitus '
282         WRITE(numout,*)
283         WRITE(numout,*)'  level = 1'
284         CALL prihre( ptsd(:,:,1    ,jp_sal), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
285         WRITE(numout,*)'  level = ', jpk/2
286         CALL prihre( ptsd(:,:,jpk/2,jp_sal), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
287         WRITE(numout,*)'  level = ', jpkm1
288         CALL prihre( ptsd(:,:,jpkm1,jp_sal), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
289         WRITE(numout,*)
290      ENDIF
291      !
292      IF( .NOT.ln_tsd_tradmp ) THEN                   !==   deallocate T & S structure   ==!
293         !                                              (data used only for initialisation)
294         IF(lwp) WRITE(numout,*) 'dta_tsd: deallocte T & S arrays as they are only use to initialize the run'
295                                        DEALLOCATE( sf_tsd(jp_tem)%fnow )     ! T arrays in the structure
296         IF( sf_tsd(jp_tem)%ln_tint )   DEALLOCATE( sf_tsd(jp_tem)%fdta )
297                                        DEALLOCATE( sf_tsd(jp_sal)%fnow )     ! S arrays in the structure
298         IF( sf_tsd(jp_sal)%ln_tint )   DEALLOCATE( sf_tsd(jp_sal)%fdta )
299                                        DEALLOCATE( sf_tsd              )     ! the structure itself
300      ENDIF
301      !
302      IF( nn_timing == 1 )  CALL timing_stop('dta_tsd')
303      !
304   END SUBROUTINE dta_tsd
305
306   !!======================================================================
307END MODULE dtatsd
Note: See TracBrowser for help on using the repository browser.