Changeset 6225 for branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/TOOLS/SIREN/src/create_boundary.f90
- Timestamp:
- 2016-01-08T10:35:19+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/TOOLS/SIREN/src/create_boundary.f90
r4213 r6225 7 7 ! 8 8 ! DESCRIPTION: 9 !> @file 9 10 !> @brief 10 11 !> This program create boundary files. 11 12 !> 12 13 !> @details 13 !> Variables are read from standard output. 14 !> Then theses variables are interpolated on fine grid boundaries. 15 !> 16 !> @author 17 !> J.Paul 14 !> @section sec1 method 15 !> Variables are read from coarse grid standard output 16 !> and interpolated on fine grid or manually written.<br/> 17 !> @note 18 !> method could be different for each variable. 19 !> 20 !> @section sec2 how to 21 !> to create boundaries files:<br/> 22 !> @code{.sh} 23 !> ./SIREN/bin/create_boundary create_boundary.nam 24 !> @endcode 25 !> <br/> 26 !> \image html boundary_NEATL36_70.png 27 !> \image latex boundary_NEATL36_70.png 28 !> 29 !> @note 30 !> you could find a template of the namelist in templates directory. 31 !> 32 !> create_boundary.nam comprise 9 namelists:<br/> 33 !> - logger namelist (namlog) 34 !> - config namelist (namcfg) 35 !> - coarse grid namelist (namcrs) 36 !> - fine grid namelist (namfin) 37 !> - variable namelist (namvar) 38 !> - nesting namelist (namnst) 39 !> - boundary namelist (nambdy) 40 !> - vertical grid namelist (namzgr) 41 !> - output namelist (namout) 42 !> 43 !> @note 44 !> All namelists have to be in file create_boundary.nam, 45 !> however variables of those namelists are all optional. 46 !> 47 !> * _logger namelist (namlog)_:<br/> 48 !> - cn_logfile : log filename 49 !> - cn_verbosity : verbosity ('trace','debug','info', 50 !> 'warning','error','fatal','none') 51 !> - in_maxerror : maximum number of error allowed 52 !> 53 !> * _config namelist (namcfg)_:<br/> 54 !> - cn_varcfg : variable configuration file 55 !> (see ./SIREN/cfg/variable.cfg) 56 !> 57 !> * _coarse grid namelist (namcrs)_:<br/> 58 !> - cn_coord0 : coordinate file 59 !> - in_perio0 : NEMO periodicity index (see Model Boundary Condition in 60 !> [NEMO documentation](http://www.nemo-ocean.eu/About-NEMO/Reference-manuals)) 61 !> 62 !> * _fine grid namelist (namfin)_:<br/> 63 !> - cn_coord1 : coordinate file 64 !> - cn_bathy1 : bathymetry file 65 !> - in_perio1 : periodicity index 66 !> 67 !> * _vertical grid namelist (namzgr)_:<br/> 68 !> - dn_pp_to_be_computed : 69 !> - dn_ppsur : 70 !> - dn_ppa0 : 71 !> - dn_ppa1 : 72 !> - dn_ppa2 : 73 !> - dn_ppkth : 74 !> - dn_ppkth2 : 75 !> - dn_ppacr : 76 !> - dn_ppacr2 : 77 !> - dn_ppdzmin : 78 !> - dn_pphmax : 79 !> - in_nlevel : number of vertical level 80 !> 81 !> * _partial step namelist (namzps)_:<br/> 82 !> - dn_e3zps_mi : 83 !> - dn_e3zps_rat : 84 !> 85 !> * _variable namelist (namvar)_:<br/> 86 !> - cn_varinfo : list of variable and extra information about request(s) 87 !> to be used (separated by ',').<br/> 88 !> each elements of *cn_varinfo* is a string character.<br/> 89 !> it is composed of the variable name follow by ':', 90 !> then request(s) to be used on this variable.<br/> 91 !> request could be: 92 !> - int = interpolation method 93 !> - ext = extrapolation method 94 !> - flt = filter method 95 !> - unt = new units 96 !> - unf = unit scale factor (linked to new units) 97 !> 98 !> requests must be separated by ';'.<br/> 99 !> order of requests does not matter. 100 !> 101 !> informations about available method could be find in @ref interp, 102 !> @ref extrap and @ref filter.<br/> 103 !> 104 !> Example: 'votemper:int=linear;flt=hann;ext=dist_weight', 'vosaline:int=cubic' 105 !> @note 106 !> If you do not specify a method which is required, 107 !> default one is apply. 108 !> - cn_varfile : list of variable, and corresponding file<br/> 109 !> *cn_varfile* is the path and filename of the file where find 110 !> variable.<br/> 111 !> @note 112 !> *cn_varfile* could be a matrix of value, if you want to filled 113 !> manually variable value.<br/> 114 !> the variable array of value is split into equal subdomain.<br/> 115 !> Each subdomain is filled with the corresponding value 116 !> of the matrix.<br/> 117 !> separators used to defined matrix are: 118 !> - ',' for line 119 !> - '/' for row 120 !> - '\' for level<br/> 121 !> Example:<br/> 122 !> 3,2,3/1,4,5 => @f$ \left( \begin{array}{ccc} 123 !> 3 & 2 & 3 \\ 124 !> 1 & 4 & 5 \end{array} \right) @f$ 125 !> @warning 126 !> the same matrix is used for all boundaries. 127 !> 128 !> Examples: 129 !> - 'votemper:gridT.nc', 'vozocrtx:gridU.nc' 130 !> - 'votemper:10\25', 'vozocrtx:gridU.nc' 131 !> 132 !> * _nesting namelist (namnst)_:<br/> 133 !> - in_rhoi : refinement factor in i-direction 134 !> - in_rhoj : refinement factor in j-direction 135 !> 136 !> * _boundary namelist (nambdy)_:<br/> 137 !> - ln_north : use north boundary 138 !> - ln_south : use south boundary 139 !> - ln_east : use east boundary 140 !> - ln_west : use west boundary 141 !> - cn_north : north boundary indices on fine grid 142 !> *cn_north* is a string character defining boundary 143 !> segmentation.<br/> 144 !> segments are separated by '|'.<br/> 145 !> each segments of the boundary is composed of: 146 !> - indice of velocity (orthogonal to boundary .ie. 147 !> for north boundary, J-indice). 148 !> - indice of segemnt start (I-indice for north boundary) 149 !> - indice of segment end (I-indice for north boundary)<br/> 150 !> indices must be separated by ':' .<br/> 151 !> - optionally, boundary size could be added between '(' and ')' 152 !> in the first segment defined. 153 !> @note 154 !> boundary width is the same for all segments of one boundary. 155 !> 156 !> Examples: 157 !> - cn_north='index1,first1:last1(width)' 158 !> - cn_north='index1(width),first1:last1|index2,first2:last2' 159 !> \image html boundary_50.png 160 !> \image latex boundary_50.png 161 !> - cn_south : south boundary indices on fine grid 162 !> - cn_east : east boundary indices on fine grid 163 !> - cn_west : west boundary indices on fine grid 164 !> - ln_oneseg : use only one segment for each boundary or not 165 !> 166 !> * _output namelist (namout)_:<br/> 167 !> - cn_fileout : fine grid boundary basename 168 !> (cardinal and segment number will be automatically added) 169 !> - dn_dayofs : date offset in day (change only ouput file name) 170 !> - ln_extrap : extrapolate land point or not 171 !> 172 !> Examples: 173 !> - cn_fileout=boundary.nc<br/> 174 !> if time_counter (16/07/2015 00h) is read on input file (see varfile), 175 !> west boundary will be named boundary_west_y2015m07d16 176 !> - dn_dayofs=-2.<br/> 177 !> if you use day offset you get boundary_west_y2015m07d14 178 !> 179 !> 180 !> @author J.Paul 18 181 ! REVISION HISTORY: 19 !> @date Nov, 2013 - Initial Version 20 ! 182 !> @date November, 2013 - Initial Version 183 !> @date September, 2014 184 !> - add header for user 185 !> - take into account grid point to compue boundaries 186 !> - reorder output dimension for north and south boundaries 187 !> @date June, 2015 188 !> - extrapolate all land points, and add ln_extrap in namelist. 189 !> - allow to change unit. 190 !> @date July, 2015 191 !> - add namelist parameter to shift date of output file name. 192 !> 21 193 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 22 !>23 !> @todo24 194 !---------------------------------------------------------------------- 25 !> @code26 195 PROGRAM create_boundary 27 196 … … 42 211 USE dom ! domain manager 43 212 USE grid ! grid manager 44 USE vgrid ! v artical grid manager213 USE vgrid ! vertical grid manager 45 214 USE extrap ! extrapolation manager 46 215 USE interp ! interpolation manager … … 57 226 CHARACTER(LEN=lc) :: cl_bdyout 58 227 CHARACTER(LEN=lc) :: cl_data 228 CHARACTER(LEN=lc) :: cl_dimorder 229 CHARACTER(LEN=lc) :: cl_point 230 CHARACTER(LEN=lc) :: cl_fmt 59 231 60 232 INTEGER(i4) :: il_narg 61 233 INTEGER(i4) :: il_status 62 234 INTEGER(i4) :: il_fileid 63 INTEGER(i4) :: il_attid64 INTEGER(i4) :: il_dim65 235 INTEGER(i4) :: il_imin0 66 236 INTEGER(i4) :: il_imax0 67 237 INTEGER(i4) :: il_jmin0 68 238 INTEGER(i4) :: il_jmax0 239 INTEGER(i4) :: il_shift 69 240 INTEGER(i4) , DIMENSION(ip_maxdim) :: il_rho 70 241 INTEGER(i4) , DIMENSION(2,2) :: il_offset 71 INTEGER(i4) , DIMENSION(2,2 ,2):: il_ind242 INTEGER(i4) , DIMENSION(2,2) :: il_ind 72 243 73 244 LOGICAL :: ll_exist 74 75 TYPE(TFILE) :: tl_coord076 TYPE(TFILE) :: tl_bathy077 TYPE(TFILE) :: tl_coord178 TYPE(TFILE) :: tl_bathy179 TYPE(TFILE) :: tl_file80 TYPE(TFILE) :: tl_fileout81 82 TYPE(TMPP) :: tl_mpp83 84 TYPE(TMULTI) :: tl_multi85 245 86 246 TYPE(TATT) :: tl_att 87 247 248 TYPE(TVAR) :: tl_depth 249 TYPE(TVAR) :: tl_time 250 TYPE(TVAR) :: tl_var1 251 TYPE(TVAR) :: tl_var0 252 TYPE(TVAR) :: tl_lon1 253 TYPE(TVAR) :: tl_lat1 254 TYPE(TVAR) :: tl_lvl1 88 255 TYPE(TVAR) , DIMENSION(:) , ALLOCATABLE :: tl_level 89 256 TYPE(TVAR) , DIMENSION(:,:,:) , ALLOCATABLE :: tl_seglvl1 90 TYPE(TVAR) :: tl_var191 257 TYPE(TVAR) , DIMENSION(:,:,:) , ALLOCATABLE :: tl_segvar1 92 TYPE(TVAR) , DIMENSION(:,:) , ALLOCATABLE :: tl_seglon193 TYPE(TVAR) , DIMENSION(:,:) , ALLOCATABLE :: tl_seglat194 TYPE(TVAR) , DIMENSION(:,:) , ALLOCATABLE :: tl_var95 TYPE(TVAR) , DIMENSION(:) , ALLOCATABLE :: tl_lon196 TYPE(TVAR) , DIMENSION(:) , ALLOCATABLE :: tl_lat197 TYPE(TVAR) :: tl_depth98 TYPE(TVAR) :: tl_time99 TYPE(TVAR) :: tl_tmp100 258 101 259 TYPE(TDIM) , DIMENSION(ip_maxdim) :: tl_dim 260 261 TYPE(TDATE) :: tl_date 102 262 103 263 TYPE(TBDY) , DIMENSION(ip_ncard) :: tl_bdy 104 264 105 265 TYPE(TDOM) :: tl_dom0 106 TYPE(TDOM) , DIMENSION(:,:) , ALLOCATABLE :: tl_segdom1 266 TYPE(TDOM) :: tl_dom1 267 TYPE(TDOM) , DIMENSION(:,:,:) , ALLOCATABLE :: tl_segdom1 268 269 TYPE(TFILE) :: tl_fileout 270 271 TYPE(TMPP) :: tl_coord0 272 TYPE(TMPP) :: tl_coord1 273 TYPE(TMPP) :: tl_bathy1 274 TYPE(TMPP) :: tl_mpp 275 276 TYPE(TMULTI) :: tl_multi 107 277 108 278 ! loop indices 109 279 INTEGER(i4) :: jvar 280 INTEGER(i4) :: jpoint 110 281 INTEGER(i4) :: ji 111 282 INTEGER(i4) :: jj … … 115 286 ! namelist variable 116 287 ! namlog 117 CHARACTER(LEN=lc) :: cn_logfile = 'create_boundary.log' 118 CHARACTER(LEN=lc) :: cn_verbosity = 'warning' 288 CHARACTER(LEN=lc) :: cn_logfile = 'create_boundary.log' 289 CHARACTER(LEN=lc) :: cn_verbosity = 'warning' 290 INTEGER(i4) :: in_maxerror = 5 291 292 ! namcfg 293 CHARACTER(LEN=lc) :: cn_varcfg = 'variable.cfg' 119 294 120 295 ! namcrs 121 CHARACTER(LEN=lc) 122 INTEGER(i4) 296 CHARACTER(LEN=lc) :: cn_coord0 = '' 297 INTEGER(i4) :: in_perio0 = -1 123 298 124 299 ! namfin 125 CHARACTER(LEN=lc) :: cn_coord1 = '' 126 CHARACTER(LEN=lc) :: cn_bathy1 = '' 127 INTEGER(i4) :: in_perio1 = -1 128 129 ! namcfg 130 CHARACTER(LEN=lc) :: cn_varcfg = 'variable.cfg' 300 CHARACTER(LEN=lc) :: cn_coord1 = '' 301 CHARACTER(LEN=lc) :: cn_bathy1 = '' 302 INTEGER(i4) :: in_perio1 = -1 303 304 !namzgr 305 REAL(dp) :: dn_pp_to_be_computed = 0._dp 306 REAL(dp) :: dn_ppsur = -3958.951371276829_dp 307 REAL(dp) :: dn_ppa0 = 103.9530096000000_dp 308 REAL(dp) :: dn_ppa1 = 2.4159512690000_dp 309 REAL(dp) :: dn_ppa2 = 100.7609285000000_dp 310 REAL(dp) :: dn_ppkth = 15.3510137000000_dp 311 REAL(dp) :: dn_ppkth2 = 48.0298937200000_dp 312 REAL(dp) :: dn_ppacr = 7.0000000000000_dp 313 REAL(dp) :: dn_ppacr2 = 13.000000000000_dp 314 REAL(dp) :: dn_ppdzmin = 6._dp 315 REAL(dp) :: dn_pphmax = 5750._dp 316 INTEGER(i4) :: in_nlevel = 75 317 318 !namzps 319 REAL(dp) :: dn_e3zps_min = 25._dp 320 REAL(dp) :: dn_e3zps_rat = 0.2_dp 131 321 132 322 ! namvar 133 CHARACTER(LEN=lc), DIMENSION(i g_maxvar) :: cn_varinfo = ''134 CHARACTER(LEN=lc), DIMENSION(i g_maxvar) :: cn_varfile = ''323 CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = '' 324 CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = '' 135 325 136 326 ! namnst 137 INTEGER(i4) :: in_imin0 = 0 138 INTEGER(i4) :: in_imax0 = 0 139 INTEGER(i4) :: in_jmin0 = 0 140 INTEGER(i4) :: in_jmax0 = 0 141 INTEGER(i4) :: in_rhoi = 1 142 INTEGER(i4) :: in_rhoj = 1 327 INTEGER(i4) :: in_rhoi = 0 328 INTEGER(i4) :: in_rhoj = 0 143 329 144 330 ! nambdy 145 LOGICAL :: ln_north = .TRUE. 146 LOGICAL :: ln_south = .TRUE. 147 LOGICAL :: ln_east = .TRUE. 148 LOGICAL :: ln_west = .TRUE. 149 CHARACTER(LEN=lc) :: cn_north = '' 150 CHARACTER(LEN=lc) :: cn_south = '' 151 CHARACTER(LEN=lc) :: cn_east = '' 152 CHARACTER(LEN=lc) :: cn_west = '' 153 LOGICAL :: ln_oneseg = .TRUE. 154 INTEGER(i4) :: in_extrap = 0 331 LOGICAL :: ln_north = .TRUE. 332 LOGICAL :: ln_south = .TRUE. 333 LOGICAL :: ln_east = .TRUE. 334 LOGICAL :: ln_west = .TRUE. 335 CHARACTER(LEN=lc) :: cn_north = '' 336 CHARACTER(LEN=lc) :: cn_south = '' 337 CHARACTER(LEN=lc) :: cn_east = '' 338 CHARACTER(LEN=lc) :: cn_west = '' 339 LOGICAL :: ln_oneseg = .TRUE. 155 340 156 341 ! namout 157 CHARACTER(LEN=lc) :: cn_fileout = 'boundary.nc' 342 CHARACTER(LEN=lc) :: cn_fileout = 'boundary.nc' 343 REAL(dp) :: dn_dayofs = 0._dp 344 LOGICAL :: ln_extrap = .FALSE. 158 345 !------------------------------------------------------------------- 159 346 160 347 NAMELIST /namlog/ & !< logger namelist 161 348 & cn_logfile, & !< log file 162 & cn_verbosity !< log verbosity 349 & cn_verbosity, & !< log verbosity 350 & in_maxerror 163 351 164 352 NAMELIST /namcfg/ & !< config namelist … … 168 356 & cn_coord0, & !< coordinate file 169 357 & in_perio0 !< periodicity index 170 358 171 359 NAMELIST /namfin/ & !< fine grid namelist 172 360 & cn_coord1, & !< coordinate file … … 174 362 & in_perio1 !< periodicity index 175 363 364 NAMELIST /namzgr/ & 365 & dn_pp_to_be_computed, & 366 & dn_ppsur, & 367 & dn_ppa0, & 368 & dn_ppa1, & 369 & dn_ppa2, & 370 & dn_ppkth, & 371 & dn_ppkth2, & 372 & dn_ppacr, & 373 & dn_ppacr2, & 374 & dn_ppdzmin, & 375 & dn_pphmax, & 376 & in_nlevel !< number of vertical level 377 378 NAMELIST /namzps/ & 379 & dn_e3zps_min, & 380 & dn_e3zps_rat 381 176 382 NAMELIST /namvar/ & !< variable namelist 177 383 & cn_varinfo, & !< list of variable and method to apply on. (ex: 'votemper:linear','vosaline:cubic' ) 178 384 & cn_varfile !< list of variable and file where find it. (ex: 'votemper:GLORYS_gridT.nc' ) 179 385 180 386 NAMELIST /namnst/ & !< nesting namelist 181 & in_imin0, & !< i-direction lower left point indice on coarse grid182 & in_imax0, & !< i-direction upper right point indice on coarse grid183 & in_jmin0, & !< j-direction lower left point indice on coarse grid184 & in_jmax0, & !< j-direction upper right point indice on coarse grid185 387 & in_rhoi, & !< refinement factor in i-direction 186 388 & in_rhoj !< refinement factor in j-direction … … 195 397 & cn_east , & !< east boundary indices on fine grid 196 398 & cn_west , & !< west boundary indices on fine grid 197 & ln_oneseg, & !< use only one segment for each boundary or not 198 & in_extrap !< number of mask point to extrapolate 399 & ln_oneseg !< use only one segment for each boundary or not 199 400 200 401 NAMELIST /namout/ & !< output namelist 201 & cn_fileout !< fine grid boundary file basename 402 & cn_fileout, & !< fine grid boundary file basename 403 & dn_dayofs, & !< date offset in day (change only ouput file name) 404 & ln_extrap !< extrapolate or not 202 405 !------------------------------------------------------------------- 203 406 204 ! 1-namelist205 ! 1-1get namelist407 ! namelist 408 ! get namelist 206 409 il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec 207 410 IF( il_narg/=1 )THEN … … 212 415 ENDIF 213 416 214 ! 1-2read namelist417 ! read namelist 215 418 INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist) 216 419 IF( ll_exist )THEN … … 231 434 232 435 READ( il_fileid, NML = namlog ) 233 ! 1-2-1define log file234 CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity) )436 ! define log file 437 CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror) 235 438 CALL logger_header() 236 439 237 440 READ( il_fileid, NML = namcfg ) 238 ! 1-2-2get variable extra information441 ! get variable extra information 239 442 CALL var_def_extra(TRIM(cn_varcfg)) 240 443 241 444 READ( il_fileid, NML = namcrs ) 242 445 READ( il_fileid, NML = namfin ) 446 READ( il_fileid, NML = namzgr ) 243 447 READ( il_fileid, NML = namvar ) 244 ! 1-2-3add user change in extra information448 ! add user change in extra information 245 449 CALL var_chg_extra(cn_varinfo) 246 ! 1-2-4match variable with file450 ! match variable with file 247 451 tl_multi=multi_init(cn_varfile) 248 452 249 453 READ( il_fileid, NML = namnst ) 250 454 READ( il_fileid, NML = nambdy ) 251 252 455 READ( il_fileid, NML = namout ) 253 456 … … 261 464 262 465 PRINT *,"CREATE BOUNDARY: ERROR. can not find "//TRIM(cl_namelist) 466 STOP 263 467 264 468 ENDIF 265 469 266 !2- open files 470 CALL multi_print(tl_multi) 471 IF( tl_multi%i_nvar <= 0 )THEN 472 CALL logger_fatal("CREATE BOUNDARY: no variable to be used."//& 473 & " check namelist.") 474 ENDIF 475 476 ! open files 267 477 IF( TRIM(cn_coord0) /= '' )THEN 268 tl_coord0= file_init(TRIM(cn_coord0),id_perio=in_perio0)269 CALL iom_open(tl_coord0)478 tl_coord0=mpp_init( file_init(TRIM(cn_coord0)), id_perio=in_perio0) 479 CALL grid_get_info(tl_coord0) 270 480 ELSE 271 481 CALL logger_fatal("CREATE BOUNDARY: can not find coarse grid "//& … … 274 484 275 485 IF( TRIM(cn_coord1) /= '' )THEN 276 tl_coord1= file_init(TRIM(cn_coord1),id_perio=in_perio1)277 CALL iom_open(tl_coord1)486 tl_coord1=mpp_init( file_init(TRIM(cn_coord1)), id_perio=in_perio1) 487 CALL grid_get_info(tl_coord1) 278 488 ELSE 279 489 CALL logger_fatal("CREATE BOUNDARY: can not find fine grid coordinate "//& … … 282 492 283 493 IF( TRIM(cn_bathy1) /= '' )THEN 284 tl_bathy1= file_init(TRIM(cn_bathy1),id_perio=in_perio1)285 CALL iom_open(tl_bathy1)494 tl_bathy1=mpp_init( file_init(TRIM(cn_bathy1)), id_perio=in_perio1) 495 CALL grid_get_info(tl_bathy1) 286 496 ELSE 287 497 CALL logger_fatal("CREATE BOUNDARY: can not find fine grid bathymetry "//& … … 289 499 ENDIF 290 500 291 !3- check 292 !3-1 check output file do not already exist 501 ! check 502 ! check output file do not already exist 503 ! WARNING: do not work when use time to create output file name 293 504 DO jk=1,ip_ncard 294 505 cl_bdyout=boundary_set_filename( TRIM(cn_fileout), & 295 & TRIM(ip_card(jk)) ) 506 & TRIM(cp_card(jk)), 1 ) 507 INQUIRE(FILE=TRIM(cl_bdyout), EXIST=ll_exist) 508 IF( ll_exist )THEN 509 CALL logger_fatal("CREATE BOUNDARY: output file "//TRIM(cl_bdyout)//& 510 & " already exist.") 511 ENDIF 512 513 cl_bdyout=boundary_set_filename( TRIM(cn_fileout), & 514 & TRIM(cp_card(jk)) ) 296 515 INQUIRE(FILE=TRIM(cl_bdyout), EXIST=ll_exist) 297 516 IF( ll_exist )THEN … … 301 520 ENDDO 302 521 303 ! 3-1check namelist304 ! 3-1-1check refinement factor522 ! check namelist 523 ! check refinement factor 305 524 il_rho(:)=1 306 525 IF( in_rhoi < 1 .OR. in_rhoj < 1 )THEN … … 312 531 ENDIF 313 532 314 !3-1-2 315 IF( in_imin0 < 1 .OR. in_imax0 < 1 .OR. in_jmin0 < 1 .OR. in_jmax0 < 1)THEN 316 ! compute coarse grid indices around fine grid 317 il_ind(:,:,:)=grid_get_coarse_index(tl_bathy0, tl_bathy1 ) 318 319 il_imin0=il_ind(1,1,1) ; il_imax0=il_ind(1,2,1) 320 il_jmin0=il_ind(2,1,1) ; il_jmax0=il_ind(2,2,1) 321 ELSE 322 il_imin0=in_imin0 ; il_imax0=in_imax0 323 il_jmin0=in_jmin0 ; il_jmax0=in_jmax0 324 ENDIF 325 326 !3-2 check domain validity 533 ! 534 ! compute coarse grid indices around fine grid 535 il_ind(:,:)=grid_get_coarse_index(tl_coord0, tl_coord1, & 536 & id_rho=il_rho(:)) 537 538 il_imin0=il_ind(1,1) ; il_imax0=il_ind(1,2) 539 il_jmin0=il_ind(2,1) ; il_jmax0=il_ind(2,2) 540 541 ! check domain validity 327 542 CALL grid_check_dom(tl_coord0, il_imin0, il_imax0, il_jmin0, il_jmax0) 328 543 329 ! 3-3check coordinate file544 ! check coordinate file 330 545 CALL grid_check_coincidence( tl_coord0, tl_coord1, & 331 546 & il_imin0, il_imax0, & … … 333 548 & il_rho(:) ) 334 549 335 !4- read or compute boundary 336 tl_var1=iom_read_var(tl_bathy1,'Bathymetry') 337 550 ! read or compute boundary 551 CALL mpp_get_contour(tl_bathy1) 552 553 CALL iom_mpp_open(tl_bathy1) 554 555 tl_var1=iom_mpp_read_var(tl_bathy1,'Bathymetry') 556 557 CALL iom_mpp_close(tl_bathy1) 558 559 ! get boundaries indices 338 560 tl_bdy(:)=boundary_init(tl_var1, ln_north, ln_south, ln_east, ln_west, & 339 561 & cn_north, cn_south, cn_east, cn_west, & … … 342 564 CALL var_clean(tl_var1) 343 565 344 ! 5-compute level345 ALLOCATE(tl_level(i g_npoint))566 ! compute level 567 ALLOCATE(tl_level(ip_npoint)) 346 568 tl_level(:)=vgrid_get_level(tl_bathy1, cl_namelist ) 347 569 348 !6- get coordinate on each segment of each boundary 349 ALLOCATE( tl_seglon1(ip_ncard,ig_maxseg) ) 350 ALLOCATE( tl_seglat1(ip_ncard,ig_maxseg) ) 351 ALLOCATE( tl_segdom1(ip_ncard,ig_maxseg) ) 352 ALLOCATE( tl_segvar1(tl_multi%i_nvar,ip_ncard,ig_maxseg) ) 353 ALLOCATE( tl_seglvl1(ip_ncard,ig_maxseg,ig_npoint) ) 354 DO jk=1,ip_ncard 355 IF( tl_bdy(jk)%l_use )THEN 356 DO jl=1,tl_bdy(jk)%i_nseg 357 !6-1 get fine grid segment domain 358 tl_segdom1(jk,jl)=create_boundary_get_dom( tl_bathy1, tl_bdy(jk), jl ) 359 360 !6-2 get fine grid segment coordinate 361 CALL create_boundary_get_coord( tl_bathy1, tl_segdom1(jk,jl), & 362 & tl_seglon1(jk,jl), tl_seglat1(jk,jl) ) 363 !6-2 get fine grid segment coordinate 364 tl_seglvl1(jk,jl,:)=create_bdy_get_level(tl_level(:), tl_segdom1(jk,jl)) 570 ! get coordinate for each segment of each boundary 571 ALLOCATE( tl_segdom1(ip_npoint,ip_maxseg,ip_ncard) ) 572 ALLOCATE( tl_seglvl1(ip_npoint,ip_maxseg,ip_ncard) ) 573 574 DO jl=1,ip_ncard 575 IF( tl_bdy(jl)%l_use )THEN 576 DO jk=1,tl_bdy(jl)%i_nseg 577 578 ! get fine grid segment domain 579 tl_segdom1(:,jk,jl)=create_boundary_get_dom( tl_bathy1, & 580 & tl_bdy(jl), jk ) 581 582 IF( .NOT. ln_extrap )THEN 583 ! get fine grid level 584 tl_seglvl1(:,jk,jl)= & 585 & create_boundary_get_level( tl_level(:), & 586 & tl_segdom1(:,jk,jl)) 587 ENDIF 588 589 ! add extra band to fine grid domain (if possible) 590 ! to avoid dimension of one and so be able to compute offset 591 DO jj=1,ip_npoint 592 CALL dom_add_extra(tl_segdom1(jj,jk,jl), & 593 & il_rho(jp_I), il_rho(jp_J)) 594 ENDDO 365 595 366 596 ENDDO … … 368 598 ENDDO 369 599 600 ! clean 601 CALL var_clean(tl_level(:)) 370 602 DEALLOCATE(tl_level) 371 603 372 !7- compute boundary for variable to be used (see namelist) 373 IF( .NOT. ASSOCIATED(tl_multi%t_file) )THEN 604 ! clean bathy 605 CALL mpp_clean(tl_bathy1) 606 607 ALLOCATE( tl_segvar1(tl_multi%i_nvar,ip_maxseg,ip_ncard) ) 608 ! compute boundary for variable to be used (see namelist) 609 IF( .NOT. ASSOCIATED(tl_multi%t_mpp) )THEN 374 610 CALL logger_error("CREATE BOUNDARY: no file to work on. "//& 375 611 & "check cn_varfile in namelist.") 376 612 ELSE 613 377 614 jvar=0 378 615 ! for each file 379 DO ji=1,tl_multi%i_nfile 380 WRITE(cl_data,'(a,i2.2)') 'data_',jvar+1 381 382 IF( .NOT. ASSOCIATED(tl_multi%t_file(ji)%t_var) )THEN 616 DO ji=1,tl_multi%i_nmpp 617 618 WRITE(cl_data,'(a,i2.2)') 'data-',jvar+1 619 620 IF( .NOT. ASSOCIATED(tl_multi%t_mpp(ji)%t_proc(1)%t_var) )THEN 621 383 622 CALL logger_error("CREATE BOUNDARY: no variable to work on for "//& 384 & " file "//TRIM(tl_multi%t_file(ji)%c_name)//&623 & "mpp "//TRIM(tl_multi%t_mpp(ji)%c_name)//& 385 624 & ". check cn_varfile in namelist.") 625 626 ELSEIF( TRIM(tl_multi%t_mpp(ji)%c_name) == TRIM(cl_data) )THEN 627 !- use input matrix to fill variable 628 629 WRITE(*,'(a)') "work on data" 630 ! for each variable initialise from matrix 631 DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 632 633 jvar=jvar+1 634 WRITE(*,'(2x,a,a)') "work on variable "//& 635 & TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 636 637 tl_var1=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)) 638 639 SELECT CASE(TRIM(tl_var1%c_point)) 640 CASE DEFAULT !'T' 641 jpoint=jp_T 642 CASE('U') 643 jpoint=jp_U 644 CASE('V') 645 jpoint=jp_V 646 CASE('F') 647 jpoint=jp_F 648 END SELECT 649 650 WRITE(*,'(4x,a,a)') 'work on '//TRIM(tl_var1%c_name) 651 DO jl=1,ip_ncard 652 IF( tl_bdy(jl)%l_use )THEN 653 654 DO jk=1,tl_bdy(jl)%i_nseg 655 656 ! fill value with matrix data 657 tl_segvar1(jvar,jk,jl)=create_boundary_matrix( & 658 & tl_var1, & 659 & tl_segdom1(jpoint,jk,jl), & 660 & in_nlevel ) 661 662 !del extra 663 CALL dom_del_extra( tl_segvar1(jvar,jk,jl), & 664 & tl_segdom1(jpoint,jk,jl) ) 665 666 ENDDO 667 668 ENDIF 669 ENDDO 670 671 ! clean 672 CALL var_clean(tl_var1) 673 674 ENDDO 675 676 !- end of use input matrix to fill variable 386 677 ELSE 387 IF( .NOT. ASSOCIATED(tl_multi%t_file(ji)%t_var) )THEN 388 389 CALL logger_error("CREATE BOUNDARY: no variable to work on for "//& 390 & "file "//TRIM(tl_multi%t_file(ji)%c_name)//& 391 & ". check cn_varfile in namelist.") 392 393 ELSEIF( TRIM(tl_multi%t_file(ji)%c_name) == TRIM(cl_data) )THEN 394 !- use input matrix to fill variable 395 396 ! for each variable initialise from matrix 397 DO jj=1,tl_multi%t_file(ji)%i_nvar 398 jvar=jvar+1 399 tl_tmp=tl_multi%t_file(ji)%t_var(jj) 400 DO jk=1,ip_ncard 401 IF( tl_bdy(jk)%l_use )THEN 402 DO jl=1,tl_bdy(jk)%i_nseg 403 !7-1 fill value with matrix data 404 ! pb voir comment gerer nb de dimension 405 tl_segvar1(jvar,jk,jl)=create_bdy_matrix(tl_tmp, tl_segdom1(jk,jl), tl_coord1) 406 407 !7-2 use mask 408 CALL create_bdy_use_mask(tl_segvar1(jvar,jk,jl), tl_seglvl1(jk,jl,:)) 409 ENDDO 410 ENDIF 411 ENDDO 412 ENDDO 413 678 !- use file to fill variable 679 680 WRITE(*,'(a)') "work on file "//TRIM(tl_multi%t_mpp(ji)%c_name) 681 ! 682 tl_mpp=mpp_init(file_init(TRIM(tl_multi%t_mpp(ji)%t_proc(1)%c_name))) 683 CALL grid_get_info(tl_mpp) 684 685 ! check vertical dimension 686 IF( tl_mpp%t_dim(jp_K)%l_use .AND. & 687 & tl_mpp%t_dim(jp_K)%i_len /= in_nlevel )THEN 688 CALL logger_error("CREATE BOUNDARY: dimension in file "//& 689 & TRIM(tl_mpp%c_name)//" not agree with namelist in_nlevel ") 690 ENDIF 691 692 ! open mpp file 693 CALL iom_mpp_open(tl_mpp) 694 695 ! get or check depth value 696 CALL create_boundary_check_depth( tl_mpp, tl_depth ) 697 698 ! get or check time value 699 CALL create_boundary_check_time( tl_mpp, tl_time ) 700 701 ! close mpp file 702 CALL iom_mpp_close(tl_mpp) 703 704 IF( ANY( tl_mpp%t_dim(1:2)%i_len /= & 705 & tl_coord0%t_dim(1:2)%i_len) )THEN 706 !- extract value from fine grid 707 708 IF( ANY( tl_mpp%t_dim(1:2)%i_len <= & 709 & tl_coord1%t_dim(1:2)%i_len) )THEN 710 CALL logger_fatal("CREATE BOUNDARY: dimension in file "//& 711 & TRIM(tl_mpp%c_name)//" smaller than those in fine"//& 712 & " grid coordinates.") 713 ENDIF 714 715 DO jl=1,ip_ncard 716 IF( tl_bdy(jl)%l_use )THEN 717 718 WRITE(*,'(2x,a,a)') 'work on '//TRIM(tl_bdy(jl)%c_card)//& 719 & ' boundary' 720 DO jk=1,tl_bdy(jl)%i_nseg 721 ! compute domain on fine grid 722 723 ! for each variable of this file 724 DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 725 726 cl_name=tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name 727 WRITE(*,'(4x,a,a)') "work on (extract) variable "//& 728 & TRIM(cl_name) 729 730 cl_point=tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_point 731 ! open mpp file on domain 732 SELECT CASE(TRIM(cl_point)) 733 CASE DEFAULT !'T' 734 jpoint=jp_T 735 CASE('U') 736 jpoint=jp_U 737 CASE('V') 738 jpoint=jp_V 739 CASE('F') 740 jpoint=jp_F 741 END SELECT 742 743 tl_dom1=dom_copy(tl_segdom1(jpoint,jk,jl)) 744 745 ! open mpp files 746 CALL iom_dom_open(tl_mpp, tl_dom1) 747 748 !7-5 read variable over domain 749 tl_segvar1(jvar+jj,jk,jl)=iom_dom_read_var( & 750 & tl_mpp, TRIM(cl_name), tl_dom1) 751 752 ! del extra point 753 CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), & 754 & tl_dom1 ) 755 756 ! clean extra point information on fine grid domain 757 CALL dom_clean_extra( tl_dom1 ) 758 759 ! add attribute to variable 760 tl_att=att_init('src_file', & 761 & TRIM(fct_basename(tl_mpp%c_name))) 762 CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att) 763 764 tl_att=att_init('src_i_indices', & 765 & (/tl_dom1%i_imin, tl_dom1%i_imax/)) 766 CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att) 767 768 tl_att=att_init('src_j_indices', & 769 & (/tl_dom1%i_jmin, tl_dom1%i_jmax/)) 770 CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att) 771 772 ! clean structure 773 CALL att_clean(tl_att) 774 CALL dom_clean(tl_dom1) 775 776 ! close mpp files 777 CALL iom_dom_close(tl_mpp) 778 779 ! clean 780 CALL var_clean(tl_lvl1) 781 782 ENDDO ! jj 783 ENDDO ! jk 784 785 ENDIF 786 ENDDO ! jl 787 788 ! clean 789 CALL mpp_clean(tl_mpp) 790 791 jvar=jvar+tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 792 793 !- end of extract value from fine grid 414 794 ELSE 415 !- use file to fill variable 416 417 ! open file 418 tl_file=file_init(TRIM(tl_multi%t_file(ji)%c_name)) 419 CALL iom_open(tl_file) 420 421 ! get or check depth value 422 IF( tl_file%i_depthid /= 0 )THEN 423 IF( ASSOCIATED(tl_depth%d_value) )THEN 424 IF( ANY( tl_depth%d_value(:,:,:,:) /= & 425 & tl_tmp%d_value(:,:,:,:) ) )THEN 426 CALL logger_fatal("CREATE BOUNDARY: depth value from "//& 427 & TRIM(tl_multi%t_file(ji)%c_name)//" not conform "//& 428 & " to those from former file(s).") 429 ENDIF 430 ELSE 431 tl_depth=iom_read_var(tl_file,tl_file%i_depthid) 432 ENDIF 433 ENDIF 434 435 ! get or check time value 436 IF( tl_file%i_timeid /= 0 )THEN 437 IF( ASSOCIATED(tl_time%d_value) )THEN 438 IF( ANY( tl_time%d_value(:,:,:,:) /= & 439 & tl_tmp%d_value(:,:,:,:) ) )THEN 440 CALL logger_fatal("CREATE BOUNDARY: time value from "//& 441 & TRIM(tl_multi%t_file(ji)%c_name)//" not conform "//& 442 & " to those from former file(s).") 443 ENDIF 444 ELSE 445 tl_time=iom_read_var(tl_file,tl_file%i_timeid) 446 ENDIF 447 ENDIF 448 449 IF( ANY( tl_file%t_dim(1:2)%i_len /= & 450 & tl_coord0%t_dim(1:2)%i_len) )THEN 451 !- extract value from fine grid 452 DO jk=1,ip_ncard 453 IF( tl_bdy(jk)%l_use )THEN 454 455 DO jl=1,tl_bdy(jk)%i_nseg 456 !7-1 compute domain on fine grid 457 795 !- interpolate value from coarse grid 796 797 DO jl=1,ip_ncard 798 IF( tl_bdy(jl)%l_use )THEN 799 800 WRITE(*,'(2x,a,a)') 'work on '//TRIM(tl_bdy(jl)%c_card)//& 801 & ' boundary' 802 DO jk=1,tl_bdy(jl)%i_nseg 803 804 ! for each variable of this file 805 DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 806 807 WRITE(*,'(4x,a,a)') "work on (interp) variable "//& 808 & TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 809 810 tl_var0=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)) 458 811 ! open mpp file on domain 459 !7-2 init mpp structure 460 tl_mpp=mpp_init(tl_file) 461 462 !7-3 get processor to be used 463 CALL mpp_get_use( tl_mpp, tl_segdom1(jk,jl) ) 464 !7-4 open mpp files 465 CALL iom_mpp_open(tl_mpp) 466 467 ! for each variable of this file 468 DO jj=1,tl_multi%t_file(ji)%i_nvar 469 470 cl_name=tl_multi%t_file(ji)%t_var(jj)%c_name 471 !7-5 read variable over domain 472 tl_segvar1(jvar+jj,jk,jl)=iom_mpp_read_var( tl_mpp, TRIM(cl_name), & 473 & td_dom=tl_segdom1(jk,jl) ) 474 475 !7-6 add attribute to variable 476 tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name))) 477 CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att) 478 479 tl_att=att_init('src_i-indices',(/tl_segdom1(jk,jl)%i_imin, tl_segdom1(jk,jl)%i_imax/)) 480 CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att) 481 482 tl_att=att_init('src_j-indices',(/tl_segdom1(jk,jl)%i_jmin, tl_segdom1(jk,jl)%i_jmax/)) 483 CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att) 484 485 ! clean structure 486 CALL att_clean(tl_att) 487 488 !7-7 use mask 489 CALL create_bdy_use_mask(tl_segvar1(jvar+jj,jk,jl), tl_seglvl1(jk,jl,:)) 490 ENDDO 491 492 !7-8 close mpp files 493 CALL iom_mpp_close(tl_mpp) 494 495 CALL mpp_clean(tl_mpp) 496 497 ENDDO 498 ENDIF 499 ENDDO 500 jvar=jvar+tl_multi%t_file(ji)%i_nvar 501 ELSE 502 !- interpolate value from coarse grid 503 504 DO jk=1,ip_ncard 505 IF( tl_bdy(jk)%l_use )THEN 506 507 DO jl=1,tl_bdy(jk)%i_nseg 508 !7-1 get coarse grid indices of this segment 509 il_ind(:,:,:)=grid_get_coarse_index(tl_coord0, & 510 & tl_seglon1(jk,jl), tl_seglat1(jk,jl), & 511 & id_rho=il_rho(:) ) 512 513 IF( ANY(il_ind(:,:,:)==0) )THEN 514 CALL logger_error("CREATE BOUNDARY: error computing "//& 515 & " coarse grid indices") 812 SELECT CASE(TRIM(tl_var0%c_point)) 813 CASE DEFAULT !'T' 814 jpoint=jp_T 815 CASE('U') 816 jpoint=jp_U 817 CASE('V') 818 jpoint=jp_V 819 CASE('F') 820 jpoint=jp_F 821 END SELECT 822 823 tl_dom1=dom_copy(tl_segdom1(jpoint,jk,jl)) 824 825 CALL create_boundary_get_coord( tl_coord1, tl_dom1, & 826 & tl_var0%c_point, & 827 & tl_lon1, tl_lat1 ) 828 829 ! get coarse grid indices of this segment 830 il_ind(:,:)=grid_get_coarse_index(tl_coord0, & 831 & tl_lon1, tl_lat1, & 832 & id_rho=il_rho(:) ) 833 834 IF( ANY(il_ind(:,:)==0) )THEN 835 CALL logger_error("CREATE BOUNDARY: error "//& 836 & "computing coarse grid indices") 516 837 ELSE 517 il_imin0=il_ind(1,1,1) 518 il_imax0=il_ind(1,2,1) 519 520 il_jmin0=il_ind(2,1,1) 521 il_jmax0=il_ind(2,2,1) 522 523 il_offset(:,:)=il_ind(:,:,2) 838 il_imin0=il_ind(1,1) 839 il_imax0=il_ind(1,2) 840 841 il_jmin0=il_ind(2,1) 842 il_jmax0=il_ind(2,2) 524 843 ENDIF 525 844 526 !7-2 compute coarse grid segment domain 845 il_offset(:,:)= grid_get_fine_offset( & 846 & tl_coord0, & 847 & il_imin0, il_jmin0,& 848 & il_imax0, il_jmax0,& 849 & tl_lon1%d_value(:,:,1,1),& 850 & tl_lat1%d_value(:,:,1,1),& 851 & il_rho(:),& 852 & TRIM(tl_var0%c_point) ) 853 854 ! compute coarse grid segment domain 527 855 tl_dom0=dom_init( tl_coord0, & 528 856 & il_imin0, il_imax0,& 529 857 & il_jmin0, il_jmax0 ) 530 858 531 !7-3 add extra band (if possible) to compute interpolation 859 ! add extra band (if possible) to compute 860 ! interpolation 532 861 CALL dom_add_extra(tl_dom0) 533 862 534 !7-4 read variables on domain (ugly way to do it, have to work on it) 535 !7-4-1 init mpp structure 536 tl_mpp=mpp_init(tl_file) 537 538 !7-4-2 get processor to be used 539 CALL mpp_get_use( tl_mpp, tl_dom0 ) 540 541 !7-4-3 open mpp files 542 CALL iom_mpp_open(tl_mpp) 543 544 ! check file dimension 545 IF( ANY(tl_mpp%t_dim(1:2)%i_len /= tl_coord0%t_dim(1:2)%i_len) )THEN 546 CALL logger_error("CREATE BOUNDARY INTERP: dimension of file "//& 547 & TRIM(tl_mpp%c_name)//" not conform to those of "//& 548 & TRIM(tl_coord0%c_name)) 549 ELSE 550 551 ! for each variable of this file 552 DO jj=1,tl_multi%t_file(ji)%i_nvar 553 554 cl_name=tl_multi%t_file(ji)%t_var(jj)%c_name 555 !7-4-4 read variable value on domain 556 tl_segvar1(jvar+jj,jk,jl)=iom_mpp_read_var( tl_mpp, TRIM(cl_name), & 557 & td_dom=tl_dom0 ) 558 559 !7-4-5 work on variable 560 CALL create_boundary_interp(tl_segvar1(jvar+jj,jk,jl), & 561 & il_rho(:), & 562 & il_offset(:,:) ) 563 564 !7-4-6 remove extraband added to domain 565 CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), tl_dom0, il_rho(:) ) 566 567 !7-4-7 keep only useful point (width) 568 ! interpolation could create more point than necessary 569 CALL boundary_clean_interp(tl_segvar1(jvar+jj,jk,jl), tl_bdy(jk) ) 570 571 !7-4-8 add attribute to variable 572 tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name))) 573 CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att) 574 575 tl_att=att_init('src_i-indices',(/tl_dom0%i_imin, tl_dom0%i_imax/)) 576 CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att) 577 578 tl_att=att_init('src_j-indices',(/tl_dom0%i_jmin, tl_dom0%i_jmax/)) 579 CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att) 580 581 ! clean structure 582 CALL att_clean(tl_att) 583 584 !7-4-9 use mask 585 CALL create_bdy_use_mask(tl_segvar1(jvar+jj,jk,jl), tl_seglvl1(jk,jl,:)) 586 ENDDO 863 ! read variables on domain 864 ! open mpp files 865 CALL iom_dom_open(tl_mpp, tl_dom0) 866 867 cl_name=tl_var0%c_name 868 ! read variable value on domain 869 tl_segvar1(jvar+jj,jk,jl)= & 870 & iom_dom_read_var(tl_mpp, TRIM(cl_name), tl_dom0) 871 872 ! work on variable 873 CALL create_boundary_interp( & 874 & tl_segvar1(jvar+jj,jk,jl),& 875 & il_rho(:), il_offset(:,:) ) 876 877 ! remove extraband added to domain 878 CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), & 879 & tl_dom0, il_rho(:) ) 880 881 ! del extra point on fine grid 882 CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), & 883 & tl_dom1 ) 884 ! clean extra point information on coarse grid domain 885 CALL dom_clean_extra( tl_dom0 ) 886 887 ! add attribute to variable 888 tl_att=att_init('src_file',& 889 & TRIM(fct_basename(tl_mpp%c_name))) 890 CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), & 891 & tl_att) 892 893 ! use clean extra avt creer attribut 894 tl_att=att_init('src_i-indices',& 895 & (/tl_dom0%i_imin, tl_dom0%i_imax/)) 896 CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), & 897 & tl_att) 898 899 tl_att=att_init('src_j-indices', & 900 & (/tl_dom0%i_jmin, tl_dom0%i_jmax/)) 901 CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), & 902 & tl_att) 903 904 IF( ANY(il_rho(:)/=1) )THEN 905 tl_att=att_init("refinment_factor", & 906 & (/il_rho(jp_I),il_rho(jp_J)/)) 907 CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), & 908 & tl_att) 587 909 ENDIF 588 910 911 ! clean structure 912 CALL att_clean(tl_att) 913 914 ! clean 589 915 CALL dom_clean(tl_dom0) 590 591 !7-5 close mpp files 592 CALL iom_mpp_close(tl_mpp) 593 594 !7-6 clean structure 595 CALL mpp_clean(tl_mpp) 596 ENDDO 597 ENDIF 598 ENDDO 599 jvar=jvar+tl_multi%t_file(ji)%i_nvar 600 601 ENDIF 602 CALL file_clean(tl_file) 603 916 CALL dom_clean(tl_dom1) 917 918 ! close mpp files 919 CALL iom_dom_close(tl_mpp) 920 921 ! clean structure 922 CALL var_clean(tl_lon1) 923 CALL var_clean(tl_lat1) 924 CALL var_clean(tl_lvl1) 925 926 ENDDO ! jj 927 928 ! clean 929 CALL var_clean(tl_var0) 930 931 ENDDO ! jk 932 933 ENDIF 934 ENDDO ! jl 935 936 jvar=jvar+tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 937 938 !- end of interpolate value from coarse grid 604 939 ENDIF 940 941 ! clean 942 CALL mpp_clean(tl_mpp) 943 944 !- end of use file to fill variable 605 945 ENDIF 606 946 ENDDO 607 947 ENDIF 948 608 949 IF( jvar /= tl_multi%i_nvar )THEN 609 CALL logger_error("CREATE BOUNDARY: it seems some variable can not be read") 950 CALL logger_error("CREATE BOUNDARY: it seems some variable "//& 951 & "can not be read") 610 952 ENDIF 611 953 612 !8- concatenate file 613 ALLOCATE( tl_lon1(ip_ncard) ) 614 ALLOCATE( tl_lat1(ip_ncard) ) 615 ALLOCATE( tl_var(tl_multi%i_nvar,ip_ncard) ) 616 617 DO jk=1,ip_ncard 618 IF( tl_bdy(jk)%l_use )THEN 619 620 SELECT CASE(TRIM(tl_bdy(jk)%c_card)) 621 CASE('north','south') 622 il_dim=1 623 CASE('east','west') 624 il_dim=2 625 END SELECT 626 627 DO jl=1,tl_bdy(jk)%i_nseg 628 !- concatenate variable 629 IF( jl == 1 )THEN 630 tl_lon1(jk)=tl_seglon1(jk,jl) 631 tl_lat1(jk)=tl_seglat1(jk,jl) 632 DO jvar=1,tl_multi%i_nvar 633 tl_var(jvar,jk)=tl_segvar1(jvar,jk,jl) 634 ENDDO 954 ! write file for each segment of each boundary 955 DO jl=1,ip_ncard 956 IF( tl_bdy(jl)%l_use )THEN 957 958 DO jk=1,tl_bdy(jl)%i_nseg 959 !- 960 CALL create_boundary_get_coord( tl_coord1, tl_segdom1(jp_T,jk,jl),& 961 & 'T', tl_lon1, tl_lat1 ) 962 963 ! force to use nav_lon, nav_lat as variable name 964 tl_lon1%c_name='nav_lon' 965 tl_lat1%c_name='nav_lat' 966 967 ! del extra point on fine grid 968 CALL dom_del_extra( tl_lon1, tl_segdom1(jp_T,jk,jl) ) 969 CALL dom_del_extra( tl_lat1, tl_segdom1(jp_T,jk,jl) ) 970 971 ! clean 972 DO jpoint=1,ip_npoint 973 CALL dom_clean(tl_segdom1(jpoint,jk,jl)) 974 ENDDO 975 976 ! swap array 977 CALL boundary_swap(tl_lon1, tl_bdy(jl)) 978 CALL boundary_swap(tl_lat1, tl_bdy(jl)) 979 DO jvar=1,tl_multi%i_nvar 980 981 ! use additional request 982 ! change unit and apply factor 983 CALL var_chg_unit(tl_segvar1(jvar,jk,jl)) 984 985 ! forced min and max value 986 CALL var_limit_value(tl_segvar1(jvar,jk,jl)) 987 988 ! filter 989 CALL filter_fill_value(tl_segvar1(jvar,jk,jl)) 990 991 IF( .NOT. ln_extrap )THEN 992 ! use mask 993 SELECT CASE(TRIM(tl_segvar1(jvar,jk,jl)%c_point)) 994 CASE DEFAULT !'T' 995 jpoint=jp_T 996 CASE('U') 997 jpoint=jp_U 998 CASE('V') 999 jpoint=jp_V 1000 CASE('F') 1001 jpoint=jp_F 1002 END SELECT 1003 1004 CALL create_boundary_use_mask(tl_segvar1(jvar,jk,jl), & 1005 & tl_seglvl1(jpoint,jk,jl)) 1006 ENDIF 1007 1008 ! swap dimension order 1009 CALL boundary_swap(tl_segvar1(jvar,jk,jl), tl_bdy(jl)) 1010 1011 ENDDO 1012 1013 ! create file 1014 ! create file structure 1015 ! set file namearray of level variable structure 1016 IF( tl_bdy(jl)%i_nseg > 1 )THEN 1017 IF( ASSOCIATED(tl_time%d_value) )THEN 1018 cl_fmt="('y',i0.4,'m',i0.2,'d',i0.2)" 1019 tl_date=var_to_date(tl_time) 1020 tl_date=tl_date+dn_dayofs 1021 cl_date=date_print( tl_date, cl_fmt ) 1022 1023 cl_bdyout=boundary_set_filename( TRIM(cn_fileout), & 1024 & TRIM(tl_bdy(jl)%c_card), jk,& 1025 & cd_date=TRIM(cl_date) ) 1026 ELSE 1027 cl_bdyout=boundary_set_filename( TRIM(cn_fileout), & 1028 & TRIM(tl_bdy(jl)%c_card), jk ) 1029 ENDIF 635 1030 ELSE 636 tl_lon1(jk)=var_concat(tl_lon1(jk),tl_seglon1(jk,jl),DIM=il_dim) 637 tl_lat1(jk)=var_concat(tl_lat1(jk),tl_seglat1(jk,jl),DIM=il_dim) 638 DO jvar=1,tl_multi%i_nvar 639 tl_var(jvar,jk)=var_concat(tl_var(jvar,jk),tl_segvar1(jvar,jk,jl),DIM=il_dim) 640 ENDDO 641 ENDIF 642 ENDDO 643 644 ! swap array 645 CALL boundary_swap(tl_lon1(jk), tl_bdy(jk)) 646 CALL boundary_swap(tl_lat1(jk), tl_bdy(jk)) 647 DO jvar=1,tl_multi%i_nvar 648 CALL boundary_swap(tl_var(jvar,jk), tl_bdy(jk)) 649 650 !9- use additional request 651 652 !9-1 forced min and max value 653 CALL var_limit_value(tl_var(jvar,jk)) 654 655 !9-2 filter 656 CALL filter_fill_value(tl_var(jvar,jk)) 657 658 !9-3 extrapolate 659 CALL extrap_fill_value(tl_var(jvar,jk), id_iext=in_extrap, & 660 & id_jext=in_extrap, & 661 & id_kext=in_extrap) 662 663 ENDDO 1031 IF( ASSOCIATED(tl_time%d_value) )THEN 1032 cl_fmt="('y',i0.4,'m',i0.2,'d',i0.2)" 1033 tl_date=var_to_date(tl_time) 1034 tl_date=tl_date+dn_dayofs 1035 cl_date=date_print( tl_date, cl_fmt ) 1036 1037 cl_bdyout=boundary_set_filename( TRIM(cn_fileout), & 1038 & TRIM(tl_bdy(jl)%c_card), & 1039 & cd_date=TRIM(cl_date) ) 1040 ELSE 1041 cl_bdyout=boundary_set_filename( TRIM(cn_fileout), & 1042 & TRIM(tl_bdy(jl)%c_card) ) 1043 ENDIF 1044 ENDIF 1045 ! 1046 tl_fileout=file_init(TRIM(cl_bdyout),id_perio=in_perio1) 1047 1048 ! add dimension 1049 tl_dim(:)=var_max_dim(tl_segvar1(:,jk,jl)) 1050 1051 SELECT CASE(TRIM(tl_bdy(jl)%c_card)) 1052 CASE DEFAULT ! 'north','south' 1053 cl_dimorder='xyzt' 1054 CASE('east','west') 1055 cl_dimorder='yxzt' 1056 END SELECT 1057 1058 DO ji=1,ip_maxdim 1059 IF( tl_dim(ji)%l_use ) CALL file_add_dim(tl_fileout, tl_dim(ji)) 1060 ENDDO 1061 1062 ! add variables 1063 IF( ALL( tl_dim(1:2)%l_use ) )THEN 1064 ! add longitude 1065 CALL file_add_var(tl_fileout, tl_lon1) 1066 CALL var_clean(tl_lon1) 1067 1068 ! add latitude 1069 CALL file_add_var(tl_fileout, tl_lat1) 1070 CALL var_clean(tl_lat1) 1071 ENDIF 1072 1073 1074 1075 IF( tl_dim(3)%l_use )THEN 1076 IF( ASSOCIATED(tl_depth%d_value) )THEN 1077 ! add depth 1078 CALL file_add_var(tl_fileout, tl_depth) 1079 ENDIF 1080 ENDIF 1081 1082 IF( tl_dim(4)%l_use )THEN 1083 IF( ASSOCIATED(tl_time%d_value) )THEN 1084 ! add time 1085 CALL file_add_var(tl_fileout, tl_time) 1086 ENDIF 1087 ENDIF 1088 1089 ! add other variable 1090 DO jvar=tl_multi%i_nvar,1,-1 1091 CALL file_add_var(tl_fileout, tl_segvar1(jvar,jk,jl)) 1092 CALL var_clean(tl_segvar1(jvar,jk,jl)) 1093 ENDDO 1094 1095 ! add some attribute 1096 tl_att=att_init("Created_by","SIREN create_boundary") 1097 CALL file_add_att(tl_fileout, tl_att) 1098 1099 cl_date=date_print(date_now()) 1100 tl_att=att_init("Creation_date",cl_date) 1101 CALL file_add_att(tl_fileout, tl_att) 1102 1103 ! add shift on north and east boundary 1104 ! boundary compute on T point but express on U or V point 1105 SELECT CASE(TRIM(tl_bdy(jl)%c_card)) 1106 CASE DEFAULT ! 'south','west' 1107 il_shift=0 1108 CASE('north','east') 1109 il_shift=1 1110 END SELECT 1111 1112 ! add indice of velocity row or column 1113 tl_att=att_init('bdy_ind',tl_bdy(jl)%t_seg(jk)%i_index-il_shift) 1114 CALL file_move_att(tl_fileout, tl_att) 1115 1116 ! add width of the relaxation zone 1117 tl_att=att_init('bdy_width',tl_bdy(jl)%t_seg(jk)%i_width) 1118 CALL file_move_att(tl_fileout, tl_att) 1119 1120 ! add indice of segment start 1121 tl_att=att_init('bdy_deb',tl_bdy(jl)%t_seg(jk)%i_first) 1122 CALL file_move_att(tl_fileout, tl_att) 1123 1124 ! add indice of segment end 1125 tl_att=att_init('bdy_end',tl_bdy(jl)%t_seg(jk)%i_last) 1126 CALL file_move_att(tl_fileout, tl_att) 1127 1128 ! clean 1129 CALL att_clean(tl_att) 1130 1131 ! create file 1132 CALL iom_create(tl_fileout) 1133 1134 ! write file 1135 CALL iom_write_file(tl_fileout, cl_dimorder) 1136 1137 ! close file 1138 CALL iom_close(tl_fileout) 1139 CALL file_clean(tl_fileout) 1140 1141 ENDDO ! jk 1142 664 1143 ENDIF 665 ENDDO 666 667 DEALLOCATE( tl_seglon1 ) 668 DEALLOCATE( tl_seglat1 ) 1144 ! clean 1145 CALL boundary_clean(tl_bdy(jl)) 1146 ENDDO !jl 1147 1148 ! clean 1149 IF( ASSOCIATED(tl_depth%d_value) ) CALL var_clean(tl_depth) 1150 IF( ASSOCIATED(tl_time%d_value) ) CALL var_clean(tl_time) 669 1151 DEALLOCATE( tl_segdom1 ) 670 1152 DEALLOCATE( tl_segvar1 ) 1153 CALL var_clean(tl_seglvl1(:,:,:)) 671 1154 DEALLOCATE( tl_seglvl1 ) 672 673 DO jk=1,ip_ncard 674 IF( tl_bdy(jk)%l_use )THEN 675 676 !10 create file 677 !10-1 create file structure 678 !10-1-1 set file name 679 cl_bdyout=boundary_set_filename( TRIM(cn_fileout), & 680 & TRIM(tl_bdy(jk)%c_card) ) 681 !10-1-2 682 tl_fileout=file_init(TRIM(cl_bdyout),id_perio=in_perio1) 683 684 !10-2 add dimension 685 tl_dim(:)=var_max_dim(tl_var(:,jk)) 686 687 DO ji=1,ip_maxdim 688 IF( tl_dim(ji)%l_use ) CALL file_add_dim(tl_fileout, tl_dim(ji)) 689 ENDDO 690 691 !10-3 add variables 692 IF( ALL( tl_dim(1:2)%l_use ) )THEN 693 ! add longitude 694 CALL file_add_var(tl_fileout, tl_lon1(jk)) 695 CALL var_clean(tl_lon1(jk)) 696 697 ! add latitude 698 CALL file_add_var(tl_fileout, tl_lat1(jk)) 699 CALL var_clean(tl_lat1(jk)) 700 ENDIF 701 702 IF( tl_dim(3)%l_use )THEN 703 ! add depth 704 CALL file_add_var(tl_fileout, tl_depth) 705 ENDIF 706 707 IF( tl_dim(4)%l_use )THEN 708 ! add time 709 CALL file_add_var(tl_fileout, tl_time) 710 ENDIF 711 712 ! add other variable 713 DO jvar=1,tl_multi%i_nvar 714 !IF( TRIM(tl_var(jvar,jk)%c_name) /= 'X' .AND. & 715 !& TRIM(tl_var(jvar,jk)%c_name) /= 'Y' )THEN 716 CALL file_add_var(tl_fileout, tl_var(jvar,jk)) 717 !ENDIF 718 CALL var_clean(tl_var(jvar,jk)) 719 ENDDO 720 721 !10-4 add some attribute 722 tl_att=att_init("Created_by","SIREN create_boundary") 723 CALL file_add_att(tl_fileout, tl_att) 724 725 cl_date=date_print(date_now()) 726 tl_att=att_init("Creation_date",cl_date) 727 CALL file_add_att(tl_fileout, tl_att) 728 729 ! add attribute periodicity 730 il_attid=0 731 IF( ASSOCIATED(tl_fileout%t_att) )THEN 732 il_attid=att_get_id(tl_fileout%t_att(:),'periodicity') 733 ENDIF 734 IF( tl_coord1%i_perio >= 0 .AND. il_attid == 0 )THEN 735 tl_att=att_init('periodicity',tl_coord1%i_perio) 736 CALL file_add_att(tl_fileout,tl_att) 737 ENDIF 738 739 il_attid=0 740 IF( ASSOCIATED(tl_fileout%t_att) )THEN 741 il_attid=att_get_id(tl_fileout%t_att(:),'ew_overlap') 742 ENDIF 743 IF( tl_coord1%i_ew >= 0 .AND. il_attid == 0 )THEN 744 tl_att=att_init('ew_overlap',tl_coord1%i_ew) 745 CALL file_add_att(tl_fileout,tl_att) 746 ENDIF 747 748 !10-5 create file 749 CALL iom_create(tl_fileout) 750 751 !10-6 write file 752 CALL iom_write_file(tl_fileout) 753 754 !10-7 close file 755 CALL iom_close(tl_fileout) 756 CALL file_clean(tl_fileout) 757 758 ENDIF 759 ENDDO 760 DEALLOCATE( tl_lon1 ) 761 DEALLOCATE( tl_lat1 ) 762 DEALLOCATE( tl_var ) 763 764 !11- close file 765 CALL iom_close(tl_bathy1) 766 CALL iom_close(tl_coord1) 767 CALL iom_close(tl_coord0) 768 769 !12- clean 770 CALL var_clean(tl_depth) 771 CALL var_clean(tl_time) 772 CALL file_clean(tl_fileout) 773 CALL file_clean(tl_bathy1) 774 CALL file_clean(tl_coord1) 775 CALL file_clean(tl_coord0) 1155 1156 1157 CALL mpp_clean(tl_coord1) 1158 CALL mpp_clean(tl_coord0) 1159 1160 CALL multi_clean(tl_multi) 776 1161 777 1162 ! close log file … … 779 1164 CALL logger_close() 780 1165 781 !> @endcode782 1166 CONTAINS 783 1167 !------------------------------------------------------------------- 784 1168 !> @brief 785 !> This subroutine 1169 !> This subroutine compute boundary domain for each grid point (T,U,V,F) 786 1170 !> 787 !> @details 1171 !> @author J.Paul 1172 !> @date November, 2013 - Initial Version 1173 !> @date September, 2014 1174 !> - take into account grid point to compute boundary indices 788 1175 !> 789 !> @author J.Paul 790 !> - 2013- Initial Version 791 !> 792 !> @param[in] 793 !> @todo 1176 !> @param[in] td_bathy1 file structure 1177 !> @param[in] td_bdy boundary structure 1178 !> @param[in] id_seg segment indice 1179 !> @return array of domain structure 794 1180 !------------------------------------------------------------------- 795 !> @code796 1181 FUNCTION create_boundary_get_dom( td_bathy1, td_bdy, id_seg ) 797 1182 … … 799 1184 800 1185 ! Argument 801 TYPE(T FILE), INTENT(IN ) :: td_bathy11186 TYPE(TMPP) , INTENT(IN ) :: td_bathy1 802 1187 TYPE(TBDY) , INTENT(IN ) :: td_bdy 803 1188 INTEGER(i4), INTENT(IN ) :: id_seg 804 1189 805 1190 ! function 806 TYPE(TDOM) :: create_boundary_get_dom1191 TYPE(TDOM), DIMENSION(ip_npoint) :: create_boundary_get_dom 807 1192 808 1193 ! local variable … … 812 1197 INTEGER(i4) :: il_jmax1 813 1198 814 TYPE(TFILE) :: tl_bathy1 815 1199 INTEGER(i4) :: il_imin 1200 INTEGER(i4) :: il_imax 1201 INTEGER(i4) :: il_jmin 1202 INTEGER(i4) :: il_jmax 1203 1204 INTEGER(i4), DIMENSION(ip_npoint) :: il_ishift 1205 INTEGER(i4), DIMENSION(ip_npoint) :: il_jshift 1206 816 1207 ! loop indices 817 INTEGER(i4) :: jl 1208 INTEGER(i4) :: ji 1209 INTEGER(i4) :: jk 818 1210 !---------------------------------------------------------------- 819 jl=id_seg 820 821 !1- get boundary definition 1211 ! init 1212 jk=id_seg 1213 1214 il_ishift(:)=0 1215 il_jshift(:)=0 1216 1217 ! get boundary definition 822 1218 SELECT CASE(TRIM(td_bdy%c_card)) 823 1219 CASE('north') 824 1220 825 il_imin1=td_bdy%t_seg(jl)%i_first 826 il_imax1=td_bdy%t_seg(jl)%i_last 827 il_jmin1=td_bdy%t_seg(jl)%i_index-(td_bdy%t_seg(jl)%i_width-1) 828 il_jmax1=td_bdy%t_seg(jl)%i_index 1221 il_imin1=td_bdy%t_seg(jk)%i_first 1222 il_imax1=td_bdy%t_seg(jk)%i_last 1223 il_jmin1=td_bdy%t_seg(jk)%i_index-(td_bdy%t_seg(jk)%i_width-1) 1224 il_jmax1=td_bdy%t_seg(jk)%i_index 1225 1226 il_jshift(jp_V)=-1 1227 il_jshift(jp_F)=-1 829 1228 830 1229 CASE('south') 831 1230 832 il_imin1=td_bdy%t_seg(j l)%i_first833 il_imax1=td_bdy%t_seg(j l)%i_last834 il_jmin1=td_bdy%t_seg(j l)%i_index835 il_jmax1=td_bdy%t_seg(j l)%i_index+(td_bdy%t_seg(jl)%i_width-1)1231 il_imin1=td_bdy%t_seg(jk)%i_first 1232 il_imax1=td_bdy%t_seg(jk)%i_last 1233 il_jmin1=td_bdy%t_seg(jk)%i_index 1234 il_jmax1=td_bdy%t_seg(jk)%i_index+(td_bdy%t_seg(jk)%i_width-1) 836 1235 837 1236 CASE('east') 838 1237 839 il_imin1=td_bdy%t_seg(jl)%i_index-(td_bdy%t_seg(jl)%i_width-1) 840 il_imax1=td_bdy%t_seg(jl)%i_index 841 il_jmin1=td_bdy%t_seg(jl)%i_first 842 il_jmax1=td_bdy%t_seg(jl)%i_last 1238 il_imin1=td_bdy%t_seg(jk)%i_index-(td_bdy%t_seg(jk)%i_width-1) 1239 il_imax1=td_bdy%t_seg(jk)%i_index 1240 il_jmin1=td_bdy%t_seg(jk)%i_first 1241 il_jmax1=td_bdy%t_seg(jk)%i_last 1242 1243 il_ishift(jp_U)=-1 1244 il_ishift(jp_F)=-1 843 1245 844 1246 CASE('west') 845 1247 846 il_imin1=td_bdy%t_seg(j l)%i_index847 il_imax1=td_bdy%t_seg(j l)%i_index+(td_bdy%t_seg(jl)%i_width-1)848 il_jmin1=td_bdy%t_seg(j l)%i_first849 il_jmax1=td_bdy%t_seg(j l)%i_last1248 il_imin1=td_bdy%t_seg(jk)%i_index 1249 il_imax1=td_bdy%t_seg(jk)%i_index+(td_bdy%t_seg(jk)%i_width-1) 1250 il_jmin1=td_bdy%t_seg(jk)%i_first 1251 il_jmax1=td_bdy%t_seg(jk)%i_last 850 1252 851 1253 END SELECT 852 1254 853 !2 -read fine grid domain 854 tl_bathy1=td_bathy1 855 CALL iom_open(tl_bathy1) 856 857 !2-1 compute domain 858 create_boundary_get_dom=dom_init( tl_bathy1, & 859 & il_imin1, il_imax1,& 860 & il_jmin1, il_jmax1 ) 861 862 !2-2 close file 863 CALL iom_close(tl_bathy1) 1255 !-read fine grid domain 1256 DO ji=1,ip_npoint 1257 1258 ! shift domain 1259 il_imin=il_imin1+il_ishift(ji) 1260 il_imax=il_imax1+il_ishift(ji) 1261 1262 il_jmin=il_jmin1+il_jshift(ji) 1263 il_jmax=il_jmax1+il_jshift(ji) 1264 1265 ! compute domain 1266 create_boundary_get_dom(ji)=dom_init( td_bathy1, & 1267 & il_imin, il_imax,& 1268 & il_jmin, il_jmax,& 1269 & TRIM(td_bdy%c_card) ) 1270 1271 ENDDO 864 1272 865 1273 END FUNCTION create_boundary_get_dom 866 !> @endcode867 1274 !------------------------------------------------------------------- 868 1275 !> @brief 869 !> This subroutine 1276 !> This subroutine get coordinates over boundary domain 1277 !> 1278 !> @author J.Paul 1279 !> @date November, 2013 - Initial Version 1280 !> @date September, 2014 1281 !> - take into account grid point 1282 !> 1283 !> @param[in] td_coord1 coordinates file structure 1284 !> @param[in] td_dom1 boundary domain structure 1285 !> @param[in] cd_point grid point 1286 !> @param[out] td_lon1 longitude variable structure 1287 !> @param[out] td_lat1 latitude variable structure 1288 !------------------------------------------------------------------- 1289 SUBROUTINE create_boundary_get_coord( td_coord1, td_dom1, cd_point, & 1290 & td_lon1, td_lat1 ) 1291 1292 IMPLICIT NONE 1293 ! Argument 1294 TYPE(TMPP) , INTENT(IN ) :: td_coord1 1295 TYPE(TDOM) , INTENT(IN ) :: td_dom1 1296 TYPE(TVAR) , INTENT( OUT) :: td_lon1 1297 TYPE(TVAR) , INTENT( OUT) :: td_lat1 1298 CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: cd_point 1299 1300 ! local variable 1301 TYPE(TMPP) :: tl_coord1 1302 1303 CHARACTER(LEN=lc) :: cl_name 1304 ! loop indices 1305 !---------------------------------------------------------------- 1306 !read variables on domain (ugly way to do it, have to work on it) 1307 ! init mpp structure 1308 tl_coord1=mpp_copy(td_coord1) 1309 1310 ! open mpp files 1311 CALL iom_dom_open(tl_coord1, td_dom1) 1312 1313 ! read variable value on domain 1314 WRITE(cl_name,*) 'longitude_'//TRIM(cd_point) 1315 td_lon1=iom_dom_read_var( tl_coord1, TRIM(cl_name), td_dom1) 1316 WRITE(cl_name,*) 'latitude_'//TRIM(cd_point) 1317 td_lat1=iom_dom_read_var( tl_coord1, TRIM(cl_name), td_dom1) 1318 1319 ! close mpp files 1320 CALL iom_dom_close(tl_coord1) 1321 1322 ! clean structure 1323 CALL mpp_clean(tl_coord1) 1324 1325 END SUBROUTINE create_boundary_get_coord 1326 !------------------------------------------------------------------- 1327 !> @brief 1328 !> This subroutine interpolate variable on boundary 870 1329 !> 871 1330 !> @details 872 1331 !> 873 1332 !> @author J.Paul 874 !> - Nov, 2013- Initial Version1333 !> @date November, 2013 - Initial Version 875 1334 !> 876 !> @param[in] 877 !> @todo 1335 !> @param[inout] td_var variable structure 1336 !> @param[in] id_rho array of refinment factor 1337 !> @param[in] id_offset array of offset between fine and coarse grid 1338 !> @param[in] id_iext i-direction size of extra bands (default=im_minext) 1339 !> @param[in] id_jext j-direction size of extra bands (default=im_minext) 878 1340 !------------------------------------------------------------------- 879 !> @code880 SUBROUTINE create_boundary_get_coord( td_bathy1, td_dom1, &881 & td_lon1, td_lat1 )882 883 IMPLICIT NONE884 885 ! Argument886 TYPE(TFILE), INTENT(IN ) :: td_bathy1887 TYPE(TDOM) , INTENT(IN ) :: td_dom1888 TYPE(TVAR) , INTENT( OUT) :: td_lon1889 TYPE(TVAR) , INTENT( OUT) :: td_lat1890 891 ! local variable892 TYPE(TFILE) :: tl_bathy1893 894 TYPE(TMPP) :: tl_mppbathy1895 896 ! loop indices897 !----------------------------------------------------------------898 !read variables on domain (ugly way to do it, have to work on it)899 900 !1 init mpp structure901 tl_bathy1=td_bathy1902 tl_mppbathy1=mpp_init(tl_bathy1)903 904 CALL file_clean(tl_bathy1)905 906 !2 get processor to be used907 CALL mpp_get_use( tl_mppbathy1, td_dom1 )908 909 !3 open mpp files910 CALL iom_mpp_open(tl_mppbathy1)911 912 !4 read variable value on domain913 td_lon1=iom_mpp_read_var(tl_mppbathy1,'longitude',td_dom=td_dom1)914 td_lat1=iom_mpp_read_var(tl_mppbathy1,'latitude' ,td_dom=td_dom1)915 916 !5 close mpp files917 CALL iom_mpp_close(tl_mppbathy1)918 919 !6 clean structure920 CALL mpp_clean(tl_mppbathy1)921 922 END SUBROUTINE create_boundary_get_coord923 !> @endcode924 !-------------------------------------------------------------------925 !> @brief926 !> This subroutine927 !>928 !> @details929 !>930 !> @author J.Paul931 !> - Nov, 2013- Initial Version932 !>933 !> @param[in]934 !> @todo935 !-------------------------------------------------------------------936 !> @code937 SUBROUTINE create_boundary_get_mask( td_level1, td_dom1, &938 & td_var, td_mask )939 940 IMPLICIT NONE941 942 ! Argument943 TYPE(TFILE), INTENT(IN ) :: td_level1944 TYPE(TDOM) , INTENT(IN ) :: td_dom1945 TYPE(TVAR) , INTENT(IN ) :: td_var946 TYPE(TVAR) , INTENT( OUT) :: td_mask947 948 ! local variable949 TYPE(TFILE) :: tl_level1950 951 TYPE(TMPP) :: tl_mpplevel1952 953 ! loop indices954 !----------------------------------------------------------------955 !read variables on domain (ugly way to do it, have to work on it)956 957 !1 init mpp structure958 tl_level1=td_level1959 tl_mpplevel1=mpp_init(tl_level1)960 961 CALL file_clean(tl_level1)962 963 !2 get processor to be used964 CALL mpp_get_use( tl_mpplevel1, td_dom1 )965 966 !3 open mpp files967 CALL iom_mpp_open(tl_mpplevel1)968 969 !4 read variable value on domain970 SELECT CASE(TRIM(td_var%c_point))971 CASE('T')972 td_mask=iom_mpp_read_var(tl_mpplevel1,'tlevel',td_dom=td_dom1)973 CASE('U')974 td_mask=iom_mpp_read_var(tl_mpplevel1,'ulevel',td_dom=td_dom1)975 CASE('V')976 td_mask=iom_mpp_read_var(tl_mpplevel1,'vlevel',td_dom=td_dom1)977 CASE('F')978 td_mask=iom_mpp_read_var(tl_mpplevel1,'flevel',td_dom=td_dom1)979 END SELECT980 981 !5 close mpp files982 CALL iom_mpp_close(tl_mpplevel1)983 984 !6 clean structure985 CALL mpp_clean(tl_mpplevel1)986 987 END SUBROUTINE create_boundary_get_mask988 !> @endcode989 ! !-------------------------------------------------------------------990 ! !> @brief991 ! !> This subroutine992 ! !>993 ! !> @details994 ! !>995 ! !> @author J.Paul996 ! !> - Nov, 2013- Initial Version997 ! !>998 ! !> @param[in]999 ! !> @todo1000 ! !-------------------------------------------------------------------1001 ! !> @code1002 ! SUBROUTINE create_boundary_get_var( td_var, td_bdy, &1003 ! & td_coord0, td_dom0, &1004 ! & td_mask, &1005 ! & id_rhoi, id_rhoj )1006 !1007 ! IMPLICIT NONE1008 !1009 ! ! Argument1010 ! TYPE(TVAR) , INTENT(INOUT) :: td_var1011 ! TYPE(TBDY) , INTENT(IN ) :: td_bdy1012 ! TYPE(TFILE), INTENT(IN ) :: td_coord01013 ! TYPE(TDOM) , INTENT(IN ) :: td_dom01014 ! TYPE(TVAR) , INTENT(IN ) :: td_mask1015 ! INTEGER(I4), INTENT(IN ) :: id_rhoi1016 ! INTEGER(I4), INTENT(IN ) :: id_rhoj1017 !1018 ! ! local variable1019 ! TYPE(TVAR) :: tl_var01020 !1021 ! TYPE(TDOM) :: tl_dom01022 !1023 ! TYPE(TFILE) :: tl_file01024 !1025 ! TYPE(TMPP) :: tl_mppfile01026 !1027 ! ! loop indices1028 ! INTEGER(i4) :: jk1029 ! INTEGER(i4) :: jl1030 ! !----------------------------------------------------------------1031 !1032 ! CALL logger_debug("CREATE BOUNDARY INTERP: read coarse grid"// TRIM(td_var%c_file) )1033 ! !1- read coarse grid variable on domain1034 ! tl_file0=file_init( TRIM(td_var%c_file) )1035 !1036 ! !2- init1037 ! tl_dom0=td_dom01038 !1039 ! !3- add extra band (if possible) to compute interpolation1040 ! CALL dom_add_extra(tl_dom0)1041 !1042 ! !4- read variables on domain (ugly way to do it, have to work on it)1043 ! !4-1 init mpp structure1044 ! tl_mppfile0=mpp_init(tl_file0)1045 !1046 ! CALL file_clean(tl_file0)1047 !1048 ! !4-2 get processor to be used1049 ! CALL mpp_get_use( tl_mppfile0, tl_dom0 )1050 !1051 ! !4-3 open mpp files1052 ! CALL iom_mpp_open(tl_mppfile0)1053 !1054 ! ! check file dimension1055 ! IF( ANY(tl_mppfile0%t_dim(1:2)%i_len /= td_coord0%t_dim(1:2)%i_len) )THEN1056 ! CALL logger_error("CREATE BOUNDARY INTERP: dimension of file "//&1057 ! & TRIM(tl_mppfile0%c_name)//" not conform to those of "//&1058 ! & TRIM(td_coord0%c_name))1059 ! ELSE1060 !1061 ! !4-4 read variable value on domain1062 ! tl_var0=iom_mpp_read_var( tl_mppfile0, TRIM(td_var%c_name), &1063 ! & td_dom=tl_dom0 )1064 !1065 ! !5- work on variable1066 ! CALL create_boundary_interp(tl_var0, id_rhoi, id_rhoj )1067 !1068 ! !6- remove extraband added to domain1069 ! CALL dom_del_extra( tl_var0, tl_dom0, id_rhoi, id_rhoj )1070 !1071 ! !6-1 remove extraband added to domain1072 ! CALL dom_clean_extra( tl_dom0 )1073 !1074 ! !7- keep only useful point (width)1075 ! ! interpolation could create more point than necessary1076 ! CALL boundary_clean_interp(tl_var0, td_bdy )1077 !1078 ! !8- forced min and max value1079 ! CALL var_limit_value(tl_var0)1080 !1081 ! !9- filter1082 ! CALL filter_fill_value(tl_var0)1083 !1084 ! td_var=tl_var01085 !1086 ! CALL var_clean(tl_var0)1087 ! ENDIF1088 !1089 ! !4-5 close mpp files1090 ! CALL iom_mpp_close(tl_mppfile0)1091 !1092 ! !4-6 clean structure1093 ! CALL mpp_clean(tl_mppfile0)1094 !1095 ! !5- apply mask1096 ! DO jl=1,td_var%t_dim(4)%i_len1097 ! DO jk=1,td_var%t_dim(3)%i_len1098 ! WHERE( td_mask%d_value(:,:,1,1) < jk )1099 ! td_var%d_value(:,:,jk,jl)=td_var%d_fill1100 ! END WHERE1101 ! ENDDO1102 ! ENDDO1103 !1104 ! END SUBROUTINE create_boundary_get_var1105 ! !> @endcode1106 !-------------------------------------------------------------------1107 !> @brief1108 !> This subroutine1109 !>1110 !> @details1111 !>1112 !> @author J.Paul1113 !> - Nov, 2013- Initial Version1114 !>1115 !> @param[in]1116 !> @todo1117 !-------------------------------------------------------------------1118 !> @code1119 1341 SUBROUTINE create_boundary_interp( td_var, & 1120 1342 & id_rho, & … … 1134 1356 1135 1357 ! local variable 1136 TYPE(TVAR) :: tl_var1137 1138 1358 INTEGER(i4) :: il_iext 1139 1359 INTEGER(i4) :: il_jext 1140 1360 ! loop indices 1141 1361 !---------------------------------------------------------------- 1142 1143 ! copy variable1144 tl_var=td_var1145 1362 1146 1363 !WARNING: at least two extrabands are required for cubic interpolation … … 1163 1380 ENDIF 1164 1381 1165 ! 2-work on variable1166 ! 2-0add extraband1167 CALL extrap_add_extrabands(t l_var, il_iext, il_jext)1168 1169 ! 2-1extrapolate variable1170 CALL extrap_fill_value( t l_var, id_iext=il_iext, id_jext=il_jext)1171 1172 ! 2-2interpolate Bathymetry1173 CALL interp_fill_value( t l_var, id_rho(:), &1382 ! work on variable 1383 ! add extraband 1384 CALL extrap_add_extrabands(td_var, il_iext, il_jext) 1385 1386 ! extrapolate variable 1387 CALL extrap_fill_value( td_var ) 1388 1389 ! interpolate Bathymetry 1390 CALL interp_fill_value( td_var, id_rho(:), & 1174 1391 & id_offset=id_offset(:,:) ) 1175 1392 1176 !2-3 remove extraband 1177 CALL extrap_del_extrabands(tl_var, il_iext*id_rho(jp_I), il_jext*id_rho(jp_J)) 1178 1179 !3- save result 1180 td_var=tl_var 1181 1182 ! clean variable structure 1183 CALL var_clean(tl_var) 1393 ! remove extraband 1394 CALL extrap_del_extrabands(td_var, il_iext*id_rho(jp_I), & 1395 & il_jext*id_rho(jp_J)) 1184 1396 1185 1397 END SUBROUTINE create_boundary_interp 1186 !> @endcode1187 1398 !------------------------------------------------------------------- 1188 1399 !> @brief … … 1192 1403 !> A variable is create with the same name that the input variable, 1193 1404 !> and with dimension of the coordinate file. 1194 !> Then the variable tableof value is split into equal subdomain.1405 !> Then the variable array of value is split into equal subdomain. 1195 1406 !> Each subdomain is fill with the linked value of the matrix. 1196 1407 !> 1197 1408 !> @author J.Paul 1198 !> - Nov, 2013- Initial Version1409 !> @date November, 2013 - Initial Version 1199 1410 !> 1200 !> @param[in] td_var :variable structure1201 !> @param[in] td_dom :domain structure1202 !> @param[in] td_coord : coordinate1411 !> @param[in] td_var variable structure 1412 !> @param[in] td_dom domain structure 1413 !> @param[in] id_nlevel number of levels 1203 1414 !> @return variable structure 1204 1415 !------------------------------------------------------------------- 1205 !> @code 1206 FUNCTION create_bdy_matrix(td_var, td_dom, td_coord) 1416 FUNCTION create_boundary_matrix(td_var, td_dom, id_nlevel) 1207 1417 IMPLICIT NONE 1208 1418 ! Argument 1209 TYPE(TVAR) , INTENT(IN) :: td_var1210 TYPE(TDOM) , INTENT(IN) :: td_dom1211 TYPE(TFILE), INTENT(IN) :: td_coord1419 TYPE(TVAR) , INTENT(IN) :: td_var 1420 TYPE(TDOM) , INTENT(IN) :: td_dom 1421 INTEGER(i4), INTENT(IN) :: id_nlevel 1212 1422 1213 1423 ! function 1214 TYPE(TVAR) :: create_b dy_matrix1424 TYPE(TVAR) :: create_boundary_matrix 1215 1425 1216 1426 ! local variable 1217 INTEGER(i4) :: il_ighost1218 INTEGER(i4) :: il_jghost1219 INTEGER(i4) , DIMENSION(2) :: il_xghost1220 1427 INTEGER(i4) , DIMENSION(3) :: il_dim 1221 1428 INTEGER(i4) , DIMENSION(3) :: il_size … … 1228 1435 REAL(dp) , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value 1229 1436 1230 TYPE(TVAR) :: tl_lon1231 TYPE(TVAR) :: tl_lat1232 TYPE(TVAR) :: tl_var1233 1437 TYPE(TDIM) , DIMENSION(ip_maxdim) :: tl_dim 1234 1438 … … 1239 1443 !---------------------------------------------------------------- 1240 1444 1241 !1- read output grid 1242 tl_lon=iom_read_var(td_coord,'longitude') 1243 tl_lat=iom_read_var(td_coord,'latitude') 1244 1245 !2- look for ghost cell 1246 il_xghost(:)=grid_get_ghost( tl_lon, tl_lat ) 1247 1248 il_ighost=il_xghost(1)*ig_ghost 1249 il_jghost=il_xghost(2)*ig_ghost 1250 1251 !3- write value on grid 1252 !3-1 get matrix dimension 1445 ! write value on grid 1446 ! get matrix dimension 1253 1447 il_dim(:)=td_var%t_dim(1:3)%i_len 1254 !3-2 output dimension 1255 tl_dim(:)=tl_lon%t_dim(:) 1256 1257 ! remove ghost cell 1258 tl_dim(1)%i_len=tl_dim(1)%i_len - 2*il_xghost(1)*ig_ghost 1259 tl_dim(2)%i_len=tl_dim(2)%i_len - 2*il_xghost(2)*ig_ghost 1260 1261 !3-3 split output domain in N subdomain depending of matrix dimension 1448 1449 tl_dim(jp_I:jp_J)=dim_copy(td_dom%t_dim(jp_I:jp_J)) 1450 tl_dim(jp_K)%i_len=id_nlevel 1451 1452 ! split output domain in N subdomain depending of matrix dimension 1262 1453 il_size(:) = tl_dim(1:3)%i_len / il_dim(:) 1263 1454 il_rest(:) = MOD(tl_dim(1:3)%i_len, il_dim(:)) … … 1271 1462 il_ishape(il_dim(1)+1)=il_ishape(il_dim(1)+1)+il_rest(1) 1272 1463 1273 1274 1464 ALLOCATE( il_jshape(il_dim(2)+1) ) 1275 1465 il_jshape(:)=0 … … 1288 1478 il_kshape(il_dim(3)+1)=il_kshape(il_dim(3)+1)+il_rest(3) 1289 1479 1290 ! 3-3 write ouput tableof value1480 ! write ouput array of value 1291 1481 ALLOCATE(dl_value( tl_dim(1)%i_len, & 1292 1482 & tl_dim(2)%i_len, & … … 1309 1499 ENDDO 1310 1500 1311 ! 3-4initialise variable with value1312 tl_var=var_init(TRIM(td_var%c_name),dl_value(:,:,:,:))1501 ! initialise variable with value 1502 create_boundary_matrix=var_init(TRIM(td_var%c_name),dl_value(:,:,:,:)) 1313 1503 1314 1504 DEALLOCATE(dl_value) 1315 1505 1316 !4- add ghost cell 1317 CALL grid_add_ghost(tl_var,il_ighost,il_jghost) 1318 1319 !5- save result 1320 create_bdy_matrix=tl_var 1321 1322 END FUNCTION create_bdy_matrix 1323 !> @endcode 1506 END FUNCTION create_boundary_matrix 1324 1507 !------------------------------------------------------------------- 1325 1508 !> @brief 1326 !> This subroutine 1509 !> This subroutine use mask to filled land point with _FillValue 1327 1510 !> 1328 1511 !> @details 1329 1512 !> 1330 1513 !> @author J.Paul 1331 !> - Nov, 2013- Initial Version1514 !> @date November, 2013 - Initial Version 1332 1515 !> 1333 !> @param[in ]1334 !> @ todo1516 !> @param[inout] td_var variable structure 1517 !> @param[in] td_mask mask variable structure 1335 1518 !------------------------------------------------------------------- 1336 !> @code 1337 SUBROUTINE create_bdy_use_mask( td_var, td_mask ) 1519 SUBROUTINE create_boundary_use_mask( td_var, td_mask ) 1338 1520 1339 1521 IMPLICIT NONE 1340 1522 1341 1523 ! Argument 1342 TYPE(TVAR) 1343 TYPE(TVAR), DIMENSION(:),INTENT(IN ) :: td_mask1524 TYPE(TVAR), INTENT(INOUT) :: td_var 1525 TYPE(TVAR), INTENT(IN ) :: td_mask 1344 1526 1345 1527 ! local variable … … 1351 1533 !---------------------------------------------------------------- 1352 1534 1535 IF( ANY(td_var%t_dim(1:2)%i_len /= & 1536 & td_mask%t_dim(1:2)%i_len) )THEN 1537 CALL logger_debug(" mask dimension ( "//& 1538 & TRIM(fct_str(td_mask%t_dim(1)%i_len))//","//& 1539 & TRIM(fct_str(td_mask%t_dim(2)%i_len))//")" ) 1540 CALL logger_debug(" variable dimension ( "//& 1541 & TRIM(fct_str(td_var%t_dim(1)%i_len))//","//& 1542 & TRIM(fct_str(td_var%t_dim(2)%i_len))//")" ) 1543 CALL logger_fatal("CREATE BOUNDARY USE MASK: mask and "//& 1544 & "variable dimension differ." ) 1545 ENDIF 1546 1353 1547 ALLOCATE( il_mask(td_var%t_dim(1)%i_len, & 1354 1548 & td_var%t_dim(2)%i_len) ) 1355 1549 1356 SELECT CASE(TRIM(td_var%c_point)) 1357 CASE('T') 1358 il_mask(:,:)=INT(td_mask(jp_T)%d_value(:,:,1,1)) 1359 CASE('U') 1360 il_mask(:,:)=INT(td_mask(jp_U)%d_value(:,:,1,1)) 1361 CASE('V') 1362 il_mask(:,:)=INT(td_mask(jp_V)%d_value(:,:,1,1)) 1363 CASE('F') 1364 il_mask(:,:)=INT(td_mask(jp_F)%d_value(:,:,1,1)) 1365 END SELECT 1550 il_mask(:,:)=INT(td_mask%d_value(:,:,1,1)) 1366 1551 1367 1552 DO jl=1,td_var%t_dim(4)%i_len … … 1372 1557 1373 1558 DEALLOCATE( il_mask ) 1374 END SUBROUTINE create_bdy_use_mask 1375 !> @endcode1559 1560 END SUBROUTINE create_boundary_use_mask 1376 1561 !------------------------------------------------------------------- 1377 1562 !> @brief 1563 !> This function extract level over domain on each grid point, and return 1564 !> array of variable structure 1565 !> 1566 !> @author J.Paul 1567 !> @date November, 2013 - Initial Version 1568 !> 1569 !> @param[in] td_level array of level variable structure 1570 !> @param[in] td_dom array of domain structure 1571 !> @return array of variable structure 1572 !------------------------------------------------------------------- 1573 FUNCTION create_boundary_get_level(td_level, td_dom) 1574 IMPLICIT NONE 1575 ! Argument 1576 TYPE(TVAR), DIMENSION(:), INTENT(IN) :: td_level 1577 TYPE(TDOM), DIMENSION(:), INTENT(IN) :: td_dom 1578 1579 ! function 1580 TYPE(TVAR), DIMENSION(ip_npoint) :: create_boundary_get_level 1581 1582 ! local variable 1583 TYPE(TVAR), DIMENSION(ip_npoint) :: tl_var 1584 1585 ! loop indices 1586 INTEGER(i4) :: ji 1587 !---------------------------------------------------------------- 1588 1589 IF( SIZE(td_level(:)) /= ip_npoint .OR. & 1590 & SIZE(td_dom(:)) /= ip_npoint )THEN 1591 CALL logger_error("CREATE BDY GET LEVEL: invalid dimension. "//& 1592 & "check input array of level and domain.") 1593 ELSE 1594 1595 DO ji=1,ip_npoint 1596 1597 tl_var(ji)=var_copy(td_level(ji)) 1598 1599 IF( ASSOCIATED(tl_var(ji)%d_value) ) DEALLOCATE(tl_var(ji)%d_value) 1600 1601 tl_var(ji)%t_dim(1)%i_len=td_dom(ji)%t_dim(1)%i_len 1602 tl_var(ji)%t_dim(2)%i_len=td_dom(ji)%t_dim(2)%i_len 1603 ALLOCATE(tl_var(ji)%d_value(tl_var(ji)%t_dim(1)%i_len, & 1604 & tl_var(ji)%t_dim(2)%i_len, & 1605 & tl_var(ji)%t_dim(3)%i_len, & 1606 & tl_var(ji)%t_dim(4)%i_len) ) 1607 1608 tl_var(ji)%d_value(:,:,:,:) = & 1609 & td_level(ji)%d_value( td_dom(ji)%i_imin:td_dom(ji)%i_imax, & 1610 & td_dom(ji)%i_jmin:td_dom(ji)%i_jmax, :, : ) 1611 1612 ENDDO 1613 ! save result 1614 create_boundary_get_level(:)=var_copy(tl_var(:)) 1615 1616 ! clean 1617 CALL var_clean(tl_var(:)) 1618 1619 ENDIF 1620 END FUNCTION create_boundary_get_level 1621 !------------------------------------------------------------------- 1622 !> @brief 1623 !> This subroutine get depth variable value in an open mpp structure 1624 !> and check if agree with already input depth variable. 1378 1625 !> 1379 1626 !> @details 1380 1627 !> 1381 1628 !> @author J.Paul 1382 !> - 2013- Initial Version1629 !> @date November, 2014 - Initial Version 1383 1630 !> 1631 !> @param[in] td_mpp mpp structure 1632 !> @param[inout] td_depth depth variable structure 1384 1633 !------------------------------------------------------------------- 1385 !> @code1386 FUNCTION create_bdy_get_level(td_level, td_dom) 1634 SUBROUTINE create_boundary_check_depth( td_mpp, td_depth ) 1635 1387 1636 IMPLICIT NONE 1637 1388 1638 ! Argument 1389 TYPE(TVAR), DIMENSION(:), INTENT(IN) :: td_level 1390 TYPE(TDOM) , INTENT(IN) :: td_dom 1391 1392 ! function 1393 TYPE(TVAR), DIMENSION(ig_npoint) :: create_bdy_get_level 1639 TYPE(TMPP) , INTENT(IN ) :: td_mpp 1640 TYPE(TVAR) , INTENT(INOUT) :: td_depth 1394 1641 1395 1642 ! local variable 1396 TYPE(TVAR), DIMENSION(ig_npoint) :: tl_var1397 1643 INTEGER(i4) :: il_varid 1644 TYPE(TVAR) :: tl_depth 1398 1645 ! loop indices 1399 INTEGER(i4) :: ji1400 1646 !---------------------------------------------------------------- 1401 1647 1402 IF( SIZE(td_level(:)) /= ig_npoint )THEN 1403 CALL logger_error("CREATE BDY GET LEVEL: invalid dimension. "//& 1404 & "check input table of level.") 1405 ELSE 1406 1407 !tl_var(1:ig_npoint)=td_level(1:ig_npoint) 1408 create_bdy_get_level(:)=tl_var(:) 1409 DO ji=1,ig_npoint 1410 1411 tl_var(ji)=td_level(ji) 1412 1413 IF( ASSOCIATED(tl_var(ji)%d_value) ) DEALLOCATE( tl_var(ji)%d_value ) 1414 1415 tl_var(ji)%t_dim(1)%i_len=td_dom%t_dim(1)%i_len 1416 tl_var(ji)%t_dim(2)%i_len=td_dom%t_dim(2)%i_len 1417 ALLOCATE(tl_var(ji)%d_value(tl_var(ji)%t_dim(1)%i_len, & 1418 & tl_var(ji)%t_dim(2)%i_len, & 1419 & tl_var(ji)%t_dim(3)%i_len, & 1420 & tl_var(ji)%t_dim(4)%i_len) ) 1421 1422 tl_var(ji)%d_value(:,:,:,:) = & 1423 & td_level(ji)%d_value( td_dom%i_imin:td_dom%i_imax, & 1424 & td_dom%i_jmin:td_dom%i_jmax, :, : ) 1425 1426 ENDDO 1427 !4 save result 1428 create_bdy_get_level(:)=tl_var(:) 1648 ! get or check depth value 1649 IF( td_mpp%t_proc(1)%i_depthid /= 0 )THEN 1650 1651 il_varid=td_mpp%t_proc(1)%i_depthid 1652 IF( ASSOCIATED(td_depth%d_value) )THEN 1653 1654 tl_depth=iom_mpp_read_var(td_mpp, il_varid) 1655 IF( ANY( td_depth%d_value(:,:,:,:) /= & 1656 & tl_depth%d_value(:,:,:,:) ) )THEN 1657 1658 CALL logger_fatal("CREATE BOUNDARY: depth value from "//& 1659 & TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//& 1660 & " to those from former file(s).") 1661 1662 ENDIF 1663 CALL var_clean(tl_depth) 1664 1665 ELSE 1666 td_depth=iom_mpp_read_var(td_mpp,il_varid) 1667 ENDIF 1429 1668 1430 1669 ENDIF 1431 END FUNCTION create_bdy_get_level 1432 !> @endcode 1670 1671 END SUBROUTINE create_boundary_check_depth 1672 !------------------------------------------------------------------- 1673 !> @brief 1674 !> This subroutine get date and time in an open mpp structure 1675 !> and check if agree with date and time already read. 1676 !> 1677 !> @details 1678 !> 1679 !> @author J.Paul 1680 !> @date November, 2014 - Initial Version 1681 !> 1682 !> @param[in] td_mpp mpp structure 1683 !> @param[inout] td_time time variable structure 1684 !------------------------------------------------------------------- 1685 SUBROUTINE create_boundary_check_time( td_mpp, td_time ) 1686 1687 IMPLICIT NONE 1688 1689 ! Argument 1690 TYPE(TMPP), INTENT(IN ) :: td_mpp 1691 TYPE(TVAR), INTENT(INOUT) :: td_time 1692 1693 ! local variable 1694 INTEGER(i4) :: il_varid 1695 TYPE(TVAR) :: tl_time 1696 1697 TYPE(TDATE) :: tl_date1 1698 TYPE(TDATE) :: tl_date2 1699 ! loop indices 1700 !---------------------------------------------------------------- 1701 1702 ! get or check depth value 1703 IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN 1704 1705 il_varid=td_mpp%t_proc(1)%i_timeid 1706 IF( ASSOCIATED(td_time%d_value) )THEN 1707 1708 tl_time=iom_mpp_read_var(td_mpp, il_varid) 1709 1710 tl_date1=var_to_date(td_time) 1711 tl_date2=var_to_date(tl_time) 1712 IF( tl_date1 - tl_date2 /= 0 )THEN 1713 1714 CALL logger_fatal("CREATE BOUNDARY: date from "//& 1715 & TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//& 1716 & " to those from former file(s).") 1717 1718 ENDIF 1719 CALL var_clean(tl_time) 1720 1721 ELSE 1722 td_time=iom_mpp_read_var(td_mpp,il_varid) 1723 ENDIF 1724 1725 ENDIF 1726 1727 END SUBROUTINE create_boundary_check_time 1433 1728 END PROGRAM create_boundary
Note: See TracChangeset
for help on using the changeset viewer.
