- Timestamp:
- 2021-12-03T20:32:50+01:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r14318_RK3_stage1
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
tests/ISOMIP+/MY_SRC/dtatsd.F90 (modified) (13 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14318_RK3_stage1
- Property svn:externals
-
old new 9 9 10 10 # SETTE 11 ^/utils/CI/sette@14244 sette 11 ^/utils/CI/sette@HEAD sette 12
-
- Property svn:externals
-
NEMO/branches/2021/dev_r14318_RK3_stage1/tests/ISOMIP+/MY_SRC/dtatsd.F90
r14090 r15574 6 6 !! History : OPA ! 1991-03 () Original code 7 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 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 10 !! 3.3 ! 2010-10 (C. Bricaud, S. Masson) use of fldread 11 11 !! 3.4 ! 2010-11 (G. Madec, C. Ethe) Merge of dtatem and dtasal + remove CPP keys … … 49 49 !!---------------------------------------------------------------------- 50 50 !! *** ROUTINE dta_tsd_init *** 51 !! 52 !! ** Purpose : initialisation of T & S input data 53 !! 51 !! 52 !! ** Purpose : initialisation of T & S input data 53 !! 54 54 !! ** Method : - Read namtsd namelist 55 !! - allocates T & S data structure 55 !! - allocates T & S data structure 56 56 !!---------------------------------------------------------------------- 57 57 LOGICAL, INTENT(in), OPTIONAL :: ld_tradmp ! force the initialization when tradp is used … … 77 77 78 78 IF( PRESENT( ld_tradmp ) ) ln_tsd_dmp = .TRUE. ! forces the initialization when tradmp is used 79 79 80 80 IF(lwp) THEN ! control print 81 81 WRITE(numout,*) … … 114 114 CALL ctl_stop( 'dta_tsd : unable to allocate T & S data arrays' ) ; RETURN 115 115 ENDIF 116 !117 116 ! ! fill sf_tsd with sn_tem & sn_sal and control print 118 117 slf_i(jp_tem) = sn_tem ; slf_i(jp_sal) = sn_sal … … 150 149 !!---------------------------------------------------------------------- 151 150 !! *** ROUTINE dta_tsd *** 152 !! 151 !! 153 152 !! ** Purpose : provides T and S data at kt 154 !! 153 !! 155 154 !! ** Method : - call fldread routine 156 !! - ORCA_R2: add some hand made alteration to read data 155 !! - ORCA_R2: add some hand made alteration to read data 157 156 !! - 'key_orca_lev10' interpolates on 10 times more levels 158 157 !! - s- or mixed z-s coordinate: vertical interpolation on model mesh … … 162 161 !! ** Action : ptsd T-S data on medl mesh and interpolated at time-step kt 163 162 !!---------------------------------------------------------------------- 164 INTEGER 165 CHARACTER(LEN=3) 163 INTEGER , INTENT(in ) :: kt ! ocean time-step 164 CHARACTER(LEN=3) , INTENT(in ) :: cddta ! dmp or ini 166 165 REAL(wp), DIMENSION(A2D(nn_hls),jpk,jpts), INTENT( out) :: ptsd ! T & S data 167 166 ! 168 167 INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies 169 168 INTEGER :: ik, il0, il1, ii0, ii1, ij0, ij1 ! local integers 170 INTEGER :: itile171 169 REAL(wp):: zl, zi ! local scalars 172 170 REAL(wp), DIMENSION(jpk) :: ztp, zsp ! 1D workspace 173 171 !!---------------------------------------------------------------------- 174 172 ! 175 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only for the full domain 176 itile = ntile 177 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 173 IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only for the full domain 174 IF( ln_tile ) CALL dom_tile_stop( ldhold=.TRUE. ) ! Use full domain 178 175 179 176 SELECT CASE(cddta) … … 186 183 END SELECT 187 184 188 IF( ln_tile ) CALL dom_tile ( ntsi, ntsj, ntei, ntej, ktile = itile) ! Revert to tile domain185 IF( ln_tile ) CALL dom_tile_start( ldhold=.TRUE. ) ! Revert to tile domain 189 186 ENDIF 190 187 ! … … 206 203 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! 207 204 ! 208 IF( ntile == 0.OR. ntile == 1 ) THEN ! Do only on the first tile205 IF( .NOT. l_istiled .OR. ntile == 1 ) THEN ! Do only on the first tile 209 206 IF( kt == nit000 .AND. lwp )THEN 210 207 WRITE(numout,*) … … 213 210 ENDIF 214 211 ! 215 DO_2D( 1, 1, 1, 1) ! vertical interpolation of T & S212 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! vertical interpolation of T & S 216 213 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 217 214 zl = gdept_0(ji,jj,jk) … … 226 223 IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 227 224 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 228 ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi 225 ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi 229 226 zsp(jk) = ptsd(ji,jj,jkk,jp_sal) + ( ptsd(ji,jj,jkk+1,jp_sal) - ptsd(ji,jj,jkk,jp_sal) ) * zi 230 227 ENDIF … … 239 236 ptsd(ji,jj,jpk,jp_sal) = 0._wp 240 237 END_2D 241 ! 238 ! 242 239 ELSE !== z- or zps- coordinate ==! 243 ! 240 ! 244 241 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 245 242 ptsd(ji,jj,jk,jp_tem) = ptsd(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) ! Mask … … 248 245 ! 249 246 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level 250 DO_2D( 1, 1, 1, 1)251 ik = mbkt(ji,jj) 247 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 248 ik = mbkt(ji,jj) 252 249 IF( ik > 1 ) THEN 253 250 zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) … … 257 254 ik = mikt(ji,jj) 258 255 IF( ik > 1 ) THEN 259 zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 256 zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 260 257 ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik+1,jp_tem) 261 258 ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik+1,jp_sal)
Note: See TracChangeset
for help on using the changeset viewer.
