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 NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/OCE/DOM – NEMO

source: NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/OCE/DOM/dtatsd.F90 @ 11671

Last change on this file since 11671 was 11671, checked in by acc, 5 years ago

Branch 2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles. Final, non-substantive changes to complete this branch. These changes remove all REWIND statements on the old namelist fortran units (now character variables for internal files). These changes have been left until last since they are easily repeated via a script and it may be preferable to use the previous revision for merge purposes and reapply these last changes separately. This branch has been fully SETTE tested.
  • Property svn:keywords set to Id
File size: 13.2 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      READ  ( numnam_ref, namtsd, IOSTAT = ios, ERR = 901)
68901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtsd in reference namelist' )
69      READ  ( numnam_cfg, namtsd, IOSTAT = ios, ERR = 902 )
70902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtsd in configuration namelist' )
71      IF(lwm) WRITE ( numond, namtsd )
72
73      IF( PRESENT( ld_tradmp ) )   ln_tsd_dmp = .TRUE.     ! forces the initialization when tradmp is used
74     
75      IF(lwp) THEN                  ! control print
76         WRITE(numout,*)
77         WRITE(numout,*) 'dta_tsd_init : Temperature & Salinity data '
78         WRITE(numout,*) '~~~~~~~~~~~~ '
79         WRITE(numout,*) '   Namelist namtsd'
80         WRITE(numout,*) '      Initialisation of ocean T & S with T &S input data   ln_tsd_init = ', ln_tsd_init
81         WRITE(numout,*) '      damping of ocean T & S toward T &S input data        ln_tsd_dmp  = ', ln_tsd_dmp
82         WRITE(numout,*)
83         IF( .NOT.ln_tsd_init .AND. .NOT.ln_tsd_dmp ) THEN
84            WRITE(numout,*)
85            WRITE(numout,*) '   ===>>   T & S data not used'
86         ENDIF
87      ENDIF
88      !
89      IF( ln_rstart .AND. ln_tsd_init ) THEN
90         CALL ctl_warn( 'dta_tsd_init: ocean restart and T & S data intialisation, ',   &
91            &           'we keep the restart T & S values and set ln_tsd_init to FALSE' )
92         ln_tsd_init = .FALSE.
93      ENDIF
94      !
95      !                             ! allocate the arrays (if necessary)
96      IF( ln_tsd_init .OR. ln_tsd_dmp ) THEN
97         !
98         ALLOCATE( sf_tsd(jpts), STAT=ierr0 )
99         IF( ierr0 > 0 ) THEN
100            CALL ctl_stop( 'dta_tsd_init: unable to allocate sf_tsd structure' )   ;   RETURN
101         ENDIF
102         !
103                                ALLOCATE( sf_tsd(jp_tem)%fnow(jpi,jpj,jpk)   , STAT=ierr0 )
104         IF( sn_tem%ln_tint )   ALLOCATE( sf_tsd(jp_tem)%fdta(jpi,jpj,jpk,2) , STAT=ierr1 )
105                                ALLOCATE( sf_tsd(jp_sal)%fnow(jpi,jpj,jpk)   , STAT=ierr2 )
106         IF( sn_sal%ln_tint )   ALLOCATE( sf_tsd(jp_sal)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )
107         !
108         IF( ierr0 + ierr1 + ierr2 + ierr3 > 0 ) THEN
109            CALL ctl_stop( 'dta_tsd : unable to allocate T & S data arrays' )   ;   RETURN
110         ENDIF
111         !                         ! fill sf_tsd with sn_tem & sn_sal and control print
112         slf_i(jp_tem) = sn_tem   ;   slf_i(jp_sal) = sn_sal
113         CALL fld_fill( sf_tsd, slf_i, cn_dir, 'dta_tsd', 'Temperature & Salinity data', 'namtsd', no_print )
114         !
115      ENDIF
116      !
117   END SUBROUTINE dta_tsd_init
118
119
120   SUBROUTINE dta_tsd( kt, ptsd )
121      !!----------------------------------------------------------------------
122      !!                   ***  ROUTINE dta_tsd  ***
123      !!                   
124      !! ** Purpose :   provides T and S data at kt
125      !!
126      !! ** Method  : - call fldread routine
127      !!              - ORCA_R2: add some hand made alteration to read data 
128      !!              - 'key_orca_lev10' interpolates on 10 times more levels
129      !!              - s- or mixed z-s coordinate: vertical interpolation on model mesh
130      !!              - ln_tsd_dmp=F: deallocates the T-S data structure
131      !!                as T-S data are no are used
132      !!
133      !! ** Action  :   ptsd   T-S data on medl mesh and interpolated at time-step kt
134      !!----------------------------------------------------------------------
135      INTEGER                              , INTENT(in   ) ::   kt     ! ocean time-step
136      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   ptsd   ! T & S data
137      !
138      INTEGER ::   ji, jj, jk, jl, jkk   ! dummy loop indicies
139      INTEGER ::   ik, il0, il1, ii0, ii1, ij0, ij1   ! local integers
140      REAL(wp)::   zl, zi                             ! local scalars
141      REAL(wp), DIMENSION(jpk) ::  ztp, zsp   ! 1D workspace
142      !!----------------------------------------------------------------------
143      !
144      CALL fld_read( kt, 1, sf_tsd )      !==   read T & S data at kt time step   ==!
145      !
146      !
147!!gm  This should be removed from the code   ===>>>>  T & S files has to be changed
148      !
149      !                                   !==   ORCA_R2 configuration and T & S damping   ==!
150      IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN
151         IF( nn_cfg == 2 .AND. ln_tsd_dmp ) THEN    ! some hand made alterations
152            !
153            ij0 = 101   ;   ij1 = 109                       ! Reduced T & S in the Alboran Sea
154            ii0 = 141   ;   ii1 = 155
155            DO jj = mj0(ij0), mj1(ij1)
156               DO ji = mi0(ii0), mi1(ii1)
157                  sf_tsd(jp_tem)%fnow(ji,jj,13:13) = sf_tsd(jp_tem)%fnow(ji,jj,13:13) - 0.20_wp
158                  sf_tsd(jp_tem)%fnow(ji,jj,14:15) = sf_tsd(jp_tem)%fnow(ji,jj,14:15) - 0.35_wp
159                  sf_tsd(jp_tem)%fnow(ji,jj,16:25) = sf_tsd(jp_tem)%fnow(ji,jj,16:25) - 0.40_wp
160                  !
161                  sf_tsd(jp_sal)%fnow(ji,jj,13:13) = sf_tsd(jp_sal)%fnow(ji,jj,13:13) - 0.15_wp
162                  sf_tsd(jp_sal)%fnow(ji,jj,14:15) = sf_tsd(jp_sal)%fnow(ji,jj,14:15) - 0.25_wp
163                  sf_tsd(jp_sal)%fnow(ji,jj,16:17) = sf_tsd(jp_sal)%fnow(ji,jj,16:17) - 0.30_wp
164                  sf_tsd(jp_sal)%fnow(ji,jj,18:25) = sf_tsd(jp_sal)%fnow(ji,jj,18:25) - 0.35_wp
165               END DO
166            END DO
167            ij0 =  87   ;   ij1 =  96                          ! Reduced temperature in Red Sea
168            ii0 = 148   ;   ii1 = 160
169            sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 ) = 7.0_wp
170            sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5_wp
171            sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0_wp
172         ENDIF
173      ENDIF
174!!gm end
175      !
176      ptsd(:,:,:,jp_tem) = sf_tsd(jp_tem)%fnow(:,:,:)    ! NO mask
177      ptsd(:,:,:,jp_sal) = sf_tsd(jp_sal)%fnow(:,:,:) 
178      !
179      IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==!
180         !
181         IF( kt == nit000 .AND. lwp )THEN
182            WRITE(numout,*)
183            WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh'
184         ENDIF
185         !
186         DO jj = 1, jpj                         ! vertical interpolation of T & S
187            DO ji = 1, jpi
188               DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points
189                  zl = gdept_0(ji,jj,jk)
190                  IF(     zl < gdept_1d(1  ) ) THEN          ! above the first level of data
191                     ztp(jk) =  ptsd(ji,jj,1    ,jp_tem)
192                     zsp(jk) =  ptsd(ji,jj,1    ,jp_sal)
193                  ELSEIF( zl > gdept_1d(jpk) ) THEN          ! below the last level of data
194                     ztp(jk) =  ptsd(ji,jj,jpkm1,jp_tem)
195                     zsp(jk) =  ptsd(ji,jj,jpkm1,jp_sal)
196                  ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1
197                     DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1)
198                        IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN
199                           zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk))
200                           ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi 
201                           zsp(jk) = ptsd(ji,jj,jkk,jp_sal) + ( ptsd(ji,jj,jkk+1,jp_sal) - ptsd(ji,jj,jkk,jp_sal) ) * zi
202                        ENDIF
203                     END DO
204                  ENDIF
205               END DO
206               DO jk = 1, jpkm1
207                  ptsd(ji,jj,jk,jp_tem) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord
208                  ptsd(ji,jj,jk,jp_sal) = zsp(jk) * tmask(ji,jj,jk)
209               END DO
210               ptsd(ji,jj,jpk,jp_tem) = 0._wp
211               ptsd(ji,jj,jpk,jp_sal) = 0._wp
212            END DO
213         END DO
214         !
215      ELSE                                !==   z- or zps- coordinate   ==!
216         !                             
217         ptsd(:,:,:,jp_tem) = ptsd(:,:,:,jp_tem) * tmask(:,:,:)    ! Mask
218         ptsd(:,:,:,jp_sal) = ptsd(:,:,:,jp_sal) * tmask(:,:,:)
219         !
220         IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level
221            DO jj = 1, jpj
222               DO ji = 1, jpi
223                  ik = mbkt(ji,jj) 
224                  IF( ik > 1 ) THEN
225                     zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
226                     ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik-1,jp_tem)
227                     ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik-1,jp_sal)
228                  ENDIF
229                  ik = mikt(ji,jj)
230                  IF( ik > 1 ) THEN
231                     zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 
232                     ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik+1,jp_tem)
233                     ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik+1,jp_sal)
234                  END IF
235               END DO
236            END DO
237         ENDIF
238         !
239      ENDIF
240      !
241      IF( .NOT.ln_tsd_dmp ) THEN                   !==   deallocate T & S structure   ==!
242         !                                              (data used only for initialisation)
243         IF(lwp) WRITE(numout,*) 'dta_tsd: deallocte T & S arrays as they are only use to initialize the run'
244                                        DEALLOCATE( sf_tsd(jp_tem)%fnow )     ! T arrays in the structure
245         IF( sf_tsd(jp_tem)%ln_tint )   DEALLOCATE( sf_tsd(jp_tem)%fdta )
246                                        DEALLOCATE( sf_tsd(jp_sal)%fnow )     ! S arrays in the structure
247         IF( sf_tsd(jp_sal)%ln_tint )   DEALLOCATE( sf_tsd(jp_sal)%fdta )
248                                        DEALLOCATE( sf_tsd              )     ! the structure itself
249      ENDIF
250      !
251   END SUBROUTINE dta_tsd
252
253   !!======================================================================
254END MODULE dtatsd
Note: See TracBrowser for help on using the repository browser.