- Timestamp:
- 2015-07-16T13:55:15+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/SIREN/src/create_bathy.f90
r4213 r5602 3 3 !---------------------------------------------------------------------- 4 4 ! 5 !6 5 ! PROGRAM: create_bathy 7 6 ! 8 7 ! DESCRIPTION: 8 !> @file 9 9 !> @brief 10 !> This program create bathymetry file.10 !> This program create fine grid bathymetry file. 11 11 !> 12 12 !> @details 13 !> Bathymetry could be extracted from fine grid Bathymetry file, or interpolated 14 !> from coarse grid Bathymetry file. 15 !> 16 !> @author 17 !> J.Paul 13 !> @section sec1 method 14 !> Bathymetry could be extracted from fine grid Bathymetry file, interpolated 15 !> from coarse grid Bathymetry file, or manually written. 16 !> 17 !> @section sec2 how to 18 !> to create fine grid bathymetry file:<br/> 19 !> @code{.sh} 20 !> ./SIREN/bin/create_bathy create_bathy.nam 21 !> @endcode 22 !> 23 !> create_bathy.nam comprise 7 namelists:<br/> 24 !> - logger namelist (namlog) 25 !> - config namelist (namcfg) 26 !> - coarse grid namelist (namcrs) 27 !> - fine grid namelist (namfin) 28 !> - variable namelist (namvar) 29 !> - nesting namelist (namnst) 30 !> - output namelist (namout) 31 !> 32 !> @note 33 !> All namelists have to be in file create_bathy.nam, however variables of 34 !> those namelists are all optional. 35 !> 36 !> * _logger namelist (namlog)_:<br/> 37 !> - cn_logfile : log filename 38 !> - cn_verbosity : verbosity ('trace','debug','info', 39 !> 'warning','error','fatal') 40 !> - in_maxerror : maximum number of error allowed 41 !> 42 !> * _config namelist (namcfg)_:<br/> 43 !> - cn_varcfg : variable configuration file 44 !> (see ./SIREN/cfg/variable.cfg) 45 !> 46 !> * _coarse grid namelist (namcrs)_:<br/> 47 !> - cn_coord0 : coordinate file 48 !> - in_perio0 : NEMO periodicity index (see Model Boundary Condition in 49 !> [NEMO documentation](http://www.nemo-ocean.eu/About-NEMO/Reference-manuals)) 50 !> 51 !> * _fine grid namelist (namfin)_:<br/> 52 !> - cn_coord1 : coordinate file 53 !> - in_perio1 : periodicity index 54 !> - ln_fillclosed : fill closed sea or not 55 !> 56 !> * _variable namelist (namvar)_:<br/> 57 !> - cn_varinfo : list of variable and extra information about request(s) 58 !> to be used.<br/> 59 !> each elements of *cn_varinfo* is a string character.<br/> 60 !> it is composed of the variable name follow by ':', 61 !> then request(s) to be used on this variable.<br/> 62 !> request could be: 63 !> - interpolation method 64 !> - extrapolation method 65 !> - filter method 66 !> - > minimum value 67 !> - < maximum value 68 !> 69 !> requests must be separated by ';'.<br/> 70 !> order of requests does not matter.<br/> 71 !> 72 !> informations about available method could be find in @ref interp, 73 !> @ref extrap and @ref filter modules.<br/> 74 !> Example: 'Bathymetry: 2*hamming(2,3); > 0' 75 !> @note 76 !> If you do not specify a method which is required, 77 !> default one is apply. 78 !> @warning 79 !> variable name must be __Bathymetry__ here. 80 !> - cn_varfile : list of variable, and corresponding file.<br/> 81 !> *cn_varfile* is the path and filename of the file where find 82 !> variable. 83 !> @note 84 !> *cn_varfile* could be a matrix of value, if you want to filled 85 !> manually variable value.<br/> 86 !> the variable array of value is split into equal subdomain.<br/> 87 !> Each subdomain is filled with the corresponding value 88 !> of the matrix.<br/> 89 !> separators used to defined matrix are: 90 !> - ',' for line 91 !> - '/' for row 92 !> - '\' for level<br/> 93 !> Example:<br/> 94 !> 3,2,3/1,4,5 => @f$ \left( \begin{array}{ccc} 95 !> 3 & 2 & 3 \\ 96 !> 1 & 4 & 5 \end{array} \right) @f$ 97 !> 98 !> Examples: 99 !> - 'Bathymetry:gridT.nc' 100 !> - 'Bathymetry:5000,5000,5000/5000,3000,5000/5000,5000,5000' 101 !> 102 !> \image html bathy_40.png 103 !> \image latex bathy_30.png 104 !> 105 !> * _nesting namelist (namnst)_:<br/> 106 !> - in_rhoi : refinement factor in i-direction 107 !> - in_rhoj : refinement factor in j-direction 108 !> @note 109 !> coarse grid indices will be deduced from fine grid 110 !> coordinate file. 111 !> 112 !> * _output namelist (namout)_:<br/> 113 !> - cn_fileout : output bathymetry file 114 !> 115 !> @author J.Paul 18 116 ! REVISION HISTORY: 19 !> @date Nov, 2013 - Initial Version 117 !> @date November, 2013 - Initial Version 118 !> @date Sepember, 2014 119 !> - add header for user 120 !> - Bug fix, compute offset depending of grid point 20 121 ! 21 122 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 22 !>23 !> @todo24 !> - add attributes indices and refinement in output file25 123 !---------------------------------------------------------------------- 26 !> @code27 124 PROGRAM create_bathy 28 125 29 ! USE netcdf ! nf90 library30 126 USE global ! global variable 31 127 USE kind ! F90 kind parameter … … 39 135 USE multi ! multi file manager 40 136 USE iom ! I/O manager 41 USE dom ! domain manager42 137 USE grid ! grid manager 43 138 USE extrap ! extrapolation manager … … 45 140 USE filter ! filter manager 46 141 USE mpp ! MPP manager 142 USE dom ! domain manager 47 143 USE iom_mpp ! MPP I/O manager 144 USE iom_dom ! DOM I/O manager 48 145 49 146 IMPLICIT NONE … … 57 154 INTEGER(i4) :: il_status 58 155 INTEGER(i4) :: il_fileid 156 INTEGER(i4) :: il_varid 59 157 INTEGER(i4) :: il_attid 60 INTEGER(i4) :: il_imin 61 INTEGER(i4) :: il_imax 62 INTEGER(i4) :: il_jmin 63 INTEGER(i4) :: il_jmax 158 INTEGER(i4) :: il_imin0 159 INTEGER(i4) :: il_imax0 160 INTEGER(i4) :: il_jmin0 161 INTEGER(i4) :: il_jmax0 64 162 INTEGER(i4) , DIMENSION(ip_maxdim) :: il_rho 65 163 INTEGER(i4) , DIMENSION(2,2) :: il_offset 66 INTEGER(i4) , DIMENSION(2,2 ,2):: il_ind164 INTEGER(i4) , DIMENSION(2,2) :: il_ind 67 165 INTEGER(i4) , DIMENSION(:,:) , ALLOCATABLE :: il_mask 68 166 69 167 LOGICAL :: ll_exist 70 168 71 TYPE(T FILE):: tl_coord072 TYPE(T FILE):: tl_coord173 TYPE(T FILE) :: tl_file169 TYPE(TMPP) :: tl_coord0 170 TYPE(TMPP) :: tl_coord1 171 TYPE(TMPP) :: tl_mpp 74 172 TYPE(TFILE) :: tl_fileout 75 173 … … 88 186 TYPE(TMULTI) :: tl_multi 89 187 188 REAL(dp) :: dl_minbat 189 90 190 ! loop indices 91 191 INTEGER(i4) :: ji … … 94 194 95 195 ! namelist variable 196 ! namlog 96 197 CHARACTER(LEN=lc) :: cn_logfile = 'create_bathy.log' 97 198 CHARACTER(LEN=lc) :: cn_verbosity = 'warning' 98 199 INTEGER(i4) :: in_maxerror = 5 200 201 ! namcfg 99 202 CHARACTER(LEN=lc) :: cn_varcfg = 'variable.cfg' 100 203 204 ! namcrs 101 205 CHARACTER(LEN=lc) :: cn_coord0 = '' 102 206 INTEGER(i4) :: in_perio0 = -1 103 207 208 ! namfin 104 209 CHARACTER(LEN=lc) :: cn_coord1 = '' 105 210 INTEGER(i4) :: in_perio1 = -1 106 211 LOGICAL :: ln_fillclosed = .TRUE. 107 212 108 CHARACTER(LEN=lc), DIMENSION(ig_maxvar) :: cn_varinfo = '' 109 CHARACTER(LEN=lc), DIMENSION(ig_maxvar) :: cn_varfile = '' 110 111 INTEGER(i4) :: in_imin0 = 0 112 INTEGER(i4) :: in_imax0 = 0 113 INTEGER(i4) :: in_jmin0 = 0 114 INTEGER(i4) :: in_jmax0 = 0 213 ! namvar 214 CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = '' 215 CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = '' 216 217 ! namnst 115 218 INTEGER(i4) :: in_rhoi = 1 116 219 INTEGER(i4) :: in_rhoj = 1 117 220 221 ! namout 118 222 CHARACTER(LEN=lc) :: cn_fileout = 'bathy_fine.nc' 119 223 !------------------------------------------------------------------- 120 224 121 NAMELIST /namlog/ & !< logger namelist 122 & cn_logfile, & !< log file 123 & cn_verbosity !< log verbosity 124 125 NAMELIST /namcfg/ & !< configuration namelist 126 & cn_varcfg !< variable configuration file 225 NAMELIST /namlog/ & !< logger namelist 226 & cn_logfile, & !< log file 227 & cn_verbosity, & !< log verbosity 228 & in_maxerror !< logger maximum error 229 230 NAMELIST /namcfg/ & !< configuration namelist 231 & cn_varcfg !< variable configuration file 127 232 128 233 NAMELIST /namcrs/ & !< coarse grid namelist … … 135 240 & ln_fillclosed !< fill closed sea 136 241 137 NAMELIST /namvar/ & !< variable namelist138 & cn_varinfo, & !< list of variable and interpolation method to be used. (ex: 'votemper:linear','vosaline:cubic' )139 & cn_varfile !< list of variable file242 NAMELIST /namvar/ & !< variable namelist 243 & cn_varinfo, & !< list of variable and interpolation method to be used. (ex: 'votemper:linear','vosaline:cubic' ) 244 & cn_varfile !< list of variable file 140 245 141 NAMELIST /namnst/ & !< nesting namelist 142 & in_imin0, & !< i-direction lower left point indice 143 & in_imax0, & !< i-direction upper right point indice 144 & in_jmin0, & !< j-direction lower left point indice 145 & in_jmax0, & !< j-direction upper right point indice 146 & in_rhoi, & !< refinement factor in i-direction 147 & in_rhoj !< refinement factor in j-direction 148 149 NAMELIST /namout/ & !< output namlist 150 & cn_fileout !< fine grid bathymetry file 246 NAMELIST /namnst/ & !< nesting namelist 247 & in_rhoi, & !< refinement factor in i-direction 248 & in_rhoj !< refinement factor in j-direction 249 250 NAMELIST /namout/ & !< output namlist 251 & cn_fileout !< fine grid bathymetry file 151 252 !------------------------------------------------------------------- 152 253 153 ! 1-namelist154 ! 1-1get namelist254 ! namelist 255 ! get namelist 155 256 il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec 156 257 IF( il_narg/=1 )THEN … … 160 261 CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec 161 262 ENDIF 162 163 ! 1-2read namelist263 264 ! read namelist 164 265 INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist) 165 266 IF( ll_exist )THEN 166 267 167 268 il_fileid=fct_getunit() 168 269 … … 180 281 181 282 READ( il_fileid, NML = namlog ) 182 ! 1-2-1define log file183 CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity) )283 ! define log file 284 CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror) 184 285 CALL logger_header() 185 286 186 287 READ( il_fileid, NML = namcfg ) 187 ! 1-2-2get variable extra information288 ! get variable extra information 188 289 CALL var_def_extra(TRIM(cn_varcfg)) 189 290 … … 191 292 READ( il_fileid, NML = namfin ) 192 293 READ( il_fileid, NML = namvar ) 193 ! 1-2-3add user change in extra information194 CALL var_chg_extra( cn_varinfo)195 ! 1-2-4match variable with file294 ! add user change in extra information 295 CALL var_chg_extra( cn_varinfo ) 296 ! match variable with file 196 297 tl_multi=multi_init(cn_varfile) 197 298 … … 211 312 ENDIF 212 313 213 !2- open files 314 CALL multi_print(tl_multi) 315 316 ! open files 214 317 IF( cn_coord0 /= '' )THEN 215 tl_coord0= file_init(TRIM(cn_coord0),id_perio=in_perio0)216 CALL iom_open(tl_coord0)318 tl_coord0=mpp_init( file_init(TRIM(cn_coord0)), id_perio=in_perio0) 319 CALL grid_get_info(tl_coord0) 217 320 ELSE 218 321 CALL logger_fatal("CREATE BATHY: no coarse grid coordinate found. "//& … … 221 324 222 325 IF( TRIM(cn_coord1) /= '' )THEN 223 tl_coord1= file_init(TRIM(cn_coord1),id_perio=in_perio1)224 CALL iom_open(tl_coord1)326 tl_coord1=mpp_init( file_init(TRIM(cn_coord1)),id_perio=in_perio1) 327 CALL grid_get_info(tl_coord1) 225 328 ELSE 226 329 CALL logger_fatal("CREATE BATHY: no fine grid coordinate found. "//& … … 228 331 ENDIF 229 332 230 ! 3-check231 ! 3-1check output file do not already exist333 ! check 334 ! check output file do not already exist 232 335 INQUIRE(FILE=TRIM(cn_fileout), EXIST=ll_exist) 233 336 IF( ll_exist )THEN … … 236 339 ENDIF 237 340 238 ! 3-2check namelist239 ! 3-2-1check refinement factor341 ! check namelist 342 ! check refinement factor 240 343 il_rho(:)=1 241 344 IF( in_rhoi < 1 .OR. in_rhoj < 1 )THEN … … 247 350 ENDIF 248 351 249 !3-2-2 check domain indices 250 IF( in_imin0 < 1 .OR. in_imax0 < 1 .OR. & 251 & in_jmin0 < 1 .OR. in_jmax0 < 1)THEN 252 ! compute coarse grid indices around fine grid 253 IF( cn_coord0 /= '' )THEN 254 il_ind(:,:,:)=grid_get_coarse_index( tl_coord0, tl_coord1, & 255 & id_rho=il_rho(:) ) 256 ENDIF 257 258 il_imin=il_ind(1,1,1) ; il_imax=il_ind(1,2,1) 259 il_jmin=il_ind(2,1,1) ; il_jmax=il_ind(2,2,1) 260 261 il_offset(:,:)=il_ind(:,:,2) 262 ELSE 263 il_imin=in_imin0 ; il_imax=in_imax0 264 il_jmin=in_jmin0 ; il_jmax=in_jmax0 265 266 il_offset(jp_I,:)=FLOOR(REAL(il_rho(jp_I)-1,dp)*0.5) 267 il_offset(jp_J,:)=FLOOR(REAL(il_rho(jp_J)-1,dp)*0.5) 268 ENDIF 269 270 !3-2-3 check domain validity 271 IF( cn_coord0 /= '' )THEN 272 CALL grid_check_dom(tl_coord0, il_imin, il_imax, il_jmin, il_jmax) 273 ENDIF 274 275 !3-2-4 check coincidence between coarse and fine grid 276 IF( cn_coord0 /= '' )THEN 277 CALL grid_check_coincidence( tl_coord0, tl_coord1, & 278 & il_imin, il_imax, & 279 & il_jmin, il_jmax, & 280 & il_rho(:) ) 281 ENDIF 282 283 IF( .NOT. ASSOCIATED(tl_multi%t_file) )THEN 284 CALL logger_error("CREATE BATHY: no file to work on. "//& 352 ! check domain indices 353 ! compute coarse grid indices around fine grid 354 il_ind(:,:)=grid_get_coarse_index( tl_coord0, tl_coord1, & 355 & id_rho=il_rho(:) ) 356 357 il_imin0=il_ind(jp_I,1) ; il_imax0=il_ind(jp_I,2) 358 il_jmin0=il_ind(jp_J,1) ; il_jmax0=il_ind(jp_J,2) 359 360 ! check domain validity 361 CALL grid_check_dom(tl_coord0, il_imin0, il_imax0, il_jmin0, il_jmax0) 362 363 ! check coincidence between coarse and fine grid 364 CALL grid_check_coincidence( tl_coord0, tl_coord1, & 365 & il_imin0, il_imax0, & 366 & il_jmin0, il_jmax0, & 367 & il_rho(:) ) 368 369 IF( .NOT. ASSOCIATED(tl_multi%t_mpp) )THEN 370 CALL logger_error("CREATE BATHY: no mpp file to work on. "//& 285 371 & "check cn_varfile in namelist.") 286 372 ELSE 373 287 374 ALLOCATE( tl_var( tl_multi%i_nvar ) ) 288 375 jk=0 289 DO ji=1,tl_multi%i_nfile 290 WRITE(cl_data,'(a,i2.2)') 'data_',jk+1 291 IF( .NOT. ASSOCIATED(tl_multi%t_file(ji)%t_var) )THEN 292 CALL logger_error("CREATE BATHY: no variable to work on for "//& 293 & "file"//TRIM(tl_multi%t_file(ji)%c_name)//& 376 DO ji=1,tl_multi%i_nmpp 377 378 WRITE(cl_data,'(a,i2.2)') 'data-',jk+1 379 IF( .NOT. ASSOCIATED(tl_multi%t_mpp(ji)%t_proc(1)%t_var) )THEN 380 381 CALL logger_fatal("CREATE BATHY: no variable to work on for "//& 382 & "mpp file"//TRIM(tl_multi%t_mpp(ji)%c_name)//& 294 383 & ". check cn_varfile in namelist.") 295 ELSEIF( TRIM(tl_multi%t_file(ji)%c_name) == TRIM(cl_data) )THEN 296 DO jj=1,tl_multi%t_file(ji)%i_nvar 384 385 ELSEIF( TRIM(tl_multi%t_mpp(ji)%c_name) == TRIM(cl_data) )THEN 386 387 !- use input matrix to initialise variable 388 DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 297 389 jk=jk+1 298 tl_tmp= tl_multi%t_file(ji)%t_var(jj)299 !- use input matrix to initialise variable390 tl_tmp=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)) 391 300 392 tl_var(jk)=create_bathy_matrix(tl_tmp, tl_coord1) 301 393 ENDDO 394 ! clean 395 CALL var_clean(tl_tmp) 396 302 397 ELSE 303 ! open file 304 tl_file=file_init(TRIM(tl_multi%t_file(ji)%c_name)) 305 CALL iom_open(tl_file) 398 399 tl_mpp=mpp_init( file_init(TRIM(tl_multi%t_mpp(ji)%c_name)) ) 400 CALL grid_get_info(tl_mpp) 401 402 ! open mpp file 403 CALL iom_mpp_open(tl_mpp) 306 404 307 405 ! get or check depth value 308 IF( tl_file%i_depthid /= 0 )THEN 406 IF( tl_multi%t_mpp(ji)%t_proc(1)%i_depthid /= 0 )THEN 407 il_varid=tl_multi%t_mpp(ji)%t_proc(1)%i_depthid 309 408 IF( ASSOCIATED(tl_depth%d_value) )THEN 409 tl_tmp=iom_mpp_read_var(tl_mpp,il_varid) 310 410 IF( ANY( tl_depth%d_value(:,:,:,:) /= & 311 411 & tl_tmp%d_value(:,:,:,:) ) )THEN 312 412 CALL logger_fatal("CREATE BATHY: depth value from "//& 313 & TRIM(tl_multi%t_ file(ji)%c_name)//" not conform "//&413 & TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//& 314 414 & " to those from former file(s).") 315 415 ENDIF 416 CALL var_clean(tl_tmp) 316 417 ELSE 317 tl_depth=iom_ read_var(tl_file,tl_file%i_depthid)418 tl_depth=iom_mpp_read_var(tl_mpp,il_varid) 318 419 ENDIF 319 420 ENDIF 320 421 321 422 ! get or check time value 322 IF( tl_file%i_timeid /= 0 )THEN 423 IF( tl_multi%t_mpp(ji)%t_proc(1)%i_timeid /= 0 )THEN 424 il_varid=tl_multi%t_mpp(ji)%t_proc(1)%i_timeid 323 425 IF( ASSOCIATED(tl_time%d_value) )THEN 426 tl_tmp=iom_mpp_read_var(tl_mpp,il_varid) 324 427 IF( ANY( tl_time%d_value(:,:,:,:) /= & 325 428 & tl_tmp%d_value(:,:,:,:) ) )THEN 326 429 CALL logger_fatal("CREATE BATHY: time value from "//& 327 & TRIM(tl_multi%t_ file(ji)%c_name)//" not conform "//&430 & TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//& 328 431 & " to those from former file(s).") 329 432 ENDIF 433 CALL var_clean(tl_tmp) 330 434 ELSE 331 tl_time=iom_ read_var(tl_file,tl_file%i_timeid)435 tl_time=iom_mpp_read_var(tl_mpp,il_varid) 332 436 ENDIF 333 437 ENDIF 334 438 335 IF( ANY( tl_file%t_dim(1:2)%i_len /= & 336 & tl_coord0%t_dim(1:2)%i_len) )THEN 337 DO jj=1,tl_multi%t_file(ji)%i_nvar 439 ! close mpp file 440 CALL iom_mpp_close(tl_mpp) 441 442 IF( ANY( tl_mpp%t_dim(1:2)%i_len /= & 443 & tl_coord0%t_dim(1:2)%i_len) )THEN 444 !- extract bathymetry from fine grid bathymetry 445 DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 338 446 jk=jk+1 339 tl_tmp= tl_multi%t_file(ji)%t_var(jj)340 !- extract bathymetry from fine grid bathymetry341 tl_var(jk)=create_bathy_extract( tl_tmp, tl_ file, &447 tl_tmp=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)) 448 449 tl_var(jk)=create_bathy_extract( tl_tmp, tl_mpp, & 342 450 & tl_coord1 ) 343 451 ENDDO 452 ! clean 453 CALL var_clean(tl_tmp) 344 454 ELSE 345 DO jj=1,tl_multi%t_file(ji)%i_nvar 455 !- get bathymetry from coarse grid bathymetry 456 DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 346 457 jk=jk+1 347 tl_tmp=tl_multi%t_file(ji)%t_var(jj) 348 !- get bathymetry from coarse grid bathymetry 349 tl_var(jk)=create_bathy_get_var( tl_tmp, tl_file, & 350 & il_imin, il_jmin, & 351 & il_imax, il_jmax, & 352 & il_offset(:,:), & 458 tl_tmp=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)) 459 460 il_offset(:,:)= grid_get_fine_offset(tl_coord0, & 461 & il_imin0, il_jmin0, & 462 & il_imax0, il_jmax0, & 463 & tl_coord1, & 464 & il_rho(:), & 465 & TRIM(tl_tmp%c_point) ) 466 467 tl_var(jk)=create_bathy_get_var( tl_tmp, tl_mpp, & 468 & il_imin0, il_jmin0, & 469 & il_imax0, il_jmax0, & 470 & il_offset(:,:), & 353 471 & il_rho(:) ) 354 472 ENDDO 473 ! clean 474 CALL var_clean(tl_tmp) 355 475 ENDIF 356 476 357 ! close file358 CALL iom_close(tl_file)359 477 ! clean structure 360 CALL file_clean(tl_file) 478 CALL mpp_clean(tl_mpp) 479 361 480 ENDIF 362 481 ENDDO … … 364 483 365 484 DO jk=1,tl_multi%i_nvar 366 ! 6-forced min and max value485 ! forced min and max value 367 486 CALL var_limit_value(tl_var(jk)) 368 487 369 !7- fill closed sea 370 IF( TRIM(tl_var(jk)%c_stdname) == 'bathymetry' .AND. & 371 ln_fillclosed )THEN 488 ! fill closed sea 489 IF( ln_fillclosed )THEN 372 490 ALLOCATE( il_mask(tl_var(jk)%t_dim(1)%i_len, & 373 491 & tl_var(jk)%t_dim(2)%i_len) ) 374 492 375 ! 7-1split domain in N sea subdomain493 ! split domain in N sea subdomain 376 494 il_mask(:,:)=grid_split_domain(tl_var(jk)) 377 495 378 ! 7-2fill smallest domain496 ! fill smallest domain 379 497 CALL grid_fill_small_dom( tl_var(jk), il_mask(:,:) ) 380 498 … … 382 500 ENDIF 383 501 384 ! 8-filter502 ! filter 385 503 CALL filter_fill_value(tl_var(jk)) 386 504 387 !9- check bathymetry 505 ! check bathymetry 506 dl_minbat=MINVAL(tl_var(jk)%d_value(:,:,:,:)) 388 507 IF( TRIM(tl_var(jk)%c_stdname) == 'bathymetry' .AND. & 389 & MINVAL(tl_var(jk)%d_value(:,:,:,:)) <= 0._dp )THEN 508 & dl_minbat <= 0._dp )THEN 509 CALL logger_debug("CREATE BATHY: min value "//TRIM(fct_str(dl_minbat))) 390 510 CALL logger_error("CREATE BATHY: Bathymetry has value <= 0") 391 511 ENDIF 512 392 513 ENDDO 393 514 394 395 !10- create file 396 tl_fileout=file_init(TRIM(cn_fileout),id_perio=in_perio1) 397 398 !10-1 add dimension 515 ! create file 516 tl_fileout=file_init(TRIM(cn_fileout)) 517 518 ! add dimension 399 519 tl_dim(:)=var_max_dim(tl_var(:)) 400 520 … … 403 523 ENDDO 404 524 405 ! 10-2add variables525 ! add variables 406 526 IF( ALL( tl_dim(1:2)%l_use ) )THEN 407 527 528 ! open mpp files 529 CALL iom_mpp_open(tl_coord1) 530 408 531 ! add longitude 409 tl_lon=iom_ read_var(tl_coord1,'longitude')532 tl_lon=iom_mpp_read_var(tl_coord1,'longitude') 410 533 CALL file_add_var(tl_fileout, tl_lon) 411 534 CALL var_clean(tl_lon) 412 535 413 536 ! add latitude 414 tl_lat=iom_ read_var(tl_coord1,'latitude')537 tl_lat=iom_mpp_read_var(tl_coord1,'latitude') 415 538 CALL file_add_var(tl_fileout, tl_lat) 416 539 CALL var_clean(tl_lat) 540 541 ! close mpp files 542 CALL iom_mpp_close(tl_coord1) 417 543 418 544 ENDIF … … 435 561 CALL var_clean(tl_var(jk)) 436 562 ENDDO 437 438 !10-3 add some attribute 563 DEALLOCATE(tl_var) 564 565 ! add some attribute 439 566 tl_att=att_init("Created_by","SIREN create_bathy") 440 567 CALL file_add_att(tl_fileout, tl_att) … … 447 574 il_attid=0 448 575 IF( ASSOCIATED(tl_fileout%t_att) )THEN 449 il_attid=att_get_i d(tl_fileout%t_att(:),'periodicity')576 il_attid=att_get_index(tl_fileout%t_att(:),'periodicity') 450 577 ENDIF 451 578 IF( tl_coord1%i_perio >= 0 .AND. il_attid == 0 )THEN … … 454 581 ENDIF 455 582 583 ! add attribute east west overlap 456 584 il_attid=0 457 585 IF( ASSOCIATED(tl_fileout%t_att) )THEN 458 il_attid=att_get_i d(tl_fileout%t_att(:),'ew_overlap')586 il_attid=att_get_index(tl_fileout%t_att(:),'ew_overlap') 459 587 ENDIF 460 588 IF( tl_coord1%i_ew >= 0 .AND. il_attid == 0 )THEN … … 462 590 CALL file_add_att(tl_fileout,tl_att) 463 591 ENDIF 464 465 ! 10-4create file592 593 ! create file 466 594 CALL iom_create(tl_fileout) 467 595 468 ! 10-5write file596 ! write file 469 597 CALL iom_write_file(tl_fileout) 470 598 471 ! 10-6close file599 ! close file 472 600 CALL iom_close(tl_fileout) 473 IF( cn_coord0 /= '' ) CALL iom_close(tl_coord0) 474 475 !11- clean 476 DEALLOCATE(tl_var) 601 602 ! clean 603 CALL att_clean(tl_att) 477 604 478 605 CALL file_clean(tl_fileout) 479 CALL file_clean(tl_coord1)480 CALL file_clean(tl_coord0)606 CALL mpp_clean(tl_coord1) 607 CALL mpp_clean(tl_coord0) 481 608 482 609 ! close log file … … 484 611 CALL logger_close() 485 612 486 !> @endcode487 613 CONTAINS 488 614 !------------------------------------------------------------------- 489 615 !> @brief 490 !> This subroutine616 !> This function create variable, filled with matrix value 491 617 !> 492 618 !> @details 619 !> A variable is create with the same name that the input variable, 620 !> and with dimension of the coordinate file.<br/> 621 !> Then the variable array of value is split into equal subdomain. 622 !> Each subdomain is filled with the corresponding value of the matrix. 493 623 !> 494 624 !> @author J.Paul 495 !> - Nov , 2013- Initial Version625 !> - November, 2013- Initial Version 496 626 !> 497 !> @param[in] 627 !> @param[in] td_var variable structure 628 !> @param[in] td_coord coordinate file structure 629 !> @return variable structure 498 630 !------------------------------------------------------------------- 499 !> @code500 631 FUNCTION create_bathy_matrix(td_var, td_coord) 501 632 IMPLICIT NONE 502 633 ! Argument 503 TYPE(TVAR) 504 TYPE(T FILE), INTENT(IN) :: td_coord634 TYPE(TVAR), INTENT(IN) :: td_var 635 TYPE(TMPP), INTENT(IN) :: td_coord 505 636 506 637 ! function … … 508 639 509 640 ! local variable 510 INTEGER(i4) :: il_ighost 511 INTEGER(i4) :: il_jghost 512 INTEGER(i4) , DIMENSION(2) :: il_xghost 641 INTEGER(i4) , DIMENSION(2,2) :: il_xghost 513 642 INTEGER(i4) , DIMENSION(3) :: il_dim 514 643 INTEGER(i4) , DIMENSION(3) :: il_size … … 522 651 523 652 TYPE(TVAR) :: tl_lon 524 TYPE(TVAR) :: tl_lat525 TYPE(TVAR) :: tl_var526 653 TYPE(TDIM) , DIMENSION(ip_maxdim) :: tl_dim 654 655 TYPE(TMPP) :: tl_coord 527 656 528 657 ! loop indices … … 532 661 !---------------------------------------------------------------- 533 662 534 !1- read output grid 535 tl_lon=iom_read_var(td_coord,'longitude') 536 tl_lat=iom_read_var(td_coord,'latitude') 537 538 !2- look for ghost cell 539 il_xghost(:)=grid_get_ghost( tl_lon, tl_lat ) 540 541 il_ighost=il_xghost(1)*ig_ghost 542 il_jghost=il_xghost(2)*ig_ghost 543 544 !3- write value on grid 545 !3-1 get matrix dimension 663 ! copy structure 664 tl_coord=mpp_copy(td_coord) 665 666 ! use only edge processor 667 CALL mpp_get_contour(tl_coord) 668 669 ! open useful processor 670 CALL iom_mpp_open(tl_coord) 671 672 ! read output grid 673 tl_lon=iom_mpp_read_var(tl_coord,'longitude') 674 675 ! look for ghost cell 676 il_xghost(:,:)=grid_get_ghost( tl_coord ) 677 678 ! close processor 679 CALL iom_mpp_close(tl_coord) 680 ! clean 681 CALL mpp_clean(tl_coord) 682 683 ! remove ghost cell 684 CALL grid_del_ghost(tl_lon, il_xghost(:,:)) 685 686 ! write value on grid 687 ! get matrix dimension 546 688 il_dim(:)=td_var%t_dim(1:3)%i_len 547 !3-2 output dimension 548 tl_dim(:)=tl_lon%t_dim(:) 549 550 ! remove ghost cell 551 tl_dim(1)%i_len=tl_dim(1)%i_len - 2*il_xghost(1)*ig_ghost 552 tl_dim(2)%i_len=tl_dim(2)%i_len - 2*il_xghost(2)*ig_ghost 553 554 !3-3 split output domain in N subdomain depending of matrix dimension 689 ! output dimension 690 tl_dim(:)=dim_copy(tl_lon%t_dim(:)) 691 ! clean 692 CALL var_clean(tl_lon) 693 694 ! split output domain in N subdomain depending of matrix dimension 555 695 il_size(:) = tl_dim(1:3)%i_len / il_dim(:) 556 696 il_rest(:) = MOD(tl_dim(1:3)%i_len, il_dim(:)) … … 563 703 ! add rest to last cell 564 704 il_ishape(il_dim(1)+1)=il_ishape(il_dim(1)+1)+il_rest(1) 565 566 705 567 706 ALLOCATE( il_jshape(il_dim(2)+1) ) … … 581 720 il_kshape(il_dim(3)+1)=il_kshape(il_dim(3)+1)+il_rest(3) 582 721 583 ! 3-3 write ouput tableof value722 ! write ouput array of value 584 723 ALLOCATE(dl_value( tl_dim(1)%i_len, & 585 724 & tl_dim(2)%i_len, & … … 602 741 ENDDO 603 742 604 ! 3-4initialise variable with value605 tl_var=var_init(TRIM(td_var%c_name),dl_value(:,:,:,:))743 ! initialise variable with value 744 create_bathy_matrix=var_init(TRIM(td_var%c_name),dl_value(:,:,:,:)) 606 745 607 746 DEALLOCATE(dl_value) 608 747 609 ! 4-add ghost cell610 CALL grid_add_ghost( tl_var,il_ighost,il_jghost)611 612 ! 5- save result613 create_bathy_matrix=tl_var748 ! add ghost cell 749 CALL grid_add_ghost(create_bathy_matrix, il_xghost(:,:)) 750 751 ! clean 752 CALL dim_clean(tl_dim(:)) 614 753 615 754 END FUNCTION create_bathy_matrix 616 !> @endcode617 755 !------------------------------------------------------------------- 618 756 !> @brief 619 !> This subroutine 757 !> This function extract variable from file over coordinate domain and 758 !> return variable structure 620 759 !> 621 !> @details 760 !> @author J.Paul 761 !> - November, 2013- Initial Version 622 762 !> 623 !> @ author J.Paul624 !> - Nov, 2013- Initial Version625 !> 626 !> @ param[in]763 !> @param[in] td_var variable structure 764 !> @param[in] td_mpp mpp file structure 765 !> @param[in] td_coord coordinate file structure 766 !> @return variable structure 627 767 !------------------------------------------------------------------- 628 !> @code 629 FUNCTION create_bathy_extract(td_var, td_file, & 768 FUNCTION create_bathy_extract(td_var, td_mpp, & 630 769 & td_coord) 631 770 IMPLICIT NONE 632 771 ! Argument 633 TYPE(TVAR) 634 TYPE(T FILE), INTENT(IN) :: td_file635 TYPE(T FILE), INTENT(IN) :: td_coord772 TYPE(TVAR), INTENT(IN) :: td_var 773 TYPE(TMPP), INTENT(IN) :: td_mpp 774 TYPE(TMPP), INTENT(IN) :: td_coord 636 775 637 776 ! function … … 639 778 640 779 ! local variable 641 INTEGER(i4), DIMENSION(2,2,2) :: il_ind 642 643 INTEGER(i4) :: il_pivot 644 INTEGER(i4) :: il_perio 780 INTEGER(i4), DIMENSION(2,2) :: il_ind 645 781 646 782 INTEGER(i4) :: il_imin … … 648 784 INTEGER(i4) :: il_imax 649 785 INTEGER(i4) :: il_jmax 650 651 TYPE(TFILE) :: tl_file652 786 653 787 TYPE(TMPP) :: tl_mpp … … 661 795 !---------------------------------------------------------------- 662 796 663 IF( td_file%i_id == 0)THEN664 CALL logger_error("CREATE BATHY EXTRACT: file"//&665 & TRIM(td_file%c_name)//" not opened ")797 IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN 798 CALL logger_error("CREATE BATHY EXTRACT: no processor associated "//& 799 & "to mpp "//TRIM(td_mpp%c_name)) 666 800 ELSE 667 801 668 802 !init 669 tl_file=td_file 670 671 !1- open file 672 CALL iom_open(tl_file) 673 674 ! get periodicity 675 il_pivot=grid_get_pivot(tl_file) 676 il_perio=grid_get_perio(tl_file,il_pivot) 677 678 tl_file%i_perio=il_perio 679 680 !2- compute file grid indices around coord grid 681 il_ind(:,:,:)=grid_get_coarse_index(tl_file, td_coord ) 682 683 il_imin=il_ind(1,1,1) ; il_imax=il_ind(1,2,1) 684 il_jmin=il_ind(2,1,1) ; il_jmax=il_ind(2,2,1) 685 686 IF( ANY( il_ind(:,:,2) /= 0 ) )THEN 687 CALL logger_error("CREATE BATHY EXTRACT: something wrong "//& 688 & " find offset when extracting data") 689 ENDIF 690 !3- check grid coincidence 691 CALL grid_check_coincidence( tl_file, td_coord, & 803 tl_mpp=mpp_copy(td_mpp) 804 805 ! compute file grid indices around coord grid 806 il_ind(:,:)=grid_get_coarse_index(tl_mpp, td_coord ) 807 808 il_imin=il_ind(1,1) ; il_imax=il_ind(1,2) 809 il_jmin=il_ind(2,1) ; il_jmax=il_ind(2,2) 810 811 ! check grid coincidence 812 CALL grid_check_coincidence( tl_mpp, td_coord, & 692 813 & il_imin, il_imax, & 693 814 & il_jmin, il_jmax, & 694 815 & (/1, 1, 1/) ) 695 816 696 ! 4-compute domain697 tl_dom=dom_init(tl_ file,&817 ! compute domain 818 tl_dom=dom_init(tl_mpp, & 698 819 & il_imin, il_imax, & 699 820 & il_jmin, il_jmax) 700 821 701 ! close file 702 CALL iom_close(tl_file) 703 704 !5- read bathymetry on domain (ugly way to do it, have to work on it) 705 !5-1 init mpp structure 706 tl_mpp=mpp_init(tl_file) 707 708 CALL file_clean(tl_file) 709 710 !5-2 get processor to be used 711 CALL mpp_get_use( tl_mpp, tl_dom ) 712 713 !5-3 open mpp files 714 CALL iom_mpp_open(tl_mpp) 715 716 !5-4 read variable on domain 717 tl_var=iom_mpp_read_var(tl_mpp,TRIM(td_var%c_name),td_dom=tl_dom) 718 719 !5-5 close mpp file 720 CALL iom_mpp_close(tl_mpp) 721 722 !6- add ghost cell 723 CALL grid_add_ghost(tl_var,tl_dom%i_ighost,tl_dom%i_jghost) 724 725 !7- check result 822 ! open mpp files over domain 823 CALL iom_dom_open(tl_mpp, tl_dom) 824 825 ! read variable on domain 826 tl_var=iom_dom_read_var(tl_mpp,TRIM(td_var%c_name),tl_dom) 827 828 ! close mpp file 829 CALL iom_dom_close(tl_mpp) 830 831 ! add ghost cell 832 CALL grid_add_ghost(tl_var,tl_dom%i_ghost(:,:)) 833 834 ! check result 726 835 IF( ANY( tl_var%t_dim(:)%l_use .AND. & 727 836 & tl_var%t_dim(:)%i_len /= td_coord%t_dim(:)%i_len) )THEN … … 743 852 ENDIF 744 853 745 ! 8-add attribute to variable854 ! add attribute to variable 746 855 tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name))) 747 856 CALL var_move_att(tl_var, tl_att) 748 857 749 tl_att=att_init('src_i -indices',(/tl_dom%i_imin, tl_dom%i_imax/))858 tl_att=att_init('src_i_indices',(/tl_dom%i_imin, tl_dom%i_imax/)) 750 859 CALL var_move_att(tl_var, tl_att) 751 860 752 tl_att=att_init('src_j -indices',(/tl_dom%i_jmin, tl_dom%i_jmax/))861 tl_att=att_init('src_j_indices',(/tl_dom%i_jmin, tl_dom%i_jmax/)) 753 862 CALL var_move_att(tl_var, tl_att) 754 863 755 ! 9-save result756 create_bathy_extract= tl_var864 ! save result 865 create_bathy_extract=var_copy(tl_var) 757 866 758 867 ! clean structure 868 CALL att_clean(tl_att) 759 869 CALL var_clean(tl_var) 760 870 CALL mpp_clean(tl_mpp) … … 762 872 763 873 END FUNCTION create_bathy_extract 764 !> @endcode765 874 !------------------------------------------------------------------- 766 875 !> @brief 767 !> This subroutine 876 !> This function get coarse grid variable, interpolate variable, and return 877 !> variable structure over fine grid 768 878 !> 769 !> @details 879 !> @author J.Paul 880 !> - November, 2013- Initial Version 770 881 !> 771 !> @author J.Paul 772 !> - Nov, 2013- Initial Version 773 !> 774 !> @param[in] td_var : variable structure 775 !> @param[in] td_file : file structure 776 !> @param[in] id_imin : i-direction lower left corner indice 777 !> @param[in] id_imax : i-direction upper right corner indice 778 !> @param[in] id_jmin : j-direction lower left corner indice 779 !> @param[in] id_jmax : j-direction upper right corner indice 780 !> @param[in] id_rho : table of refinement factor 882 !> @param[in] td_var variable structure 883 !> @param[in] td_mpp mpp file structure 884 !> @param[in] id_imin i-direction lower left corner indice 885 !> @param[in] id_imax i-direction upper right corner indice 886 !> @param[in] id_jmin j-direction lower left corner indice 887 !> @param[in] id_jmax j-direction upper right corner indice 888 !> @param[in] id_offset offset between fine grid and coarse grid 889 !> @param[in] id_rho array of refinement factor 890 !> @return variable structure 781 891 !------------------------------------------------------------------- 782 !> @code 783 FUNCTION create_bathy_get_var(td_var, td_file, & 892 FUNCTION create_bathy_get_var(td_var, td_mpp, & 784 893 & id_imin, id_jmin, & 785 894 & id_imax, id_jmax, & … … 789 898 ! Argument 790 899 TYPE(TVAR) , INTENT(IN) :: td_var 791 TYPE(T FILE), INTENT(IN) :: td_file900 TYPE(TMPP) , INTENT(IN) :: td_mpp 792 901 INTEGER(i4), INTENT(IN) :: id_imin 793 902 INTEGER(i4), INTENT(IN) :: id_imax … … 801 910 802 911 ! local variable 803 INTEGER(i4) :: il_pivot804 INTEGER(i4) :: il_perio805 806 TYPE(TFILE) :: tl_file807 808 912 TYPE(TMPP) :: tl_mpp 809 810 913 TYPE(TATT) :: tl_att 811 812 914 TYPE(TVAR) :: tl_var 813 814 915 TYPE(TDOM) :: tl_dom 916 917 INTEGER(i4) :: il_size 918 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho 815 919 816 920 ! loop indices 817 921 !---------------------------------------------------------------- 818 922 IF( ANY(SHAPE(id_offset(:,:)) /= 2) )THEN 819 CALL logger_error("CREATE BATHY GET VAR: invalid dimensio of "//&820 & "offset table")923 CALL logger_error("CREATE BATHY GET VAR: invalid dimension of "//& 924 & "offset array") 821 925 ENDIF 822 926 823 !init 824 tl_file=td_file 825 826 !1- open file 827 CALL iom_open(tl_file) 828 829 ! get periodicity 830 il_pivot=grid_get_pivot(tl_file) 831 il_perio=grid_get_perio(tl_file,il_pivot) 832 833 tl_file%i_perio=il_perio 834 835 !2- compute domain 836 tl_dom=dom_init(tl_file, & 927 ! copy structure 928 tl_mpp=mpp_copy(td_mpp) 929 930 !- compute domain 931 tl_dom=dom_init(tl_mpp, & 837 932 & id_imin, id_imax, & 838 933 & id_jmin, id_jmax) 839 934 840 CALL dom_print(tl_dom) 841 print *,'id_offset ',id_offset(:,:) 842 !3- close file 843 CALL iom_close(tl_file) 844 845 !4- add extra band (if possible) to compute interpolation 935 !- add extra band (if possible) to compute interpolation 846 936 CALL dom_add_extra(tl_dom) 847 937 848 !5- read bathymetry on domain (ugly way to do it, have to work on it) 849 !5-1 init mpp sturcutre 850 tl_mpp=mpp_init(tl_file) 851 852 CALL file_clean(tl_file) 853 854 !5-2 get processor to be used 855 CALL mpp_get_use( tl_mpp, tl_dom ) 856 857 !5-3 open mpp files 858 CALL iom_mpp_open(tl_mpp) 859 860 !5-4 read variable value on domain 861 tl_var=iom_mpp_read_var(tl_mpp,TRIM(td_var%c_name),td_dom=tl_dom) 862 863 !5-5 close mpp files 864 CALL iom_mpp_close(tl_mpp) 865 866 !6- interpolate variable 867 CALL create_bathy_interp(tl_var, id_rho(:), id_offset(:,:)) 868 869 !7- remove extraband added to domain 870 CALL dom_del_extra( tl_var, tl_dom, id_rho(:) ) 871 872 !8- add ghost cell 873 CALL grid_add_ghost(tl_var,tl_dom%i_ighost,tl_dom%i_jghost) 938 !- open mpp files over domain 939 CALL iom_dom_open(tl_mpp, tl_dom) 940 941 !- read variable value on domain 942 tl_var=iom_dom_read_var(tl_mpp,TRIM(td_var%c_name),tl_dom) 943 944 !- close mpp files 945 CALL iom_dom_close(tl_mpp) 946 947 il_size=SIZE(id_rho(:)) 948 ALLOCATE( il_rho(il_size) ) 949 il_rho(:)=id_rho(:) 950 951 !- interpolate variable 952 CALL create_bathy_interp(tl_var, il_rho(:), id_offset(:,:)) 953 954 !- remove extraband added to domain 955 CALL dom_del_extra( tl_var, tl_dom, il_rho(:) ) 956 957 !- add ghost cell 958 CALL grid_add_ghost(tl_var,tl_dom%i_ghost(:,:)) 874 959 875 ! 9- add attribute to variable960 !- add attribute to variable 876 961 tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name))) 877 962 CALL var_move_att(tl_var, tl_att) 878 963 879 tl_att=att_init('src_i -indices',(/tl_dom%i_imin, tl_dom%i_imax/))964 tl_att=att_init('src_i_indices',(/tl_dom%i_imin, tl_dom%i_imax/)) 880 965 CALL var_move_att(tl_var, tl_att) 881 966 882 tl_att=att_init('src_j -indices',(/tl_dom%i_jmin, tl_dom%i_jmax/))967 tl_att=att_init('src_j_indices',(/tl_dom%i_jmin, tl_dom%i_jmax/)) 883 968 CALL var_move_att(tl_var, tl_att) 884 969 885 !10- save result 886 create_bathy_get_var=tl_var 887 888 !11- clean structure 970 IF( .NOT. ALL(id_rho(:)==1) )THEN 971 tl_att=att_init("refinment_factor",(/id_rho(jp_I),id_rho(jp_J)/)) 972 CALL var_move_att(tl_var, tl_att) 973 ENDIF 974 975 DEALLOCATE( il_rho ) 976 977 !- save result 978 create_bathy_get_var=var_copy(tl_var) 979 980 !- clean structure 981 CALL att_clean(tl_att) 982 CALL var_clean(tl_var) 889 983 CALL mpp_clean(tl_mpp) 890 984 891 985 END FUNCTION create_bathy_get_var 892 !> @endcode893 986 !------------------------------------------------------------------- 894 987 !> @brief 895 !> This subroutine 988 !> This subroutine interpolate variable 896 989 !> 897 !> @details 990 !> @author J.Paul 991 !> - November, 2013- Initial Version 898 992 !> 899 !> @ author J.Paul900 !> - Nov, 2013- Initial Version901 !> 902 !> @param[in] 903 !> @ todo993 !> @param[inout] td_var variable structure 994 !> @param[in] id_rho array of refinment factor 995 !> @param[in] id_offset array of offset between fine and coarse grid 996 !> @param[in] id_iext i-direction size of extra bands (default=im_minext) 997 !> @param[in] id_jext j-direction size of extra bands (default=im_minext) 904 998 !------------------------------------------------------------------- 905 !> @code906 999 SUBROUTINE create_bathy_interp( td_var, & 907 1000 & id_rho, & … … 919 1012 920 1013 ! local variable 921 TYPE(TVAR) :: tl_var922 1014 TYPE(TVAR) :: tl_mask 923 1015 … … 929 1021 ! loop indices 930 1022 !---------------------------------------------------------------- 931 932 ! copy variable933 tl_var=td_var934 1023 935 1024 !WARNING: two extrabands are required for cubic interpolation … … 952 1041 ENDIF 953 1042 954 ! 1-work on mask955 ! 1-1create mask956 ALLOCATE(bl_mask(t l_var%t_dim(1)%i_len, &957 & t l_var%t_dim(2)%i_len, &958 & t l_var%t_dim(3)%i_len, &959 & t l_var%t_dim(4)%i_len) )1043 ! work on mask 1044 ! create mask 1045 ALLOCATE(bl_mask(td_var%t_dim(1)%i_len, & 1046 & td_var%t_dim(2)%i_len, & 1047 & td_var%t_dim(3)%i_len, & 1048 & td_var%t_dim(4)%i_len) ) 960 1049 961 1050 bl_mask(:,:,:,:)=1 962 WHERE(t l_var%d_value(:,:,:,:)==tl_var%d_fill) bl_mask(:,:,:,:)=0963 964 SELECT CASE(TRIM(t l_var%c_point))1051 WHERE(td_var%d_value(:,:,:,:)==td_var%d_fill) bl_mask(:,:,:,:)=0 1052 1053 SELECT CASE(TRIM(td_var%c_point)) 965 1054 CASE DEFAULT ! 'T' 966 tl_mask=var_init('tmask', bl_mask(:,:,:,:), td_dim=t l_var%t_dim(:))967 CASE('U')968 tl_mask=var_init('umask', bl_mask(:,:,:,:), td_dim=tl_var%t_dim(:))969 CASE('V')970 tl_mask=var_init('vmask', bl_mask(:,:,:,:), td_dim=tl_var%t_dim(:))971 CASE('F')972 tl_mask=var_init('fmask', bl_mask(:,:,:,:), td_dim=tl_var%t_dim(:))1055 tl_mask=var_init('tmask', bl_mask(:,:,:,:), td_dim=td_var%t_dim(:), & 1056 & id_ew=td_var%i_ew ) 1057 CASE('U','V','F') 1058 CALL logger_fatal("CREATE BATHY INTERP: can not computed "//& 1059 & "interpolation on "//TRIM(td_var%c_point)//& 1060 & " grid point (variable "//TRIM(td_var%c_name)//& 1061 & "). check namelist.") 973 1062 END SELECT 974 1063 975 1064 DEALLOCATE(bl_mask) 976 1065 977 ! 1-2interpolate mask1066 ! interpolate mask 978 1067 CALL interp_fill_value( tl_mask, id_rho(:), & 979 1068 & id_offset=id_offset(:,:) ) 980 1069 981 ! 2-work on variable982 ! 2-0add extraband983 CALL extrap_add_extrabands(t l_var, il_iext, il_jext)984 985 ! 2-1extrapolate variable986 CALL extrap_fill_value( t l_var, id_offset=id_offset(:,:), &1070 ! work on variable 1071 ! add extraband 1072 CALL extrap_add_extrabands(td_var, il_iext, il_jext) 1073 1074 ! extrapolate variable 1075 CALL extrap_fill_value( td_var, id_offset=id_offset(:,:), & 987 1076 & id_rho=id_rho(:), & 988 1077 & id_iext=il_iext, id_jext=il_jext ) 989 1078 990 ! 2-2interpolate Bathymetry991 CALL interp_fill_value( t l_var, id_rho(:), &1079 ! interpolate Bathymetry 1080 CALL interp_fill_value( td_var, id_rho(:), & 992 1081 & id_offset=id_offset(:,:) ) 993 1082 994 ! 2-3remove extraband995 CALL extrap_del_extrabands(t l_var, il_iext*id_rho(jp_I), il_jext*id_rho(jp_J))996 997 ! 2-2-5keep original mask1083 ! remove extraband 1084 CALL extrap_del_extrabands(td_var, il_iext*id_rho(jp_I), il_jext*id_rho(jp_J)) 1085 1086 ! keep original mask 998 1087 WHERE( tl_mask%d_value(:,:,:,:) == 0 ) 999 t l_var%d_value(:,:,:,:)=tl_var%d_fill1088 td_var%d_value(:,:,:,:)=td_var%d_fill 1000 1089 END WHERE 1001 1002 !3- save result1003 td_var=tl_var1004 1090 1005 1091 ! clean variable structure 1006 1092 CALL var_clean(tl_mask) 1007 CALL var_clean(tl_var)1008 1093 1009 1094 END SUBROUTINE create_bathy_interp 1010 !> @endcode1011 1095 END PROGRAM create_bathy
Note: See TracChangeset
for help on using the changeset viewer.