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.
dtauvd.F90 in NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/OCE/C1D – NEMO

source: NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/OCE/C1D/dtauvd.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: 11.2 KB
Line 
1MODULE dtauvd
2   !!======================================================================
3   !!                     ***  MODULE  dtauvd  ***
4   !! Ocean data  :  read ocean U & V current data from gridded data
5   !!======================================================================
6   !! History :  3.5  ! 2013-08  (D. Calvert)  Original code
7   !!----------------------------------------------------------------------
8
9   !!----------------------------------------------------------------------
10   !!   dta_uvd_init  : read namelist and allocate data structures
11   !!   dta_uvd       : read and time-interpolate ocean U & V current data
12   !!----------------------------------------------------------------------
13   USE oce            ! ocean dynamics and tracers
14   USE phycst         ! physical constants
15   USE dom_oce        ! ocean space and time domain
16   !
17   USE in_out_manager ! I/O manager
18   USE fldread        ! read input fields
19   USE lib_mpp        ! MPP library
20   USE timing         ! Timing
21
22   IMPLICIT NONE
23   PRIVATE
24
25   PUBLIC   dta_uvd_init   ! called by nemogcm.F90
26   PUBLIC   dta_uvd        ! called by istate.F90 and dyndmp.90
27
28   LOGICAL , PUBLIC ::   ln_uvd_init     ! Flag to initialise with U & V current data
29   LOGICAL , PUBLIC ::   ln_uvd_dyndmp   ! Flag for Newtonian damping toward U & V current data
30
31   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_uvd   ! structure for input U & V current (file information and data)
32
33   !!----------------------------------------------------------------------
34   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
35   !! $Id$
36   !! Software governed by the CeCILL license (see ./LICENSE)
37   !!----------------------------------------------------------------------
38CONTAINS
39
40   SUBROUTINE dta_uvd_init( ld_dyndmp )
41      !!----------------------------------------------------------------------
42      !!                   ***  ROUTINE dta_uvd_init  ***
43      !!                   
44      !! ** Purpose :   initialization of U & V current input data
45      !!
46      !! ** Method  : - read namc1d_uvd namelist
47      !!              - allocate U & V current data structure
48      !!              - fld_fill data structure with namelist information
49      !!----------------------------------------------------------------------
50      LOGICAL, INTENT(in), OPTIONAL ::   ld_dyndmp   ! force the initialization when dyndmp is used
51      !
52      INTEGER ::   ios, ierr0, ierr1, ierr2, ierr3     ! local integers
53      CHARACTER(len=100)        ::   cn_dir            ! Root directory for location of files to be used
54      TYPE(FLD_N), DIMENSION(2) ::   suv_i             ! Combined U & V namelist information
55      TYPE(FLD_N)               ::   sn_ucur, sn_vcur  ! U & V data namelist information
56      !!
57      NAMELIST/namc1d_uvd/ ln_uvd_init, ln_uvd_dyndmp, cn_dir, sn_ucur, sn_vcur
58      !!----------------------------------------------------------------------
59      !
60      ierr0 = 0   ;   ierr1 = 0   ;   ierr2 = 0  ;   ierr3 = 0
61
62      READ  ( numnam_ref, namc1d_uvd, IOSTAT = ios, ERR = 901)
63901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d_uvd in reference namelist' )
64      !
65      READ  ( numnam_cfg, namc1d_uvd, IOSTAT = ios, ERR = 902 )
66902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namc1d_uvd in configuration namelist' )
67      IF(lwm) WRITE ( numond, namc1d_uvd )
68
69      !                             ! force the initialization when dyndmp is used
70      IF( PRESENT( ld_dyndmp ) )   ln_uvd_dyndmp = .TRUE.
71     
72      IF(lwp) THEN                  ! control print
73         WRITE(numout,*)
74         WRITE(numout,*) 'dta_uvd_init : U & V current data '
75         WRITE(numout,*) '~~~~~~~~~~~~ '
76         WRITE(numout,*) '   Namelist namc1d_uvd : Set flags'
77         WRITE(numout,*) '      Initialization of ocean U & V current with input data   ln_uvd_init   = ', ln_uvd_init
78         WRITE(numout,*) '      Damping of ocean U & V current toward input data        ln_uvd_dyndmp = ', ln_uvd_dyndmp
79         WRITE(numout,*)
80         IF( .NOT. ln_uvd_init .AND. .NOT. ln_uvd_dyndmp ) THEN
81            WRITE(numout,*)
82            WRITE(numout,*) '   U & V current data not used'
83         ENDIF
84      ENDIF
85      !                             ! no initialization when restarting
86      IF( ln_rstart .AND. ln_uvd_init ) THEN
87         CALL ctl_warn( 'dta_uvd_init: ocean restart and U & V current data initialization, ',   &
88            &           'we keep the restart U & V current values and set ln_uvd_init to FALSE' )
89         ln_uvd_init = .FALSE.
90      ENDIF
91
92      !
93      IF(  ln_uvd_init .OR. ln_uvd_dyndmp  ) THEN
94         !                          !==   allocate the data arrays   ==!
95         ALLOCATE( sf_uvd(2), STAT=ierr0 )
96         IF( ierr0 > 0 ) THEN
97            CALL ctl_stop( 'dta_uvd_init: unable to allocate sf_uvd structure' )             ;   RETURN
98         ENDIF
99         !
100                                 ALLOCATE( sf_uvd(1)%fnow(jpi,jpj,jpk)   , STAT=ierr0 )
101         IF( sn_ucur%ln_tint )   ALLOCATE( sf_uvd(1)%fdta(jpi,jpj,jpk,2) , STAT=ierr1 )
102                                 ALLOCATE( sf_uvd(2)%fnow(jpi,jpj,jpk)   , STAT=ierr2 )
103         IF( sn_vcur%ln_tint )   ALLOCATE( sf_uvd(2)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )
104         !
105         IF( ierr0 + ierr1 + ierr2 + ierr3 > 0 ) THEN
106            CALL ctl_stop( 'dta_uvd_init : unable to allocate U & V current data arrays' )   ;   RETURN
107         ENDIF
108         !                          !==   fill sf_uvd with sn_ucur, sn_vcur and control print   ==!
109         suv_i(1) = sn_ucur   ;   suv_i(2) = sn_vcur
110         CALL fld_fill( sf_uvd, suv_i, cn_dir, 'dta_uvd', 'U & V current data', 'namc1d_uvd' )
111         !
112      ENDIF
113      !
114   END SUBROUTINE dta_uvd_init
115
116
117   SUBROUTINE dta_uvd( kt, puvd )
118      !!----------------------------------------------------------------------
119      !!                   ***  ROUTINE dta_uvd  ***
120      !!                   
121      !! ** Purpose :   provides U & V current data at time step kt
122      !!
123      !! ** Method  : - call fldread routine
124      !!              - ORCA_R2: make some hand made alterations to the data (EMPTY)
125      !!              - s- or mixed s-zps coordinate: vertical interpolation onto model mesh
126      !!              - zps coordinate: vertical interpolation onto last partial level
127      !!              - ln_uvd_dyndmp=False: deallocate the U & V current data structure,
128      !!                                     as the data is no longer used
129      !!
130      !! ** Action  :   puvd,  U & V current data interpolated onto model mesh at time-step kt
131      !!----------------------------------------------------------------------
132      INTEGER                           , INTENT(in   ) ::   kt     ! ocean time-step
133      REAL(wp), DIMENSION(jpi,jpj,jpk,2), INTENT(  out) ::   puvd   ! U & V current data
134      !
135      INTEGER ::   ji, jj, jk, jl, jkk               ! dummy loop indicies
136      INTEGER ::   ik, il0, il1, ii0, ii1, ij0, ij1  ! local integers
137      REAL(wp)::   zl, zi                            ! local floats
138      REAL(wp), ALLOCATABLE, DIMENSION(:) ::  zup, zvp   ! 1D workspace
139      !!----------------------------------------------------------------------
140      !
141      IF( ln_timing )   CALL timing_start('dta_uvd')
142      !
143      CALL fld_read( kt, 1, sf_uvd )      !==   read U & V current data at time step kt   ==!
144      !
145      puvd(:,:,:,1) = sf_uvd(1)%fnow(:,:,:)                 ! NO mask
146      puvd(:,:,:,2) = sf_uvd(2)%fnow(:,:,:) 
147      !
148      IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==!
149         !
150         ALLOCATE( zup(jpk), zvp(jpk) )
151         !
152         IF( kt == nit000 .AND. lwp )THEN
153            WRITE(numout,*)
154            WRITE(numout,*) 'dta_uvd: interpolate U & V current data onto the s- or mixed s-z-coordinate mesh'
155         ENDIF
156         !
157         DO jj = 1, jpj                   ! vertical interpolation of U & V current:
158            DO ji = 1, jpi                ! determines the interpolated U & V current profiles at each (i,j) point
159               DO jk = 1, jpk
160                  zl = gdept_n(ji,jj,jk)
161                  IF    ( zl < gdept_1d(1  ) ) THEN          ! extrapolate above the first level of data
162                     zup(jk) =  puvd(ji,jj,1    ,1)
163                     zvp(jk) =  puvd(ji,jj,1    ,2)
164                  ELSEIF( zl > gdept_1d(jpk) ) THEN          ! extrapolate below the last level of data
165                     zup(jk) =  puvd(ji,jj,jpkm1,1)
166                     zvp(jk) =  puvd(ji,jj,jpkm1,2)
167                  ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1
168                     DO jkk = 1, jpkm1                      ! when  gdept(jkk) < zl < gdept(jkk+1)
169                        IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN
170                           zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk))
171                           zup(jk) = puvd(ji,jj,jkk,1) + ( puvd(ji,jj,jkk+1,1 ) - puvd(ji,jj,jkk,1) ) * zi 
172                           zvp(jk) = puvd(ji,jj,jkk,2) + ( puvd(ji,jj,jkk+1,2 ) - puvd(ji,jj,jkk,2) ) * zi
173                        ENDIF
174                     END DO
175                  ENDIF
176               END DO
177               DO jk = 1, jpkm1           ! apply mask
178                  puvd(ji,jj,jk,1) = zup(jk) * umask(ji,jj,jk)
179                  puvd(ji,jj,jk,2) = zvp(jk) * vmask(ji,jj,jk)
180               END DO
181               puvd(ji,jj,jpk,1) = 0._wp
182               puvd(ji,jj,jpk,2) = 0._wp
183            END DO
184         END DO
185         !
186         DEALLOCATE( zup, zvp )
187         !
188      ELSE                                !==   z- or zps- coordinate   ==!
189         !                             
190         puvd(:,:,:,1) = puvd(:,:,:,1) * umask(:,:,:)       ! apply mask
191         puvd(:,:,:,2) = puvd(:,:,:,2) * vmask(:,:,:)
192         !
193         IF( ln_zps ) THEN                ! zps-coordinate (partial steps) interpolation at the last ocean level
194            DO jj = 1, jpj
195               DO ji = 1, jpi
196                  ik = mbkt(ji,jj) 
197                  IF( ik > 1 ) THEN
198                     zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
199                     puvd(ji,jj,ik,1) = (1.-zl) * puvd(ji,jj,ik,1) + zl * puvd(ji,jj,ik-1,1)
200                     puvd(ji,jj,ik,2) = (1.-zl) * puvd(ji,jj,ik,2) + zl * puvd(ji,jj,ik-1,2)
201                  ENDIF
202               END DO
203            END DO
204         ENDIF
205         !
206      ENDIF
207      !
208      IF( .NOT. ln_uvd_dyndmp    ) THEN   !==   deallocate U & V current structure   ==!
209         !                                !==   (data used only for initialization)  ==!
210         IF(lwp) WRITE(numout,*) 'dta_uvd: deallocate U & V current arrays as they are only used to initialize the run'
211                                   DEALLOCATE( sf_uvd(1)%fnow )     ! U current arrays in the structure
212         IF( sf_uvd(1)%ln_tint )   DEALLOCATE( sf_uvd(1)%fdta )
213                                   DEALLOCATE( sf_uvd(2)%fnow )     ! V current arrays in the structure
214         IF( sf_uvd(2)%ln_tint )   DEALLOCATE( sf_uvd(2)%fdta )
215                                   DEALLOCATE( sf_uvd         )     ! the structure itself
216      ENDIF
217      !
218      IF( ln_timing )   CALL timing_stop('dta_uvd')
219      !
220   END SUBROUTINE dta_uvd
221
222   !!======================================================================
223END MODULE dtauvd
Note: See TracBrowser for help on using the repository browser.