- Timestamp:
- 2020-09-14T17:40:34+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/C1D/dtauvd.F90 (modified) (6 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@13382 sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/C1D/dtauvd.F90
r10068 r13463 31 31 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_uvd ! structure for input U & V current (file information and data) 32 32 33 !! * Substitutions 34 # include "do_loop_substitute.h90" 33 35 !!---------------------------------------------------------------------- 34 36 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 60 62 ierr0 = 0 ; ierr1 = 0 ; ierr2 = 0 ; ierr3 = 0 61 63 62 REWIND( numnam_ref ) ! Namelist namc1d_uvd in reference namelist :63 64 READ ( numnam_ref, namc1d_uvd, IOSTAT = ios, ERR = 901) 64 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d_uvd in reference namelist', lwp ) 65 ! 66 REWIND( numnam_cfg ) ! Namelist namc1d_uvd in configuration namelist : Parameters of the run 65 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d_uvd in reference namelist' ) 66 ! 67 67 READ ( numnam_cfg, namc1d_uvd, IOSTAT = ios, ERR = 902 ) 68 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namc1d_uvd in configuration namelist' , lwp)68 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namc1d_uvd in configuration namelist' ) 69 69 IF(lwm) WRITE ( numond, namc1d_uvd ) 70 70 … … 117 117 118 118 119 SUBROUTINE dta_uvd( kt, puvd )119 SUBROUTINE dta_uvd( kt, Kmm, puvd ) 120 120 !!---------------------------------------------------------------------- 121 121 !! *** ROUTINE dta_uvd *** … … 133 133 !!---------------------------------------------------------------------- 134 134 INTEGER , INTENT(in ) :: kt ! ocean time-step 135 INTEGER , INTENT(in ) :: Kmm ! time level index 135 136 REAL(wp), DIMENSION(jpi,jpj,jpk,2), INTENT( out) :: puvd ! U & V current data 136 137 ! … … 157 158 ENDIF 158 159 ! 159 DO jj = 1, jpj ! vertical interpolation of U & V current: 160 DO ji = 1, jpi ! determines the interpolated U & V current profiles at each (i,j) point 161 DO jk = 1, jpk 162 zl = gdept_n(ji,jj,jk) 163 IF ( zl < gdept_1d(1 ) ) THEN ! extrapolate above the first level of data 164 zup(jk) = puvd(ji,jj,1 ,1) 165 zvp(jk) = puvd(ji,jj,1 ,2) 166 ELSEIF( zl > gdept_1d(jpk) ) THEN ! extrapolate below the last level of data 167 zup(jk) = puvd(ji,jj,jpkm1,1) 168 zvp(jk) = puvd(ji,jj,jpkm1,2) 169 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 170 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 171 IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 172 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 173 zup(jk) = puvd(ji,jj,jkk,1) + ( puvd(ji,jj,jkk+1,1 ) - puvd(ji,jj,jkk,1) ) * zi 174 zvp(jk) = puvd(ji,jj,jkk,2) + ( puvd(ji,jj,jkk+1,2 ) - puvd(ji,jj,jkk,2) ) * zi 175 ENDIF 176 END DO 177 ENDIF 178 END DO 179 DO jk = 1, jpkm1 ! apply mask 180 puvd(ji,jj,jk,1) = zup(jk) * umask(ji,jj,jk) 181 puvd(ji,jj,jk,2) = zvp(jk) * vmask(ji,jj,jk) 182 END DO 183 puvd(ji,jj,jpk,1) = 0._wp 184 puvd(ji,jj,jpk,2) = 0._wp 160 DO_2D( 1, 1, 1, 1 ) 161 DO jk = 1, jpk 162 zl = gdept(ji,jj,jk,Kmm) 163 IF ( zl < gdept_1d(1 ) ) THEN ! extrapolate above the first level of data 164 zup(jk) = puvd(ji,jj,1 ,1) 165 zvp(jk) = puvd(ji,jj,1 ,2) 166 ELSEIF( zl > gdept_1d(jpk) ) THEN ! extrapolate below the last level of data 167 zup(jk) = puvd(ji,jj,jpkm1,1) 168 zvp(jk) = puvd(ji,jj,jpkm1,2) 169 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 170 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 171 IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 172 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 173 zup(jk) = puvd(ji,jj,jkk,1) + ( puvd(ji,jj,jkk+1,1 ) - puvd(ji,jj,jkk,1) ) * zi 174 zvp(jk) = puvd(ji,jj,jkk,2) + ( puvd(ji,jj,jkk+1,2 ) - puvd(ji,jj,jkk,2) ) * zi 175 ENDIF 176 END DO 177 ENDIF 185 178 END DO 186 END DO 179 DO jk = 1, jpkm1 ! apply mask 180 puvd(ji,jj,jk,1) = zup(jk) * umask(ji,jj,jk) 181 puvd(ji,jj,jk,2) = zvp(jk) * vmask(ji,jj,jk) 182 END DO 183 puvd(ji,jj,jpk,1) = 0._wp 184 puvd(ji,jj,jpk,2) = 0._wp 185 END_2D 187 186 ! 188 187 DEALLOCATE( zup, zvp ) … … 194 193 ! 195 194 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level 196 DO jj = 1, jpj 197 DO ji = 1, jpi 198 ik = mbkt(ji,jj) 199 IF( ik > 1 ) THEN 200 zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 201 puvd(ji,jj,ik,1) = (1.-zl) * puvd(ji,jj,ik,1) + zl * puvd(ji,jj,ik-1,1) 202 puvd(ji,jj,ik,2) = (1.-zl) * puvd(ji,jj,ik,2) + zl * puvd(ji,jj,ik-1,2) 203 ENDIF 204 END DO 205 END DO 195 DO_2D( 1, 1, 1, 1 ) 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_2D 206 203 ENDIF 207 204 !
Note: See TracChangeset
for help on using the changeset viewer.
