Changeset 5240 for branches/UKMO/dev_r5021_nn_etau_revision/NEMOGCM/TOOLS/SIREN/src/create_boundary.f90
- Timestamp:
- 2015-04-29T12:17:12+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5021_nn_etau_revision/NEMOGCM/TOOLS/SIREN/src/create_boundary.f90
r4213 r5240 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 !> 26 !> create_boundary.nam comprise 9 namelists:<br/> 27 !> - logger namelist (namlog) 28 !> - config namelist (namcfg) 29 !> - coarse grid namelist (namcrs) 30 !> - fine grid namelist (namfin) 31 !> - variable namelist (namvar) 32 !> - nesting namelist (namnst) 33 !> - boundary namelist (nambdy) 34 !> - vertical grid namelist (namzgr) 35 !> - output namelist (namout) 36 !> 37 !> @note 38 !> All namelists have to be in file create_boundary.nam, 39 !> however variables of those namelists are all optional. 40 !> 41 !> * _logger namelist (namlog)_:<br/> 42 !> - cn_logfile : log filename 43 !> - cn_verbosity : verbosity ('trace','debug','info', 44 !> 'warning','error','fatal') 45 !> - in_maxerror : maximum number of error allowed 46 !> 47 !> * _config namelist (namcfg)_:<br/> 48 !> - cn_varcfg : variable configuration file 49 !> (see ./SIREN/cfg/variable.cfg) 50 !> 51 !> * _coarse grid namelist (namcrs)_:<br/> 52 !> - cn_coord0 : coordinate file 53 !> - in_perio0 : NEMO periodicity index (see Model Boundary Condition in 54 !> [NEMO documentation](http://www.nemo-ocean.eu/About-NEMO/Reference-manuals)) 55 !> 56 !> * _fine grid namelist (namfin)_:<br/> 57 !> - cn_coord1 : coordinate file 58 !> - cn_bathy1 : bathymetry file 59 !> - in_perio1 : periodicity index 60 !> 61 !> * _vertical grid namelist (namzgr)_:<br/> 62 !> - dn_pp_to_be_computed : 63 !> - dn_ppsur : 64 !> - dn_ppa0 : 65 !> - dn_ppa1 : 66 !> - dn_ppa2 : 67 !> - dn_ppkth : 68 !> - dn_ppkth2 : 69 !> - dn_ppacr : 70 !> - dn_ppacr2 : 71 !> - dn_ppdzmin : 72 !> - dn_pphmax : 73 !> - in_nlevel : number of vertical level 74 !> 75 !> * _partial step namelist (namzps)_:<br/> 76 !> - dn_e3zps_mi : 77 !> - dn_e3zps_rat : 78 !> 79 !> * _variable namelist (namvar)_:<br/> 80 !> - cn_varinfo : list of variable and extra information about request(s) 81 !> to be used.<br/> 82 !> each elements of *cn_varinfo* is a string character.<br/> 83 !> it is composed of the variable name follow by ':', 84 !> then request(s) to be used on this variable.<br/> 85 !> request could be: 86 !> - interpolation method 87 !> - extrapolation method 88 !> - filter method 89 !> 90 !> requests must be separated by ';'.<br/> 91 !> order of requests does not matter. 92 !> 93 !> informations about available method could be find in @ref interp, 94 !> @ref extrap and @ref filter.<br/> 95 !> 96 !> Example: 'votemper:linear;hann;dist_weight', 'vosaline:cubic' 97 !> @note 98 !> If you do not specify a method which is required, 99 !> default one is apply. 100 !> - cn_varfile : list of variable, and corresponding file<br/> 101 !> *cn_varfile* is the path and filename of the file where find 102 !> variable.<br/> 103 !> @note 104 !> *cn_varfile* could be a matrix of value, if you want to filled 105 !> manually variable value.<br/> 106 !> the variable array of value is split into equal subdomain.<br/> 107 !> Each subdomain is filled with the corresponding value 108 !> of the matrix.<br/> 109 !> separators used to defined matrix are: 110 !> - ',' for line 111 !> - '/' for row 112 !> - '\' for level<br/> 113 !> Example:<br/> 114 !> 3,2,3/1,4,5 => @f$ \left( \begin{array}{ccc} 115 !> 3 & 2 & 3 \\ 116 !> 1 & 4 & 5 \end{array} \right) @f$ 117 !> @warning 118 !> the same matrix is used for all boundaries. 119 !> 120 !> Examples: 121 !> - 'votemper:gridT.nc', 'vozocrtx:gridU.nc' 122 !> - 'votemper:10\25', 'vozocrtx:gridU.nc' 123 !> 124 !> * _nesting namelist (namnst)_:<br/> 125 !> - in_rhoi : refinement factor in i-direction 126 !> - in_rhoj : refinement factor in j-direction 127 !> 128 !> * _boundary namelist (nambdy)_:<br/> 129 !> - ln_north : use north boundary 130 !> - ln_south : use south boundary 131 !> - ln_east : use east boundary 132 !> - ln_west : use west boundary 133 !> - cn_north : north boundary indices on fine grid 134 !> *cn_north* is a string character defining boundary 135 !> segmentation.<br/> 136 !> segments are separated by '|'.<br/> 137 !> each segments of the boundary is composed of: 138 !> - orthogonal indice (.ie. for north boundary, 139 !> J-indice where boundary are). 140 !> - first indice of boundary (I-indice for north boundary) 141 !> - last indice of boundary (I-indice for north boundary)<br/> 142 !> indices must be separated by ',' .<br/> 143 !> - optionally, boundary size could be added between '(' and ')' 144 !> in the first segment defined. 145 !> @note 146 !> boundary width is the same for all segments of one boundary. 147 !> 148 !> Examples: 149 !> - cn_north='index1,first1,last1(width)' 150 !> - cn_north='index1(width),first1,last1|index2,first2,last2' 151 !> 152 !> \image html boundary_50.png 153 !> \image latex boundary_50.png 154 !> 155 !> - cn_south : south boundary indices on fine grid 156 !> - cn_east : east boundary indices on fine grid 157 !> - cn_west : west boundary indices on fine grid 158 !> - ln_oneseg : use only one segment for each boundary or not 159 !> - in_extrap : number of mask point to be extrapolated 160 !> 161 !> * _output namelist (namout)_:<br/> 162 !> - cn_fileout : fine grid boundary basename 163 !> (cardinal and segment number will be automatically added) 164 !> 165 !> @author J.Paul 18 166 ! REVISION HISTORY: 19 !> @date Nov, 2013 - Initial Version 20 ! 167 !> @date November, 2013 - Initial Version 168 !> @date September, 2014 169 !> - add header for user 170 !> - take into account grid point to compue boundaries 171 !> - reorder output dimension for north and south boundaries 172 !> 21 173 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 22 !>23 !> @todo24 174 !---------------------------------------------------------------------- 25 !> @code26 175 PROGRAM create_boundary 27 176 … … 57 206 CHARACTER(LEN=lc) :: cl_bdyout 58 207 CHARACTER(LEN=lc) :: cl_data 208 CHARACTER(LEN=lc) :: cl_dimorder 209 CHARACTER(LEN=lc) :: cl_point 210 CHARACTER(LEN=lc) :: cl_fmt 59 211 60 212 INTEGER(i4) :: il_narg 61 213 INTEGER(i4) :: il_status 62 214 INTEGER(i4) :: il_fileid 63 INTEGER(i4) :: il_attid64 215 INTEGER(i4) :: il_dim 65 216 INTEGER(i4) :: il_imin0 … … 67 218 INTEGER(i4) :: il_jmin0 68 219 INTEGER(i4) :: il_jmax0 220 INTEGER(i4) :: il_shift 69 221 INTEGER(i4) , DIMENSION(ip_maxdim) :: il_rho 70 222 INTEGER(i4) , DIMENSION(2,2) :: il_offset 71 INTEGER(i4) , DIMENSION(2,2 ,2):: il_ind223 INTEGER(i4) , DIMENSION(2,2) :: il_ind 72 224 73 225 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 226 86 227 TYPE(TATT) :: tl_att 87 228 229 TYPE(TVAR) :: tl_depth 230 TYPE(TVAR) :: tl_time 231 TYPE(TVAR) :: tl_var1 232 TYPE(TVAR) :: tl_var0 233 TYPE(TVAR) :: tl_lon1 234 TYPE(TVAR) :: tl_lat1 235 TYPE(TVAR) :: tl_lvl1 88 236 TYPE(TVAR) , DIMENSION(:) , ALLOCATABLE :: tl_level 89 237 TYPE(TVAR) , DIMENSION(:,:,:) , ALLOCATABLE :: tl_seglvl1 90 TYPE(TVAR) :: tl_var191 238 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 239 101 240 TYPE(TDIM) , DIMENSION(ip_maxdim) :: tl_dim … … 104 243 105 244 TYPE(TDOM) :: tl_dom0 106 TYPE(TDOM) , DIMENSION(:,:) , ALLOCATABLE :: tl_segdom1 245 TYPE(TDOM) :: tl_dom1 246 TYPE(TDOM) , DIMENSION(:,:,:) , ALLOCATABLE :: tl_segdom1 247 248 TYPE(TFILE) :: tl_fileout 249 250 TYPE(TMPP) :: tl_coord0 251 TYPE(TMPP) :: tl_coord1 252 TYPE(TMPP) :: tl_bathy1 253 TYPE(TMPP) :: tl_mpp 254 255 TYPE(TMULTI) :: tl_multi 107 256 108 257 ! loop indices 109 258 INTEGER(i4) :: jvar 259 INTEGER(i4) :: jpoint 110 260 INTEGER(i4) :: ji 111 261 INTEGER(i4) :: jj … … 117 267 CHARACTER(LEN=lc) :: cn_logfile = 'create_boundary.log' 118 268 CHARACTER(LEN=lc) :: cn_verbosity = 'warning' 269 INTEGER(i4) :: in_maxerror = 5 270 271 ! namcfg 272 CHARACTER(LEN=lc) :: cn_varcfg = 'variable.cfg' 119 273 120 274 ! namcrs … … 127 281 INTEGER(i4) :: in_perio1 = -1 128 282 129 ! namcfg130 CHARACTER(LEN=lc) :: cn_varcfg = 'variable.cfg'283 !namzgr 284 INTEGER(i4) :: in_nlevel = 75 131 285 132 286 ! namvar 133 CHARACTER(LEN=lc), DIMENSION(i g_maxvar) :: cn_varinfo = ''134 CHARACTER(LEN=lc), DIMENSION(i g_maxvar) :: cn_varfile = ''287 CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = '' 288 CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = '' 135 289 136 290 ! 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 291 INTEGER(i4) :: in_rhoi = 0 292 INTEGER(i4) :: in_rhoj = 0 143 293 144 294 ! nambdy … … 160 310 NAMELIST /namlog/ & !< logger namelist 161 311 & cn_logfile, & !< log file 162 & cn_verbosity !< log verbosity 312 & cn_verbosity, & !< log verbosity 313 & in_maxerror 163 314 164 315 NAMELIST /namcfg/ & !< config namelist … … 174 325 & in_perio1 !< periodicity index 175 326 327 NAMELIST /namzgr/ & 328 & in_nlevel 329 176 330 NAMELIST /namvar/ & !< variable namelist 177 331 & cn_varinfo, & !< list of variable and method to apply on. (ex: 'votemper:linear','vosaline:cubic' ) … … 179 333 180 334 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 335 & in_rhoi, & !< refinement factor in i-direction 186 336 & in_rhoj !< refinement factor in j-direction … … 196 346 & cn_west , & !< west boundary indices on fine grid 197 347 & ln_oneseg, & !< use only one segment for each boundary or not 198 & in_extrap !< number of mask point to extrapolate348 & in_extrap !< number of mask point to be extrapolated 199 349 200 350 NAMELIST /namout/ & !< output namelist … … 202 352 !------------------------------------------------------------------- 203 353 204 ! 1-namelist205 ! 1-1get namelist354 ! namelist 355 ! get namelist 206 356 il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec 207 357 IF( il_narg/=1 )THEN … … 212 362 ENDIF 213 363 214 ! 1-2read namelist364 ! read namelist 215 365 INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist) 216 366 IF( ll_exist )THEN … … 231 381 232 382 READ( il_fileid, NML = namlog ) 233 ! 1-2-1define log file234 CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity) )383 ! define log file 384 CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror) 235 385 CALL logger_header() 236 386 237 387 READ( il_fileid, NML = namcfg ) 238 ! 1-2-2get variable extra information388 ! get variable extra information 239 389 CALL var_def_extra(TRIM(cn_varcfg)) 240 390 241 391 READ( il_fileid, NML = namcrs ) 242 392 READ( il_fileid, NML = namfin ) 393 READ( il_fileid, NML = namzgr ) 243 394 READ( il_fileid, NML = namvar ) 244 ! 1-2-3add user change in extra information395 ! add user change in extra information 245 396 CALL var_chg_extra(cn_varinfo) 246 ! 1-2-4match variable with file397 ! match variable with file 247 398 tl_multi=multi_init(cn_varfile) 248 399 249 400 READ( il_fileid, NML = namnst ) 250 401 READ( il_fileid, NML = nambdy ) 251 252 402 READ( il_fileid, NML = namout ) 253 403 … … 261 411 262 412 PRINT *,"CREATE BOUNDARY: ERROR. can not find "//TRIM(cl_namelist) 413 STOP 263 414 264 415 ENDIF 265 416 266 !2- open files 417 CALL multi_print(tl_multi) 418 IF( tl_multi%i_nvar <= 0 )THEN 419 CALL logger_fatal("CREATE BOUNDARY: no variable to be used."//& 420 & " check namelist.") 421 ENDIF 422 423 ! open files 267 424 IF( TRIM(cn_coord0) /= '' )THEN 268 tl_coord0= file_init(TRIM(cn_coord0),id_perio=in_perio0)269 CALL iom_open(tl_coord0)425 tl_coord0=mpp_init( file_init(TRIM(cn_coord0)), id_perio=in_perio0) 426 CALL grid_get_info(tl_coord0) 270 427 ELSE 271 428 CALL logger_fatal("CREATE BOUNDARY: can not find coarse grid "//& … … 274 431 275 432 IF( TRIM(cn_coord1) /= '' )THEN 276 tl_coord1= file_init(TRIM(cn_coord1),id_perio=in_perio1)277 CALL iom_open(tl_coord1)433 tl_coord1=mpp_init( file_init(TRIM(cn_coord1)), id_perio=in_perio1) 434 CALL grid_get_info(tl_coord1) 278 435 ELSE 279 436 CALL logger_fatal("CREATE BOUNDARY: can not find fine grid coordinate "//& … … 282 439 283 440 IF( TRIM(cn_bathy1) /= '' )THEN 284 tl_bathy1= file_init(TRIM(cn_bathy1),id_perio=in_perio1)285 CALL iom_open(tl_bathy1)441 tl_bathy1=mpp_init( file_init(TRIM(cn_bathy1)), id_perio=in_perio1) 442 CALL grid_get_info(tl_bathy1) 286 443 ELSE 287 444 CALL logger_fatal("CREATE BOUNDARY: can not find fine grid bathymetry "//& … … 289 446 ENDIF 290 447 291 ! 3-check292 ! 3-1check output file do not already exist448 ! check 449 ! check output file do not already exist 293 450 DO jk=1,ip_ncard 294 451 cl_bdyout=boundary_set_filename( TRIM(cn_fileout), & 295 & TRIM( ip_card(jk)))452 & TRIM(cp_card(jk)), 1 ) 296 453 INQUIRE(FILE=TRIM(cl_bdyout), EXIST=ll_exist) 297 454 IF( ll_exist )THEN … … 301 458 ENDDO 302 459 303 ! 3-1check namelist304 ! 3-1-1check refinement factor460 ! check namelist 461 ! check refinement factor 305 462 il_rho(:)=1 306 463 IF( in_rhoi < 1 .OR. in_rhoj < 1 )THEN … … 312 469 ENDIF 313 470 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 471 ! 472 ! compute coarse grid indices around fine grid 473 il_ind(:,:)=grid_get_coarse_index(tl_coord0, tl_coord1, & 474 & id_rho=il_rho(:)) 475 476 il_imin0=il_ind(1,1) ; il_imax0=il_ind(1,2) 477 il_jmin0=il_ind(2,1) ; il_jmax0=il_ind(2,2) 478 479 ! check domain validity 327 480 CALL grid_check_dom(tl_coord0, il_imin0, il_imax0, il_jmin0, il_jmax0) 328 481 329 ! 3-3check coordinate file482 ! check coordinate file 330 483 CALL grid_check_coincidence( tl_coord0, tl_coord1, & 331 484 & il_imin0, il_imax0, & … … 333 486 & il_rho(:) ) 334 487 335 !4- read or compute boundary 336 tl_var1=iom_read_var(tl_bathy1,'Bathymetry') 488 ! read or compute boundary 489 CALL mpp_get_contour(tl_bathy1) 490 491 CALL iom_mpp_open(tl_bathy1) 492 493 tl_var1=iom_mpp_read_var(tl_bathy1,'Bathymetry') 494 495 CALL iom_mpp_close(tl_bathy1) 337 496 338 497 tl_bdy(:)=boundary_init(tl_var1, ln_north, ln_south, ln_east, ln_west, & … … 342 501 CALL var_clean(tl_var1) 343 502 344 ! 5-compute level345 ALLOCATE(tl_level(i g_npoint))503 ! compute level 504 ALLOCATE(tl_level(ip_npoint)) 346 505 tl_level(:)=vgrid_get_level(tl_bathy1, cl_namelist ) 347 506 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)) 507 ! get coordinate on each segment of each boundary 508 ALLOCATE( tl_segdom1(ip_npoint,ip_maxseg,ip_ncard) ) 509 ALLOCATE( tl_seglvl1(ip_npoint,ip_maxseg,ip_ncard) ) 510 511 DO jl=1,ip_ncard 512 IF( tl_bdy(jl)%l_use )THEN 513 DO jk=1,tl_bdy(jl)%i_nseg 514 515 ! get fine grid segment domain 516 tl_segdom1(:,jk,jl)=create_boundary_get_dom( tl_bathy1, & 517 & tl_bdy(jl), jk ) 518 519 ! add extra band to fine grid domain (if possible) 520 ! to avoid dimension of one and so be able to compute offset 521 DO jj=1,ip_npoint 522 CALL dom_add_extra(tl_segdom1(jj,jk,jl), & 523 & il_rho(jp_I), il_rho(jp_J)) 524 ENDDO 525 526 ! get fine grid level 527 tl_seglvl1(:,jk,jl)=create_boundary_get_level( tl_level(:), & 528 tl_segdom1(:,jk,jl)) 365 529 366 530 ENDDO … … 368 532 ENDDO 369 533 534 ! clean 535 CALL var_clean(tl_level(:)) 370 536 DEALLOCATE(tl_level) 371 537 372 !7- compute boundary for variable to be used (see namelist) 373 IF( .NOT. ASSOCIATED(tl_multi%t_file) )THEN 538 ! clean bathy 539 CALL mpp_clean(tl_bathy1) 540 541 ALLOCATE( tl_segvar1(tl_multi%i_nvar,ip_maxseg,ip_ncard) ) 542 ! compute boundary for variable to be used (see namelist) 543 IF( .NOT. ASSOCIATED(tl_multi%t_mpp) )THEN 374 544 CALL logger_error("CREATE BOUNDARY: no file to work on. "//& 375 545 & "check cn_varfile in namelist.") 376 546 ELSE 547 377 548 jvar=0 378 549 ! 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 550 DO ji=1,tl_multi%i_nmpp 551 552 WRITE(cl_data,'(a,i2.2)') 'data-',jvar+1 553 554 IF( .NOT. ASSOCIATED(tl_multi%t_mpp(ji)%t_proc(1)%t_var) )THEN 555 383 556 CALL logger_error("CREATE BOUNDARY: no variable to work on for "//& 384 & " file "//TRIM(tl_multi%t_file(ji)%c_name)//&557 & "mpp "//TRIM(tl_multi%t_mpp(ji)%c_name)//& 385 558 & ". check cn_varfile in namelist.") 559 560 ELSEIF( TRIM(tl_multi%t_mpp(ji)%c_name) == TRIM(cl_data) )THEN 561 !- use input matrix to fill variable 562 563 WRITE(*,'(a)') "work on data" 564 ! for each variable initialise from matrix 565 DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 566 567 jvar=jvar+1 568 WRITE(*,'(2x,a,a)') "work on variable "//& 569 & TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 570 571 tl_var1=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)) 572 573 SELECT CASE(TRIM(tl_var1%c_point)) 574 CASE DEFAULT !'T' 575 jpoint=jp_T 576 CASE('U') 577 jpoint=jp_U 578 CASE('V') 579 jpoint=jp_V 580 CASE('F') 581 jpoint=jp_F 582 END SELECT 583 584 WRITE(*,'(4x,a,a)') 'work on '//TRIM(tl_var1%c_name) 585 DO jl=1,ip_ncard 586 IF( tl_bdy(jl)%l_use )THEN 587 588 DO jk=1,tl_bdy(jl)%i_nseg 589 590 ! fill value with matrix data 591 tl_segvar1(jvar,jk,jl)=create_boundary_matrix( & 592 & tl_var1, & 593 & tl_segdom1(jpoint,jk,jl), & 594 & in_nlevel ) 595 596 ! use mask 597 CALL create_boundary_use_mask( tl_segvar1(jvar,jk,jl), & 598 & tl_seglvl1(jpoint,jk,jl)) 599 600 !del extra 601 CALL dom_del_extra( tl_segvar1(jvar,jk,jl), & 602 & tl_segdom1(jpoint,jk,jl) ) 603 604 ENDDO 605 606 ENDIF 607 ENDDO 608 609 ! clean 610 CALL var_clean(tl_var1) 611 612 ENDDO 613 614 !- end of use input matrix to fill variable 386 615 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 616 !- use file to fill variable 617 618 WRITE(*,'(a)') "work on file "//TRIM(tl_multi%t_mpp(ji)%c_name) 619 ! 620 tl_mpp=mpp_init(file_init(TRIM(tl_multi%t_mpp(ji)%t_proc(1)%c_name))) 621 CALL grid_get_info(tl_mpp) 622 623 ! check vertical dimension 624 IF( tl_mpp%t_dim(jp_K)%l_use .AND. & 625 & tl_mpp%t_dim(jp_K)%i_len /= in_nlevel )THEN 626 CALL logger_error("CREATE BOUNDARY: dimension in file "//& 627 & TRIM(tl_mpp%c_name)//" not agree with namelist in_nlevel ") 628 ENDIF 629 630 ! open mpp file 631 CALL iom_mpp_open(tl_mpp) 632 633 ! get or check depth value 634 CALL create_boundary_check_depth( tl_mpp, tl_depth ) 635 636 ! get or check time value 637 CALL create_boundary_check_time( tl_mpp, tl_time ) 638 639 ! close mpp file 640 CALL iom_mpp_close(tl_mpp) 641 642 IF( ANY( tl_mpp%t_dim(1:2)%i_len /= & 643 & tl_coord0%t_dim(1:2)%i_len) )THEN 644 !- extract value from fine grid 645 646 IF( ANY( tl_mpp%t_dim(1:2)%i_len <= & 647 & tl_coord1%t_dim(1:2)%i_len) )THEN 648 CALL logger_fatal("CREATE BOUNDARY: dimension in file "//& 649 & TRIM(tl_mpp%c_name)//" smaller than those in fine"//& 650 & " grid coordinates.") 651 ENDIF 652 653 DO jl=1,ip_ncard 654 IF( tl_bdy(jl)%l_use )THEN 655 656 WRITE(*,'(2x,a,a)') 'work on '//TRIM(tl_bdy(jl)%c_card)//' boundary' 657 DO jk=1,tl_bdy(jl)%i_nseg 658 ! compute domain on fine grid 659 660 ! for each variable of this file 661 DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 662 663 cl_name=tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name 664 WRITE(*,'(4x,a,a)') "work on variable "//TRIM(cl_name) 665 666 cl_point=tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_point 667 ! open mpp file on domain 668 SELECT CASE(TRIM(cl_point)) 669 CASE DEFAULT !'T' 670 jpoint=jp_T 671 CASE('U') 672 jpoint=jp_U 673 CASE('V') 674 jpoint=jp_V 675 CASE('F') 676 jpoint=jp_F 677 END SELECT 678 679 tl_dom1=dom_copy(tl_segdom1(jpoint,jk,jl)) 680 tl_lvl1=var_copy(tl_seglvl1(jpoint,jk,jl)) 681 682 ! open mpp files 683 CALL iom_dom_open(tl_mpp, tl_dom1) 684 685 !7-5 read variable over domain 686 tl_segvar1(jvar+jj,jk,jl)=iom_dom_read_var( & 687 & tl_mpp, TRIM(cl_name), tl_dom1) 688 689 ! use mask 690 CALL create_boundary_use_mask( & 691 & tl_segvar1(jvar+jj,jk,jl), tl_lvl1) 692 693 ! del extra point 694 CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), & 695 & tl_dom1 ) 696 697 ! clean extra point information on fine grid domain 698 CALL dom_clean_extra( tl_dom1 ) 699 700 ! add attribute to variable 701 tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name))) 702 CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att) 703 704 tl_att=att_init('src_i_indices',(/tl_dom1%i_imin, tl_dom1%i_imax/)) 705 CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att) 706 707 tl_att=att_init('src_j_indices',(/tl_dom1%i_jmin, tl_dom1%i_jmax/)) 708 CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), tl_att) 709 710 ! clean structure 711 CALL att_clean(tl_att) 712 CALL dom_clean(tl_dom1) 713 714 ! close mpp files 715 CALL iom_dom_close(tl_mpp) 716 717 ! clean 718 CALL var_clean(tl_lvl1) 719 720 ENDDO ! jj 721 ENDDO ! jk 722 723 ENDIF 724 ENDDO ! jl 725 726 ! clean 727 CALL mpp_clean(tl_mpp) 728 729 jvar=jvar+tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 730 731 !- end of extract value from fine grid 414 732 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 733 !- interpolate value from coarse grid 734 735 DO jl=1,ip_ncard 736 IF( tl_bdy(jl)%l_use )THEN 737 738 WRITE(*,'(2x,a,a)') 'work on '//TRIM(tl_bdy(jl)%c_card)//' boundary' 739 DO jk=1,tl_bdy(jl)%i_nseg 740 741 ! for each variable of this file 742 DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 457 743 744 WRITE(*,'(4x,a,a)') "work on variable "//& 745 & TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 746 747 tl_var0=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)) 458 748 ! 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") 749 SELECT CASE(TRIM(tl_var0%c_point)) 750 CASE DEFAULT !'T' 751 jpoint=jp_T 752 CASE('U') 753 jpoint=jp_U 754 CASE('V') 755 jpoint=jp_V 756 CASE('F') 757 jpoint=jp_F 758 END SELECT 759 760 tl_dom1=dom_copy(tl_segdom1(jpoint,jk,jl)) 761 tl_lvl1=var_copy(tl_seglvl1(jpoint,jk,jl)) 762 763 CALL create_boundary_get_coord( tl_coord1, tl_dom1, & 764 & tl_var0%c_point, & 765 & tl_lon1, tl_lat1 ) 766 767 ! get coarse grid indices of this segment 768 il_ind(:,:)=grid_get_coarse_index(tl_coord0, & 769 & tl_lon1, tl_lat1, & 770 & id_rho=il_rho(:) ) 771 772 IF( ANY(il_ind(:,:)==0) )THEN 773 CALL logger_error("CREATE BOUNDARY: error "//& 774 & "computing coarse grid indices") 516 775 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) 776 il_imin0=il_ind(1,1) 777 il_imax0=il_ind(1,2) 778 779 il_jmin0=il_ind(2,1) 780 il_jmax0=il_ind(2,2) 524 781 ENDIF 525 782 526 !7-2 compute coarse grid segment domain 783 il_offset(:,:)= grid_get_fine_offset( & 784 & tl_coord0, & 785 & il_imin0, il_jmin0,& 786 & il_imax0, il_jmax0,& 787 & tl_lon1%d_value(:,:,1,1),& 788 & tl_lat1%d_value(:,:,1,1),& 789 & il_rho(:),& 790 & TRIM(tl_var0%c_point) ) 791 792 ! compute coarse grid segment domain 527 793 tl_dom0=dom_init( tl_coord0, & 528 794 & il_imin0, il_imax0,& 529 795 & il_jmin0, il_jmax0 ) 530 796 531 ! 7-3add extra band (if possible) to compute interpolation797 ! add extra band (if possible) to compute interpolation 532 798 CALL dom_add_extra(tl_dom0) 533 799 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 800 ! read variables on domain 801 ! open mpp files 802 CALL iom_dom_open(tl_mpp, tl_dom0) 803 804 cl_name=tl_var0%c_name 805 ! read variable value on domain 806 tl_segvar1(jvar+jj,jk,jl)= & 807 & iom_dom_read_var(tl_mpp, TRIM(cl_name), tl_dom0) 808 809 ! work on variable 810 CALL create_boundary_interp( & 811 & tl_segvar1(jvar+jj,jk,jl),& 812 & il_rho(:), il_offset(:,:) ) 813 814 ! remove extraband added to domain 815 CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), & 816 & tl_dom0, il_rho(:) ) 817 818 ! use mask 819 CALL create_boundary_use_mask( & 820 & tl_segvar1(jvar+jj,jk,jl), tl_lvl1) 821 822 ! del extra point on fine grid 823 CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), & 824 & tl_dom1 ) 825 ! clean extra point information on coarse grid domain 826 CALL dom_clean_extra( tl_dom0 ) 827 828 ! add attribute to variable 829 tl_att=att_init('src_file',& 830 & TRIM(fct_basename(tl_mpp%c_name))) 831 CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), & 832 & tl_att) 833 834 ! use clean extra avt creer attribut 835 tl_att=att_init('src_i-indices',& 836 & (/tl_dom0%i_imin, tl_dom0%i_imax/)) 837 CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), & 838 & tl_att) 839 840 tl_att=att_init('src_j-indices', & 841 & (/tl_dom0%i_jmin, tl_dom0%i_jmax/)) 842 CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), & 843 & tl_att) 844 845 IF( ANY(il_rho(:)/=1) )THEN 846 tl_att=att_init("refinment_factor", & 847 & (/il_rho(jp_I),il_rho(jp_J)/)) 848 CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), & 849 & tl_att) 587 850 ENDIF 588 851 852 ! clean structure 853 CALL att_clean(tl_att) 854 855 ! clean 589 856 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 857 CALL dom_clean(tl_dom1) 858 859 ! close mpp files 860 CALL iom_dom_close(tl_mpp) 861 862 ! clean structure 863 CALL var_clean(tl_lon1) 864 CALL var_clean(tl_lat1) 865 CALL var_clean(tl_lvl1) 866 867 ENDDO ! jj 868 869 ! clean 870 CALL var_clean(tl_var0) 871 872 ENDDO ! jk 873 874 ENDIF 875 ENDDO ! jl 876 877 jvar=jvar+tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 878 879 !- end of interpolate value from coarse grid 604 880 ENDIF 881 882 ! clean 883 CALL mpp_clean(tl_mpp) 884 885 !- end of use file to fill variable 605 886 ENDIF 606 887 ENDDO 607 888 ENDIF 889 608 890 IF( jvar /= tl_multi%i_nvar )THEN 609 891 CALL logger_error("CREATE BOUNDARY: it seems some variable can not be read") 610 892 ENDIF 611 893 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 894 CALL var_clean(tl_seglvl1(:,:,:)) 895 DEALLOCATE( tl_seglvl1 ) 896 897 ! write file for each segment of each boundary 898 DO jl=1,ip_ncard 899 IF( tl_bdy(jl)%l_use )THEN 619 900 620 901 SELECT CASE(TRIM(tl_bdy(jk)%c_card)) … … 625 906 END SELECT 626 907 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 908 DO jk=1,tl_bdy(jl)%i_nseg 909 !- 910 CALL create_boundary_get_coord( tl_coord1, tl_segdom1(jp_T,jk,jl),& 911 & 'T', tl_lon1, tl_lat1 ) 912 913 ! del extra point on fine grid 914 CALL dom_del_extra( tl_lon1, tl_segdom1(jp_T,jk,jl) ) 915 CALL dom_del_extra( tl_lat1, tl_segdom1(jp_T,jk,jl) ) 916 917 ! clean 918 DO jpoint=1,ip_npoint 919 CALL dom_clean(tl_segdom1(jpoint,jk,jl)) 920 ENDDO 921 922 ! swap array 923 CALL boundary_swap(tl_lon1, tl_bdy(jl)) 924 CALL boundary_swap(tl_lat1, tl_bdy(jl)) 925 DO jvar=1,tl_multi%i_nvar 926 CALL boundary_swap(tl_segvar1(jvar,jk,jl), tl_bdy(jl)) 927 928 ! use additional request 929 ! forced min and max value 930 CALL var_limit_value(tl_segvar1(jvar,jk,jl)) 931 932 ! filter 933 CALL filter_fill_value(tl_segvar1(jvar,jk,jl)) 934 935 ! extrapolate 936 CALL extrap_fill_value( tl_segvar1(jvar,jk,jl), & 937 & id_iext=in_extrap, & 938 & id_jext=in_extrap, & 939 & id_kext=in_extrap ) 940 941 ENDDO 942 943 ! create file 944 ! create file structure 945 ! set file namearray of level variable structure 946 IF( ASSOCIATED(tl_time%d_value) )THEN 947 cl_fmt="('y',i0.4,'m',i0.2,'d',i0.2)" 948 cl_date=date_print( var_to_date(tl_time), cl_fmt ) 949 950 cl_bdyout=boundary_set_filename( TRIM(cn_fileout), & 951 & TRIM(tl_bdy(jl)%c_card), jk, TRIM(cl_date) ) 635 952 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 953 cl_bdyout=boundary_set_filename( TRIM(cn_fileout), & 954 & TRIM(tl_bdy(jl)%c_card), jk ) 955 ENDIF 956 ! 957 tl_fileout=file_init(TRIM(cl_bdyout),id_perio=in_perio1) 958 959 ! add dimension 960 tl_dim(:)=var_max_dim(tl_segvar1(:,jk,jl)) 961 962 CALL dim_unorder(tl_dim(:)) 963 SELECT CASE(TRIM(tl_bdy(jl)%c_card)) 964 CASE DEFAULT ! 'north','south' 965 cl_dimorder='xyzt' 966 CALL dim_reorder(tl_dim(:),TRIM(cl_dimorder)) 967 CASE('east','west') 968 cl_dimorder='yxzt' 969 CALL dim_reorder(tl_dim(:),TRIM(cl_dimorder)) 970 ! reorder coordinates dimension 971 CALL var_reorder(tl_lon1,TRIM(cl_dimorder)) 972 CALL var_reorder(tl_lat1,TRIM(cl_dimorder)) 973 ! reorder other variable dimension 974 DO jvar=1,tl_multi%i_nvar 975 CALL var_reorder(tl_segvar1(jvar,jk,jl),TRIM(cl_dimorder)) 976 ENDDO 977 END SELECT 978 979 DO ji=1,ip_maxdim 980 IF( tl_dim(ji)%l_use ) CALL file_add_dim(tl_fileout, tl_dim(ji)) 981 ENDDO 982 983 ! add variables 984 IF( ALL( tl_dim(1:2)%l_use ) )THEN 985 ! add longitude 986 CALL file_add_var(tl_fileout, tl_lon1) 987 CALL var_clean(tl_lon1) 988 989 ! add latitude 990 CALL file_add_var(tl_fileout, tl_lat1) 991 CALL var_clean(tl_lat1) 992 ENDIF 993 994 IF( tl_dim(3)%l_use )THEN 995 ! add depth 996 CALL file_add_var(tl_fileout, tl_depth) 997 ENDIF 998 999 IF( tl_dim(4)%l_use )THEN 1000 ! add time 1001 CALL file_add_var(tl_fileout, tl_time) 1002 ENDIF 1003 1004 ! add other variable 1005 DO jvar=1,tl_multi%i_nvar 1006 CALL file_add_var(tl_fileout, tl_segvar1(jvar,jk,jl)) 1007 CALL var_clean(tl_segvar1(jvar,jk,jl)) 1008 ENDDO 1009 1010 ! add some attribute 1011 tl_att=att_init("Created_by","SIREN create_boundary") 1012 CALL file_add_att(tl_fileout, tl_att) 1013 1014 cl_date=date_print(date_now()) 1015 tl_att=att_init("Creation_date",cl_date) 1016 CALL file_add_att(tl_fileout, tl_att) 1017 1018 ! add shift on north and east boundary 1019 ! boundary compute on T point but express on U or V point 1020 SELECT CASE(TRIM(tl_bdy(jl)%c_card)) 1021 CASE DEFAULT ! 'south','west' 1022 il_shift=0 1023 CASE('north','east') 1024 il_shift=1 1025 END SELECT 1026 1027 ! add indice of velocity row or column 1028 tl_att=att_init('bdy_ind',tl_bdy(jl)%t_seg(jk)%i_index-il_shift) 1029 CALL file_move_att(tl_fileout, tl_att) 1030 1031 ! add width of the relaxation zone 1032 tl_att=att_init('bdy_width',tl_bdy(jl)%t_seg(jk)%i_width) 1033 CALL file_move_att(tl_fileout, tl_att) 1034 1035 ! add indice of segment start 1036 tl_att=att_init('bdy_deb',tl_bdy(jl)%t_seg(jk)%i_first) 1037 CALL file_move_att(tl_fileout, tl_att) 1038 1039 ! add indice of segment end 1040 tl_att=att_init('bdy_end',tl_bdy(jl)%t_seg(jk)%i_last) 1041 CALL file_move_att(tl_fileout, tl_att) 1042 1043 ! clean 1044 CALL att_clean(tl_att) 1045 1046 ! create file 1047 CALL iom_create(tl_fileout) 1048 1049 ! write file 1050 CALL iom_write_file(tl_fileout) 1051 1052 ! close file 1053 CALL iom_close(tl_fileout) 1054 CALL file_clean(tl_fileout) 1055 1056 ENDDO ! jk 1057 664 1058 ENDIF 665 ENDDO 666 667 DEALLOCATE( tl_seglon1 ) 668 DEALLOCATE( tl_seglat1 ) 1059 ! clean 1060 CALL boundary_clean(tl_bdy(jl)) 1061 ENDDO !jl 1062 1063 ! clean 1064 IF( ASSOCIATED(tl_depth%d_value) ) CALL var_clean(tl_depth) 1065 IF( ASSOCIATED(tl_time%d_value) ) CALL var_clean(tl_time) 669 1066 DEALLOCATE( tl_segdom1 ) 670 1067 DEALLOCATE( tl_segvar1 ) 671 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) 1068 1069 CALL mpp_clean(tl_coord1) 1070 CALL mpp_clean(tl_coord0) 1071 1072 CALL multi_clean(tl_multi) 776 1073 777 1074 ! close log file … … 779 1076 CALL logger_close() 780 1077 781 !> @endcode782 1078 CONTAINS 783 1079 !------------------------------------------------------------------- 784 1080 !> @brief 785 !> This subroutine 1081 !> This subroutine compute boundary domain for each grid point (T,U,V,F) 786 1082 !> 787 !> @details 1083 !> @author J.Paul 1084 !> - November, 2013- Initial Version 1085 !> @date September, 2014 1086 !> - take into account grid point to compute boundary indices 788 1087 !> 789 !> @author J.Paul 790 !> - 2013- Initial Version 791 !> 792 !> @param[in] 793 !> @todo 794 !------------------------------------------------------------------- 795 !> @code 1088 !> @param[in] td_bathy1 file structure 1089 !> @param[in] td_bdy boundary structure 1090 !> @param[in] id_seg segment indice 1091 !> @return array of domain structure 1092 !------------------------------------------------------------------- 796 1093 FUNCTION create_boundary_get_dom( td_bathy1, td_bdy, id_seg ) 797 1094 … … 799 1096 800 1097 ! Argument 801 TYPE(T FILE), INTENT(IN ) :: td_bathy11098 TYPE(TMPP) , INTENT(IN ) :: td_bathy1 802 1099 TYPE(TBDY) , INTENT(IN ) :: td_bdy 803 1100 INTEGER(i4), INTENT(IN ) :: id_seg 804 1101 805 1102 ! function 806 TYPE(TDOM) :: create_boundary_get_dom1103 TYPE(TDOM), DIMENSION(ip_npoint) :: create_boundary_get_dom 807 1104 808 1105 ! local variable … … 812 1109 INTEGER(i4) :: il_jmax1 813 1110 814 TYPE(TFILE) :: tl_bathy1 815 1111 INTEGER(i4) :: il_imin 1112 INTEGER(i4) :: il_imax 1113 INTEGER(i4) :: il_jmin 1114 INTEGER(i4) :: il_jmax 1115 1116 INTEGER(i4), DIMENSION(ip_npoint) :: il_ishift 1117 INTEGER(i4), DIMENSION(ip_npoint) :: il_jshift 1118 816 1119 ! loop indices 817 INTEGER(i4) :: jl 1120 INTEGER(i4) :: ji 1121 INTEGER(i4) :: jk 818 1122 !---------------------------------------------------------------- 819 jl=id_seg 820 821 !1- get boundary definition 1123 ! init 1124 jk=id_seg 1125 1126 il_ishift(:)=0 1127 il_jshift(:)=0 1128 1129 ! get boundary definition 822 1130 SELECT CASE(TRIM(td_bdy%c_card)) 823 1131 CASE('north') 824 1132 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 1133 il_imin1=td_bdy%t_seg(jk)%i_first 1134 il_imax1=td_bdy%t_seg(jk)%i_last 1135 il_jmin1=td_bdy%t_seg(jk)%i_index-(td_bdy%t_seg(jk)%i_width-1) 1136 il_jmax1=td_bdy%t_seg(jk)%i_index 1137 1138 il_jshift(jp_V)=-1 1139 il_jshift(jp_F)=-1 829 1140 830 1141 CASE('south') 831 1142 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)1143 il_imin1=td_bdy%t_seg(jk)%i_first 1144 il_imax1=td_bdy%t_seg(jk)%i_last 1145 il_jmin1=td_bdy%t_seg(jk)%i_index 1146 il_jmax1=td_bdy%t_seg(jk)%i_index+(td_bdy%t_seg(jk)%i_width-1) 836 1147 837 1148 CASE('east') 838 1149 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 1150 il_imin1=td_bdy%t_seg(jk)%i_index-(td_bdy%t_seg(jk)%i_width-1) 1151 il_imax1=td_bdy%t_seg(jk)%i_index 1152 il_jmin1=td_bdy%t_seg(jk)%i_first 1153 il_jmax1=td_bdy%t_seg(jk)%i_last 1154 1155 il_ishift(jp_U)=-1 1156 il_ishift(jp_F)=-1 843 1157 844 1158 CASE('west') 845 1159 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_last1160 il_imin1=td_bdy%t_seg(jk)%i_index 1161 il_imax1=td_bdy%t_seg(jk)%i_index+(td_bdy%t_seg(jk)%i_width-1) 1162 il_jmin1=td_bdy%t_seg(jk)%i_first 1163 il_jmax1=td_bdy%t_seg(jk)%i_last 850 1164 851 1165 END SELECT 852 1166 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) 1167 !-read fine grid domain 1168 DO ji=1,ip_npoint 1169 1170 ! shift domain 1171 il_imin=il_imin1+il_ishift(ji) 1172 il_imax=il_imax1+il_ishift(ji) 1173 1174 il_jmin=il_jmin1+il_jshift(ji) 1175 il_jmax=il_jmax1+il_jshift(ji) 1176 1177 ! compute domain 1178 create_boundary_get_dom(ji)=dom_init( td_bathy1, & 1179 & il_imin, il_imax,& 1180 & il_jmin, il_jmax,& 1181 & TRIM(td_bdy%c_card) ) 1182 1183 ENDDO 864 1184 865 1185 END FUNCTION create_boundary_get_dom 866 !> @endcode867 1186 !------------------------------------------------------------------- 868 1187 !> @brief 869 !> This subroutine 1188 !> This subroutine get coordinates over boudnary domain 1189 !> 1190 !> @author J.Paul 1191 !> - November, 2013- Initial Version 1192 !> @date September, 2014 - take into account grid point 1193 !> 1194 !> @param[in] td_coord1 coordinates file structure 1195 !> @param[in] td_dom1 boundary domain structure 1196 !> @param[in] cd_point grid point 1197 !> @param[out] td_lon1 longitude variable structure 1198 !> @param[out] td_lat1 latitude variable structure 1199 !------------------------------------------------------------------- 1200 SUBROUTINE create_boundary_get_coord( td_coord1, td_dom1, cd_point, & 1201 & td_lon1, td_lat1 ) 1202 1203 IMPLICIT NONE 1204 ! Argument 1205 TYPE(TMPP) , INTENT(IN ) :: td_coord1 1206 TYPE(TDOM) , INTENT(IN ) :: td_dom1 1207 TYPE(TVAR) , INTENT( OUT) :: td_lon1 1208 TYPE(TVAR) , INTENT( OUT) :: td_lat1 1209 CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: cd_point 1210 1211 ! local variable 1212 TYPE(TMPP) :: tl_coord1 1213 1214 CHARACTER(LEN=lc) :: cl_name 1215 ! loop indices 1216 !---------------------------------------------------------------- 1217 !read variables on domain (ugly way to do it, have to work on it) 1218 ! init mpp structure 1219 tl_coord1=mpp_copy(td_coord1) 1220 1221 ! open mpp files 1222 CALL iom_dom_open(tl_coord1, td_dom1) 1223 1224 ! read variable value on domain 1225 WRITE(cl_name,*) 'longitude_'//TRIM(cd_point) 1226 td_lon1=iom_dom_read_var( tl_coord1, TRIM(cl_name), td_dom1) 1227 WRITE(cl_name,*) 'latitude_'//TRIM(cd_point) 1228 td_lat1=iom_dom_read_var( tl_coord1, TRIM(cl_name), td_dom1) 1229 1230 ! close mpp files 1231 CALL iom_dom_close(tl_coord1) 1232 1233 ! clean structure 1234 CALL mpp_clean(tl_coord1) 1235 1236 END SUBROUTINE create_boundary_get_coord 1237 !------------------------------------------------------------------- 1238 !> @brief 1239 !> This subroutine interpolate variable over boundary 870 1240 !> 871 1241 !> @details … … 874 1244 !> - Nov, 2013- Initial Version 875 1245 !> 876 !> @param[in] 877 !> @todo 878 !------------------------------------------------------------------- 879 !> @code 880 SUBROUTINE create_boundary_get_coord( td_bathy1, td_dom1, & 881 & td_lon1, td_lat1 ) 882 883 IMPLICIT NONE 884 885 ! Argument 886 TYPE(TFILE), INTENT(IN ) :: td_bathy1 887 TYPE(TDOM) , INTENT(IN ) :: td_dom1 888 TYPE(TVAR) , INTENT( OUT) :: td_lon1 889 TYPE(TVAR) , INTENT( OUT) :: td_lat1 890 891 ! local variable 892 TYPE(TFILE) :: tl_bathy1 893 894 TYPE(TMPP) :: tl_mppbathy1 895 896 ! loop indices 897 !---------------------------------------------------------------- 898 !read variables on domain (ugly way to do it, have to work on it) 899 900 !1 init mpp structure 901 tl_bathy1=td_bathy1 902 tl_mppbathy1=mpp_init(tl_bathy1) 903 904 CALL file_clean(tl_bathy1) 905 906 !2 get processor to be used 907 CALL mpp_get_use( tl_mppbathy1, td_dom1 ) 908 909 !3 open mpp files 910 CALL iom_mpp_open(tl_mppbathy1) 911 912 !4 read variable value on domain 913 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 files 917 CALL iom_mpp_close(tl_mppbathy1) 918 919 !6 clean structure 920 CALL mpp_clean(tl_mppbathy1) 921 922 END SUBROUTINE create_boundary_get_coord 923 !> @endcode 924 !------------------------------------------------------------------- 925 !> @brief 926 !> This subroutine 927 !> 928 !> @details 929 !> 930 !> @author J.Paul 931 !> - Nov, 2013- Initial Version 932 !> 933 !> @param[in] 934 !> @todo 935 !------------------------------------------------------------------- 936 !> @code 937 SUBROUTINE create_boundary_get_mask( td_level1, td_dom1, & 938 & td_var, td_mask ) 939 940 IMPLICIT NONE 941 942 ! Argument 943 TYPE(TFILE), INTENT(IN ) :: td_level1 944 TYPE(TDOM) , INTENT(IN ) :: td_dom1 945 TYPE(TVAR) , INTENT(IN ) :: td_var 946 TYPE(TVAR) , INTENT( OUT) :: td_mask 947 948 ! local variable 949 TYPE(TFILE) :: tl_level1 950 951 TYPE(TMPP) :: tl_mpplevel1 952 953 ! loop indices 954 !---------------------------------------------------------------- 955 !read variables on domain (ugly way to do it, have to work on it) 956 957 !1 init mpp structure 958 tl_level1=td_level1 959 tl_mpplevel1=mpp_init(tl_level1) 960 961 CALL file_clean(tl_level1) 962 963 !2 get processor to be used 964 CALL mpp_get_use( tl_mpplevel1, td_dom1 ) 965 966 !3 open mpp files 967 CALL iom_mpp_open(tl_mpplevel1) 968 969 !4 read variable value on domain 970 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 SELECT 980 981 !5 close mpp files 982 CALL iom_mpp_close(tl_mpplevel1) 983 984 !6 clean structure 985 CALL mpp_clean(tl_mpplevel1) 986 987 END SUBROUTINE create_boundary_get_mask 988 !> @endcode 989 ! !------------------------------------------------------------------- 990 ! !> @brief 991 ! !> This subroutine 992 ! !> 993 ! !> @details 994 ! !> 995 ! !> @author J.Paul 996 ! !> - Nov, 2013- Initial Version 997 ! !> 998 ! !> @param[in] 999 ! !> @todo 1000 ! !------------------------------------------------------------------- 1001 ! !> @code 1002 ! 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 NONE 1008 ! 1009 ! ! Argument 1010 ! TYPE(TVAR) , INTENT(INOUT) :: td_var 1011 ! TYPE(TBDY) , INTENT(IN ) :: td_bdy 1012 ! TYPE(TFILE), INTENT(IN ) :: td_coord0 1013 ! TYPE(TDOM) , INTENT(IN ) :: td_dom0 1014 ! TYPE(TVAR) , INTENT(IN ) :: td_mask 1015 ! INTEGER(I4), INTENT(IN ) :: id_rhoi 1016 ! INTEGER(I4), INTENT(IN ) :: id_rhoj 1017 ! 1018 ! ! local variable 1019 ! TYPE(TVAR) :: tl_var0 1020 ! 1021 ! TYPE(TDOM) :: tl_dom0 1022 ! 1023 ! TYPE(TFILE) :: tl_file0 1024 ! 1025 ! TYPE(TMPP) :: tl_mppfile0 1026 ! 1027 ! ! loop indices 1028 ! INTEGER(i4) :: jk 1029 ! INTEGER(i4) :: jl 1030 ! !---------------------------------------------------------------- 1031 ! 1032 ! CALL logger_debug("CREATE BOUNDARY INTERP: read coarse grid"// TRIM(td_var%c_file) ) 1033 ! !1- read coarse grid variable on domain 1034 ! tl_file0=file_init( TRIM(td_var%c_file) ) 1035 ! 1036 ! !2- init 1037 ! tl_dom0=td_dom0 1038 ! 1039 ! !3- add extra band (if possible) to compute interpolation 1040 ! 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 structure 1044 ! tl_mppfile0=mpp_init(tl_file0) 1045 ! 1046 ! CALL file_clean(tl_file0) 1047 ! 1048 ! !4-2 get processor to be used 1049 ! CALL mpp_get_use( tl_mppfile0, tl_dom0 ) 1050 ! 1051 ! !4-3 open mpp files 1052 ! CALL iom_mpp_open(tl_mppfile0) 1053 ! 1054 ! ! check file dimension 1055 ! IF( ANY(tl_mppfile0%t_dim(1:2)%i_len /= td_coord0%t_dim(1:2)%i_len) )THEN 1056 ! 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 ! ELSE 1060 ! 1061 ! !4-4 read variable value on domain 1062 ! tl_var0=iom_mpp_read_var( tl_mppfile0, TRIM(td_var%c_name), & 1063 ! & td_dom=tl_dom0 ) 1064 ! 1065 ! !5- work on variable 1066 ! CALL create_boundary_interp(tl_var0, id_rhoi, id_rhoj ) 1067 ! 1068 ! !6- remove extraband added to domain 1069 ! CALL dom_del_extra( tl_var0, tl_dom0, id_rhoi, id_rhoj ) 1070 ! 1071 ! !6-1 remove extraband added to domain 1072 ! CALL dom_clean_extra( tl_dom0 ) 1073 ! 1074 ! !7- keep only useful point (width) 1075 ! ! interpolation could create more point than necessary 1076 ! CALL boundary_clean_interp(tl_var0, td_bdy ) 1077 ! 1078 ! !8- forced min and max value 1079 ! CALL var_limit_value(tl_var0) 1080 ! 1081 ! !9- filter 1082 ! CALL filter_fill_value(tl_var0) 1083 ! 1084 ! td_var=tl_var0 1085 ! 1086 ! CALL var_clean(tl_var0) 1087 ! ENDIF 1088 ! 1089 ! !4-5 close mpp files 1090 ! CALL iom_mpp_close(tl_mppfile0) 1091 ! 1092 ! !4-6 clean structure 1093 ! CALL mpp_clean(tl_mppfile0) 1094 ! 1095 ! !5- apply mask 1096 ! DO jl=1,td_var%t_dim(4)%i_len 1097 ! DO jk=1,td_var%t_dim(3)%i_len 1098 ! WHERE( td_mask%d_value(:,:,1,1) < jk ) 1099 ! td_var%d_value(:,:,jk,jl)=td_var%d_fill 1100 ! END WHERE 1101 ! ENDDO 1102 ! ENDDO 1103 ! 1104 ! END SUBROUTINE create_boundary_get_var 1105 ! !> @endcode 1106 !------------------------------------------------------------------- 1107 !> @brief 1108 !> This subroutine 1109 !> 1110 !> @details 1111 !> 1112 !> @author J.Paul 1113 !> - Nov, 2013- Initial Version 1114 !> 1115 !> @param[in] 1116 !> @todo 1117 !------------------------------------------------------------------- 1118 !> @code 1246 !> @param[inout] td_var variable structure 1247 !> @param[in] id_rho array of refinment factor 1248 !> @param[in] id_offset array of offset between fine and coarse grid 1249 !> @param[in] id_iext i-direction size of extra bands (default=im_minext) 1250 !> @param[in] id_jext j-direction size of extra bands (default=im_minext) 1251 !------------------------------------------------------------------- 1119 1252 SUBROUTINE create_boundary_interp( td_var, & 1120 1253 & id_rho, & … … 1134 1267 1135 1268 ! local variable 1136 TYPE(TVAR) :: tl_var1137 1138 1269 INTEGER(i4) :: il_iext 1139 1270 INTEGER(i4) :: il_jext 1140 1271 ! loop indices 1141 1272 !---------------------------------------------------------------- 1142 1143 ! copy variable1144 tl_var=td_var1145 1273 1146 1274 !WARNING: at least two extrabands are required for cubic interpolation … … 1163 1291 ENDIF 1164 1292 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(:), &1293 ! work on variable 1294 ! add extraband 1295 CALL extrap_add_extrabands(td_var, il_iext, il_jext) 1296 1297 ! extrapolate variable 1298 CALL extrap_fill_value( td_var, id_iext=il_iext, id_jext=il_jext ) 1299 1300 ! interpolate Bathymetry 1301 CALL interp_fill_value( td_var, id_rho(:), & 1174 1302 & id_offset=id_offset(:,:) ) 1175 1303 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) 1304 ! remove extraband 1305 CALL extrap_del_extrabands(td_var, il_iext*id_rho(jp_I), il_jext*id_rho(jp_J)) 1184 1306 1185 1307 END SUBROUTINE create_boundary_interp 1186 !> @endcode1187 1308 !------------------------------------------------------------------- 1188 1309 !> @brief … … 1192 1313 !> A variable is create with the same name that the input variable, 1193 1314 !> and with dimension of the coordinate file. 1194 !> Then the variable tableof value is split into equal subdomain.1315 !> Then the variable array of value is split into equal subdomain. 1195 1316 !> Each subdomain is fill with the linked value of the matrix. 1196 1317 !> 1197 1318 !> @author J.Paul 1198 !> - Nov , 2013- Initial Version1319 !> - November, 2013- Initial Version 1199 1320 !> 1200 !> @param[in] td_var :variable structure1201 !> @param[in] td_dom :domain structure1202 !> @param[in] td_coord : coordinate1321 !> @param[in] td_var variable structure 1322 !> @param[in] td_dom domain structure 1323 !> @param[in] id_nlevel number of levels 1203 1324 !> @return variable structure 1204 1325 !------------------------------------------------------------------- 1205 !> @code 1206 FUNCTION create_bdy_matrix(td_var, td_dom, td_coord) 1326 FUNCTION create_boundary_matrix(td_var, td_dom, id_nlevel) 1207 1327 IMPLICIT NONE 1208 1328 ! Argument 1209 TYPE(TVAR) , INTENT(IN) :: td_var1210 TYPE(TDOM) , INTENT(IN) :: td_dom1211 TYPE(TFILE), INTENT(IN) :: td_coord1329 TYPE(TVAR) , INTENT(IN) :: td_var 1330 TYPE(TDOM) , INTENT(IN) :: td_dom 1331 INTEGER(i4), INTENT(IN) :: id_nlevel 1212 1332 1213 1333 ! function 1214 TYPE(TVAR) :: create_b dy_matrix1334 TYPE(TVAR) :: create_boundary_matrix 1215 1335 1216 1336 ! local variable 1217 INTEGER(i4) :: il_ighost1218 INTEGER(i4) :: il_jghost1219 INTEGER(i4) , DIMENSION(2) :: il_xghost1220 1337 INTEGER(i4) , DIMENSION(3) :: il_dim 1221 1338 INTEGER(i4) , DIMENSION(3) :: il_size … … 1228 1345 REAL(dp) , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value 1229 1346 1230 TYPE(TVAR) :: tl_lon1231 TYPE(TVAR) :: tl_lat1232 TYPE(TVAR) :: tl_var1233 1347 TYPE(TDIM) , DIMENSION(ip_maxdim) :: tl_dim 1234 1348 … … 1239 1353 !---------------------------------------------------------------- 1240 1354 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 1355 ! write value on grid 1356 ! get matrix dimension 1253 1357 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 1358 1359 tl_dim(jp_I:jp_J)=dim_copy(td_dom%t_dim(jp_I:jp_J)) 1360 tl_dim(jp_K)%i_len=id_nlevel 1361 1362 ! split output domain in N subdomain depending of matrix dimension 1262 1363 il_size(:) = tl_dim(1:3)%i_len / il_dim(:) 1263 1364 il_rest(:) = MOD(tl_dim(1:3)%i_len, il_dim(:)) … … 1271 1372 il_ishape(il_dim(1)+1)=il_ishape(il_dim(1)+1)+il_rest(1) 1272 1373 1273 1274 1374 ALLOCATE( il_jshape(il_dim(2)+1) ) 1275 1375 il_jshape(:)=0 … … 1288 1388 il_kshape(il_dim(3)+1)=il_kshape(il_dim(3)+1)+il_rest(3) 1289 1389 1290 ! 3-3 write ouput tableof value1390 ! write ouput array of value 1291 1391 ALLOCATE(dl_value( tl_dim(1)%i_len, & 1292 1392 & tl_dim(2)%i_len, & … … 1309 1409 ENDDO 1310 1410 1311 ! 3-4initialise variable with value1312 tl_var=var_init(TRIM(td_var%c_name),dl_value(:,:,:,:))1411 ! initialise variable with value 1412 create_boundary_matrix=var_init(TRIM(td_var%c_name),dl_value(:,:,:,:)) 1313 1413 1314 1414 DEALLOCATE(dl_value) 1315 1415 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 1416 END FUNCTION create_boundary_matrix 1324 1417 !------------------------------------------------------------------- 1325 1418 !> @brief 1326 !> This subroutine 1419 !> This subroutine use mask to filled land point with _FillValue 1327 1420 !> 1328 1421 !> @details 1329 1422 !> 1330 1423 !> @author J.Paul 1331 !> - Nov , 2013- Initial Version1424 !> - November, 2013- Initial Version 1332 1425 !> 1333 !> @param[in] 1334 !> @todo 1335 !------------------------------------------------------------------- 1336 !> @code 1337 SUBROUTINE create_bdy_use_mask( td_var, td_mask ) 1426 !> @param[inout] td_var variable structure 1427 !> @param[in] td_mask mask variable structure 1428 !------------------------------------------------------------------- 1429 SUBROUTINE create_boundary_use_mask( td_var, td_mask ) 1338 1430 1339 1431 IMPLICIT NONE 1340 1432 1341 1433 ! Argument 1342 TYPE(TVAR) 1343 TYPE(TVAR), DIMENSION(:),INTENT(IN ) :: td_mask1434 TYPE(TVAR), INTENT(INOUT) :: td_var 1435 TYPE(TVAR), INTENT(IN ) :: td_mask 1344 1436 1345 1437 ! local variable … … 1351 1443 !---------------------------------------------------------------- 1352 1444 1445 IF( ANY(td_var%t_dim(1:2)%i_len /= & 1446 & td_mask%t_dim(1:2)%i_len) )THEN 1447 CALL logger_debug(" mask dimension ( "//& 1448 & TRIM(fct_str(td_mask%t_dim(1)%i_len))//","//& 1449 & TRIM(fct_str(td_mask%t_dim(2)%i_len))//")" ) 1450 CALL logger_debug(" variable dimension ( "//& 1451 & TRIM(fct_str(td_var%t_dim(1)%i_len))//","//& 1452 & TRIM(fct_str(td_var%t_dim(2)%i_len))//")" ) 1453 CALL logger_fatal("CREATE BOUNDARY USE MASK: mask and "//& 1454 & "variable dimension differ." ) 1455 ENDIF 1456 1353 1457 ALLOCATE( il_mask(td_var%t_dim(1)%i_len, & 1354 1458 & td_var%t_dim(2)%i_len) ) 1355 1459 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 1460 il_mask(:,:)=INT(td_mask%d_value(:,:,1,1)) 1366 1461 1367 1462 DO jl=1,td_var%t_dim(4)%i_len … … 1372 1467 1373 1468 DEALLOCATE( il_mask ) 1374 END SUBROUTINE create_bdy_use_mask 1375 !> @endcode1469 1470 END SUBROUTINE create_boundary_use_mask 1376 1471 !------------------------------------------------------------------- 1377 1472 !> @brief 1473 !> This function extract level over domain on each grid point, and return 1474 !> array of variable structure 1475 !> 1476 !> @author J.Paul 1477 !> - November, 2013- Initial Version 1478 !> 1479 !> @param[in] td_level array of level variable structure 1480 !> @param[in] td_dom array of domain structure 1481 !> @return array of variable structure 1482 !------------------------------------------------------------------- 1483 FUNCTION create_boundary_get_level(td_level, td_dom) 1484 IMPLICIT NONE 1485 ! Argument 1486 TYPE(TVAR), DIMENSION(:), INTENT(IN) :: td_level 1487 TYPE(TDOM), DIMENSION(:), INTENT(IN) :: td_dom 1488 1489 ! function 1490 TYPE(TVAR), DIMENSION(ip_npoint) :: create_boundary_get_level 1491 1492 ! local variable 1493 TYPE(TVAR), DIMENSION(ip_npoint) :: tl_var 1494 1495 ! loop indices 1496 INTEGER(i4) :: ji 1497 !---------------------------------------------------------------- 1498 1499 IF( SIZE(td_level(:)) /= ip_npoint .OR. & 1500 & SIZE(td_dom(:)) /= ip_npoint )THEN 1501 CALL logger_error("CREATE BDY GET LEVEL: invalid dimension. "//& 1502 & "check input array of level and domain.") 1503 ELSE 1504 1505 DO ji=1,ip_npoint 1506 1507 tl_var(ji)=var_copy(td_level(ji)) 1508 1509 IF( ASSOCIATED(tl_var(ji)%d_value) ) DEALLOCATE(tl_var(ji)%d_value) 1510 1511 tl_var(ji)%t_dim(1)%i_len=td_dom(ji)%t_dim(1)%i_len 1512 tl_var(ji)%t_dim(2)%i_len=td_dom(ji)%t_dim(2)%i_len 1513 ALLOCATE(tl_var(ji)%d_value(tl_var(ji)%t_dim(1)%i_len, & 1514 & tl_var(ji)%t_dim(2)%i_len, & 1515 & tl_var(ji)%t_dim(3)%i_len, & 1516 & tl_var(ji)%t_dim(4)%i_len) ) 1517 1518 tl_var(ji)%d_value(:,:,:,:) = & 1519 & td_level(ji)%d_value( td_dom(ji)%i_imin:td_dom(ji)%i_imax, & 1520 & td_dom(ji)%i_jmin:td_dom(ji)%i_jmax, :, : ) 1521 1522 ENDDO 1523 ! save result 1524 create_boundary_get_level(:)=var_copy(tl_var(:)) 1525 1526 ! clean 1527 CALL var_clean(tl_var(:)) 1528 1529 ENDIF 1530 END FUNCTION create_boundary_get_level 1531 !------------------------------------------------------------------- 1532 !> @brief 1533 !> This subroutine get depth variable value in an open mpp structure 1534 !> and check if agree with already input depth variable. 1378 1535 !> 1379 1536 !> @details 1380 1537 !> 1381 1538 !> @author J.Paul 1382 !> - 2013- Initial Version1539 !> - November, 2014- Initial Version 1383 1540 !> 1384 !------------------------------------------------------------------- 1385 !> @code 1386 FUNCTION create_bdy_get_level(td_level, td_dom) 1541 !> @param[in] td_mpp mpp structure 1542 !> @param[inout] td_depth depth variable structure 1543 !------------------------------------------------------------------- 1544 SUBROUTINE create_boundary_check_depth( td_mpp, td_depth ) 1545 1387 1546 IMPLICIT NONE 1547 1388 1548 ! 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 1549 TYPE(TMPP) , INTENT(IN ) :: td_mpp 1550 TYPE(TVAR) , INTENT(INOUT) :: td_depth 1394 1551 1395 1552 ! local variable 1396 TYPE(TVAR), DIMENSION(ig_npoint) :: tl_var1397 1553 INTEGER(i4) :: il_varid 1554 TYPE(TVAR) :: tl_depth 1398 1555 ! loop indices 1399 INTEGER(i4) :: ji1400 1556 !---------------------------------------------------------------- 1401 1557 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(:) 1558 ! get or check depth value 1559 IF( td_mpp%t_proc(1)%i_depthid /= 0 )THEN 1560 1561 il_varid=td_mpp%t_proc(1)%i_depthid 1562 IF( ASSOCIATED(td_depth%d_value) )THEN 1563 1564 tl_depth=iom_mpp_read_var(td_mpp, il_varid) 1565 IF( ANY( td_depth%d_value(:,:,:,:) /= & 1566 & tl_depth%d_value(:,:,:,:) ) )THEN 1567 1568 CALL logger_fatal("CREATE BOUNDARY: depth value from "//& 1569 & TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//& 1570 & " to those from former file(s).") 1571 1572 ENDIF 1573 CALL var_clean(tl_depth) 1574 1575 ELSE 1576 td_depth=iom_mpp_read_var(td_mpp,il_varid) 1577 ENDIF 1429 1578 1430 1579 ENDIF 1431 END FUNCTION create_bdy_get_level 1432 !> @endcode 1580 1581 END SUBROUTINE create_boundary_check_depth 1582 !------------------------------------------------------------------- 1583 !> @brief 1584 !> This subroutine get date and time in an open mpp structure 1585 !> and check if agree with date and time already read. 1586 !> 1587 !> @details 1588 !> 1589 !> @author J.Paul 1590 !> - November, 2014- Initial Version 1591 !> 1592 !> @param[in] td_mpp mpp structure 1593 !> @param[inout] td_time time variable structure 1594 !------------------------------------------------------------------- 1595 SUBROUTINE create_boundary_check_time( td_mpp, td_time ) 1596 1597 IMPLICIT NONE 1598 1599 ! Argument 1600 TYPE(TMPP), INTENT(IN ) :: td_mpp 1601 TYPE(TVAR), INTENT(INOUT) :: td_time 1602 1603 ! local variable 1604 INTEGER(i4) :: il_varid 1605 TYPE(TVAR) :: tl_time 1606 1607 TYPE(TDATE) :: tl_date1 1608 TYPE(TDATE) :: tl_date2 1609 ! loop indices 1610 !---------------------------------------------------------------- 1611 1612 ! get or check depth value 1613 IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN 1614 1615 il_varid=td_mpp%t_proc(1)%i_timeid 1616 IF( ASSOCIATED(td_time%d_value) )THEN 1617 1618 tl_time=iom_mpp_read_var(td_mpp, il_varid) 1619 1620 tl_date1=var_to_date(td_time) 1621 tl_date2=var_to_date(tl_time) 1622 IF( tl_date1 - tl_date2 /= 0 )THEN 1623 1624 CALL logger_fatal("CREATE BOUNDARY: date from "//& 1625 & TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//& 1626 & " to those from former file(s).") 1627 1628 ENDIF 1629 CALL var_clean(tl_time) 1630 1631 ELSE 1632 td_time=iom_mpp_read_var(td_mpp,il_varid) 1633 ENDIF 1634 1635 ENDIF 1636 1637 END SUBROUTINE create_boundary_check_time 1433 1638 END PROGRAM create_boundary
Note: See TracChangeset
for help on using the changeset viewer.