Changeset 6393 for trunk/NEMOGCM/TOOLS/SIREN/src/create_boundary.F90
- Timestamp:
- 2016-03-17T10:16:03+01:00 (8 years ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/TOOLS/SIREN/src/create_boundary.F90
r6391 r6393 9 9 !> @file 10 10 !> @brief 11 !> This program create boundary files.11 !> This program creates boundary files. 12 12 !> 13 13 !> @details 14 14 !> @section sec1 method 15 !> Variables are read from coarse grid standard output 16 !> and interpolated on fine grid or manually written.<br/> 15 !> Variables are read from coarse grid standard output, 16 !> extracted or interpolated on fine grid. 17 !> Variables could also be manually written.<br/> 17 18 !> @note 18 19 !> method could be different for each variable. … … 30 31 !> you could find a template of the namelist in templates directory. 31 32 !> 32 !> create_boundary.nam co mprise9 namelists:<br/>33 !> create_boundary.nam contains 9 namelists:<br/> 33 34 !> - logger namelist (namlog) 34 35 !> - config namelist (namcfg) … … 41 42 !> - output namelist (namout) 42 43 !> 43 !> @note44 !> All namelists have to be in file create_boundary.nam,45 !> however variables of those namelists are all optional.46 !>47 44 !> * _logger namelist (namlog)_:<br/> 48 45 !> - cn_logfile : log filename … … 54 51 !> - cn_varcfg : variable configuration file 55 52 !> (see ./SIREN/cfg/variable.cfg) 53 !> - cn_dumcfg : useless (dummy) configuration file, for useless 54 !> dimension or variable (see ./SIREN/cfg/dummy.cfg). 56 55 !> 57 56 !> * _coarse grid namelist (namcrs)_:<br/> … … 80 79 !> 81 80 !> * _partial step namelist (namzps)_:<br/> 82 !> - dn_e3zps_mi 81 !> - dn_e3zps_min : 83 82 !> - dn_e3zps_rat : 84 83 !> 85 84 !> * _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/> 85 !> - cn_varfile : list of variable, and associated file<br/> 109 86 !> *cn_varfile* is the path and filename of the file where find 110 87 !> variable.<br/> … … 121 98 !> Example:<br/> 122 99 !> 3,2,3/1,4,5 => @f$ \left( \begin{array}{ccc} 123 !> 3 & 2 & 3 \\ 100 !> 3 & 2 & 3 \\\\ 124 101 !> 1 & 4 & 5 \end{array} \right) @f$ 125 102 !> @warning … … 129 106 !> - 'votemper:gridT.nc', 'vozocrtx:gridU.nc' 130 107 !> - 'votemper:10\25', 'vozocrtx:gridU.nc' 108 !> 109 !> - cn_varinfo : list of variable and extra information about request(s) 110 !> to be used (separated by ',').<br/> 111 !> each elements of *cn_varinfo* is a string character.<br/> 112 !> it is composed of the variable name follow by ':', 113 !> then request(s) to be used on this variable.<br/> 114 !> request could be: 115 !> - int = interpolation method 116 !> - ext = extrapolation method 117 !> - flt = filter method 118 !> - min = minimum value 119 !> - max = maximum value 120 !> - unt = new units 121 !> - unf = unit scale factor (linked to new units) 122 !> 123 !> requests must be separated by ';'.<br/> 124 !> order of requests does not matter. 125 !> 126 !> informations about available method could be find in @ref interp, 127 !> @ref extrap and @ref filter.<br/> 128 !> 129 !> Example: 'votemper:int=linear;flt=hann;ext=dist_weight', 130 !> 'vosaline:int=cubic' 131 !> @note 132 !> If you do not specify a method which is required, 133 !> default one is apply. 131 134 !> 132 135 !> * _nesting namelist (namnst)_:<br/> … … 146 149 !> - indice of velocity (orthogonal to boundary .ie. 147 150 !> for north boundary, J-indice). 148 !> - indice of seg emnt start (I-indice for north boundary)151 !> - indice of segment start (I-indice for north boundary) 149 152 !> - indice of segment end (I-indice for north boundary)<br/> 150 153 !> indices must be separated by ':' .<br/> 151 154 !> - optionally, boundary size could be added between '(' and ')' 152 !> in the first segment defined.155 !> in the definition of the first segment. 153 156 !> @note 154 157 !> boundary width is the same for all segments of one boundary. … … 162 165 !> - cn_east : east boundary indices on fine grid 163 166 !> - cn_west : west boundary indices on fine grid 164 !> - ln_oneseg : use only one segment for each boundary or not167 !> - ln_oneseg : force to use only one segment for each boundary or not 165 168 !> 166 169 !> * _output namelist (namout)_:<br/> 167 170 !> - cn_fileout : fine grid boundary basename 168 !> (cardinal and segment number will be automatically added)171 !> (cardinal point and segment number will be automatically added) 169 172 !> - dn_dayofs : date offset in day (change only ouput file name) 170 173 !> - ln_extrap : extrapolate land point or not 171 174 !> 172 175 !> Examples: 173 !> - cn_fileout= boundary.nc<br/>176 !> - cn_fileout='boundary.nc'<br/> 174 177 !> if time_counter (16/07/2015 00h) is read on input file (see varfile), 175 178 !> west boundary will be named boundary_west_y2015m07d16 … … 189 192 !> - allow to change unit. 190 193 !> @date July, 2015 191 !> - add namelist parameter to shift date of output file name. 194 !> - add namelist parameter to shift date of output file name. 195 !> @date September, 2015 196 !> - manage useless (dummy) variable, attributes, and dimension 197 !> - allow to run on multi processors with key_mpp_mpi 198 !> @date January, 2016 199 !> - same process use for variable extracted or interpolated from input file. 192 200 !> 193 201 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 199 207 USE phycst ! physical constant 200 208 USE kind ! F90 kind parameter 201 USE logger ! log file manager202 209 USE fct ! basic useful function 203 210 USE date ! date manager … … 221 228 222 229 ! local variable 230 INTEGER(i4) :: il_narg 231 232 #if defined key_mpp_mpi 233 ! mpp variable 234 CHARACTER(LEN=lc), DIMENSION(:) , ALLOCATABLE :: cl_namelist 235 INTEGER(i4) :: ierror 236 INTEGER(i4) :: iproc 237 INTEGER(i4) :: nproc 238 INTEGER(i4) , DIMENSION(:) , ALLOCATABLE :: il_nprog 239 240 ! loop indices 241 INTEGER(i4) :: jm 242 #else 223 243 CHARACTER(LEN=lc) :: cl_namelist 244 #endif 245 !------------------------------------------------------------------- 246 #if defined key_mpp_mpi 247 INCLUDE 'mpif.h' 248 #endif 249 !------------------------------------------------------------------- 250 251 il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec 252 #if ! defined key_mpp_mpi 253 254 IF( il_narg/=1 )THEN 255 PRINT *,"CREATE BOUNDARY: ERROR. need one namelist" 256 STOP 257 ELSE 258 CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec 259 ENDIF 260 261 CALL create__boundary(cl_namelist) 262 263 #else 264 265 ! Initialize MPI 266 CALL mpi_init(ierror) 267 CALL mpi_comm_rank(mpi_comm_world,iproc,ierror) 268 CALL mpi_comm_size(mpi_comm_world,nproc,ierror) 269 270 IF( il_narg==0 )THEN 271 PRINT *,"CREATE BOUNDARY: ERROR. need at least one namelist" 272 STOP 273 ELSE 274 ALLOCATE(cl_namelist(il_narg)) 275 DO jm=1,il_narg 276 CALL GET_COMMAND_ARGUMENT(jm,cl_namelist(jm)) 277 ENDDO 278 ENDIF 279 280 ALLOCATE(il_nprog(il_narg)) 281 DO jm=1, il_narg 282 il_nprog(jm)= MOD(jm,nproc) 283 ENDDO 284 285 DO jm=1, il_narg 286 IF ( il_nprog(jm) .eq. iproc ) THEN 287 CALL create__boundary(cl_namelist(jm)) 288 ENDIF 289 ENDDO 290 291 CALL mpi_finalize(ierror) 292 293 DEALLOCATE(cl_namelist) 294 DEALLOCATE(il_nprog) 295 #endif 296 297 CONTAINS 298 SUBROUTINE create__boundary(cd_namelist) 299 !------------------------------------------------------------------- 300 !> @brief 301 !> This subroutine create boundary files. 302 !> 303 !> @details 304 !> 305 !> @author J.Paul 306 !> @date January, 2016 - Initial Version 307 !> 308 !> @param[in] cd_namelist namelist file 309 !------------------------------------------------------------------- 310 311 USE logger ! log file manager 312 313 IMPLICIT NONE 314 ! Argument 315 CHARACTER(LEN=lc), INTENT(IN) :: cd_namelist 316 317 ! local variable 224 318 CHARACTER(LEN=lc) :: cl_date 225 319 CHARACTER(LEN=lc) :: cl_name … … 227 321 CHARACTER(LEN=lc) :: cl_data 228 322 CHARACTER(LEN=lc) :: cl_dimorder 229 CHARACTER(LEN=lc) :: cl_point230 323 CHARACTER(LEN=lc) :: cl_fmt 231 324 232 INTEGER(i4) :: il_narg233 325 INTEGER(i4) :: il_status 234 326 INTEGER(i4) :: il_fileid … … 286 378 ! namelist variable 287 379 ! namlog 288 CHARACTER(LEN=lc) :: cn_logfile = 'create_boundary.log'289 CHARACTER(LEN=lc) :: cn_verbosity = 'warning'290 INTEGER(i4) :: in_maxerror = 5380 CHARACTER(LEN=lc) :: cn_logfile = 'create_boundary.log' 381 CHARACTER(LEN=lc) :: cn_verbosity = 'warning' 382 INTEGER(i4) :: in_maxerror = 5 291 383 292 384 ! namcfg 293 CHARACTER(LEN=lc) :: cn_varcfg = 'variable.cfg' 385 CHARACTER(LEN=lc) :: cn_varcfg = 'variable.cfg' 386 CHARACTER(LEN=lc) :: cn_dumcfg = 'dummy.cfg' 294 387 295 388 ! namcrs 296 CHARACTER(LEN=lc) :: cn_coord0 = ''297 INTEGER(i4) :: in_perio0 = -1389 CHARACTER(LEN=lc) :: cn_coord0 = '' 390 INTEGER(i4) :: in_perio0 = -1 298 391 299 392 ! namfin 300 CHARACTER(LEN=lc) :: cn_coord1 = ''301 CHARACTER(LEN=lc) :: cn_bathy1 = ''302 INTEGER(i4) :: in_perio1 = -1393 CHARACTER(LEN=lc) :: cn_coord1 = '' 394 CHARACTER(LEN=lc) :: cn_bathy1 = '' 395 INTEGER(i4) :: in_perio1 = -1 303 396 304 397 !namzgr 305 REAL(dp) :: dn_pp_to_be_computed = 0._dp306 REAL(dp) :: dn_ppsur= -3958.951371276829_dp307 REAL(dp) :: dn_ppa0 = 103.9530096000000_dp308 REAL(dp) :: dn_ppa1 = 2.4159512690000_dp309 REAL(dp) :: dn_ppa2 = 100.7609285000000_dp310 REAL(dp) :: dn_ppkth = 15.3510137000000_dp311 REAL(dp) :: dn_ppkth2 = 48.0298937200000_dp312 REAL(dp) :: dn_ppacr = 7.0000000000000_dp313 REAL(dp) :: dn_ppacr2= 13.000000000000_dp314 REAL(dp) :: dn_ppdzmin= 6._dp315 REAL(dp) :: dn_pphmax= 5750._dp316 INTEGER(i4) :: in_nlevel= 75398 REAL(dp) :: dn_pp_to_be_computed = 0._dp 399 REAL(dp) :: dn_ppsur = -3958.951371276829_dp 400 REAL(dp) :: dn_ppa0 = 103.953009600000_dp 401 REAL(dp) :: dn_ppa1 = 2.415951269000_dp 402 REAL(dp) :: dn_ppa2 = 100.760928500000_dp 403 REAL(dp) :: dn_ppkth = 15.351013700000_dp 404 REAL(dp) :: dn_ppkth2 = 48.029893720000_dp 405 REAL(dp) :: dn_ppacr = 7.000000000000_dp 406 REAL(dp) :: dn_ppacr2 = 13.000000000000_dp 407 REAL(dp) :: dn_ppdzmin = 6._dp 408 REAL(dp) :: dn_pphmax = 5750._dp 409 INTEGER(i4) :: in_nlevel = 75 317 410 318 411 !namzps 319 REAL(dp) :: dn_e3zps_min = 25._dp320 REAL(dp) :: dn_e3zps_rat = 0.2_dp412 REAL(dp) :: dn_e3zps_min = 25._dp 413 REAL(dp) :: dn_e3zps_rat = 0.2_dp 321 414 322 415 ! namvar 416 CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = '' 323 417 CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = '' 324 CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = ''325 418 326 419 ! namnst 327 INTEGER(i4) :: in_rhoi = 0328 INTEGER(i4) :: in_rhoj = 0420 INTEGER(i4) :: in_rhoi = 0 421 INTEGER(i4) :: in_rhoj = 0 329 422 330 423 ! nambdy 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.424 LOGICAL :: ln_north = .TRUE. 425 LOGICAL :: ln_south = .TRUE. 426 LOGICAL :: ln_east = .TRUE. 427 LOGICAL :: ln_west = .TRUE. 428 LOGICAL :: ln_oneseg = .TRUE. 429 CHARACTER(LEN=lc) :: cn_north = '' 430 CHARACTER(LEN=lc) :: cn_south = '' 431 CHARACTER(LEN=lc) :: cn_east = '' 432 CHARACTER(LEN=lc) :: cn_west = '' 340 433 341 434 ! namout 342 CHARACTER(LEN=lc) :: cn_fileout = 'boundary.nc'343 REAL(dp) :: dn_dayofs = 0._dp344 LOGICAL :: ln_extrap = .FALSE.435 CHARACTER(LEN=lc) :: cn_fileout = 'boundary.nc' 436 REAL(dp) :: dn_dayofs = 0._dp 437 LOGICAL :: ln_extrap = .FALSE. 345 438 !------------------------------------------------------------------- 346 439 … … 351 444 352 445 NAMELIST /namcfg/ & !< config namelist 353 & cn_varcfg !< variable configuration file 446 & cn_varcfg, & !< variable configuration file 447 & cn_dumcfg !< dummy configuration file 354 448 355 449 NAMELIST /namcrs/ & !< coarse grid namelist … … 381 475 382 476 NAMELIST /namvar/ & !< variable namelist 383 & cn_var info, & !< list of variable and method to apply on. (ex: 'votemper:linear','vosaline:cubic' )384 & cn_var file !< list of variable and file where find it. (ex: 'votemper:GLORYS_gridT.nc' )477 & cn_varfile, & !< list of variable and file where find it. (ex: 'votemper:GLORYS_gridT.nc' ) 478 & cn_varinfo !< list of variable and method to apply on. (ex: 'votemper:linear','vosaline:cubic' ) 385 479 386 480 NAMELIST /namnst/ & !< nesting namelist … … 405 499 !------------------------------------------------------------------- 406 500 407 ! namelist408 ! get namelist409 il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec410 IF( il_narg/=1 )THEN411 PRINT *,"CREATE BOUNDARY: ERROR. need a namelist"412 STOP413 ELSE414 CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec415 ENDIF416 417 501 ! read namelist 418 INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist) 502 INQUIRE(FILE=TRIM(cd_namelist), EXIST=ll_exist) 503 419 504 IF( ll_exist )THEN 420 505 421 506 il_fileid=fct_getunit() 422 507 423 OPEN( il_fileid, FILE=TRIM(c l_namelist), &508 OPEN( il_fileid, FILE=TRIM(cd_namelist), & 424 509 & FORM='FORMATTED', & 425 510 & ACCESS='SEQUENTIAL', & … … 429 514 CALL fct_err(il_status) 430 515 IF( il_status /= 0 )THEN 431 PRINT *,"CREATE BOUNDARY: ERROR opening "//TRIM(c l_namelist)516 PRINT *,"CREATE BOUNDARY: ERROR opening "//TRIM(cd_namelist) 432 517 STOP 433 518 ENDIF … … 441 526 ! get variable extra information 442 527 CALL var_def_extra(TRIM(cn_varcfg)) 528 529 ! get dummy variable 530 CALL var_get_dummy(TRIM(cn_dumcfg)) 531 ! get dummy dimension 532 CALL dim_get_dummy(TRIM(cn_dumcfg)) 533 ! get dummy attribute 534 CALL att_get_dummy(TRIM(cn_dumcfg)) 443 535 444 536 READ( il_fileid, NML = namcrs ) … … 458 550 CALL fct_err(il_status) 459 551 IF( il_status /= 0 )THEN 460 CALL logger_error("CREATE BOUNDARY: ERROR closing "//TRIM(c l_namelist))552 CALL logger_error("CREATE BOUNDARY: ERROR closing "//TRIM(cd_namelist)) 461 553 ENDIF 462 554 463 555 ELSE 464 556 465 PRINT *,"CREATE BOUNDARY: ERROR. can not find "//TRIM(c l_namelist)557 PRINT *,"CREATE BOUNDARY: ERROR. can not find "//TRIM(cd_namelist) 466 558 STOP 467 559 … … 525 617 IF( in_rhoi < 1 .OR. in_rhoj < 1 )THEN 526 618 CALL logger_error("CREATE BOUNDARY: invalid refinement factor."//& 527 & " check namelist "//TRIM(c l_namelist))619 & " check namelist "//TRIM(cd_namelist)) 528 620 ELSE 529 621 il_rho(jp_I)=in_rhoi … … 562 654 & ln_oneseg ) 563 655 656 564 657 CALL var_clean(tl_var1) 565 658 566 659 ! compute level 567 660 ALLOCATE(tl_level(ip_npoint)) 568 tl_level(:)=vgrid_get_level(tl_bathy1, c l_namelist )661 tl_level(:)=vgrid_get_level(tl_bathy1, cd_namelist ) 569 662 570 663 ! get coordinate for each segment of each boundary … … 676 769 !- end of use input matrix to fill variable 677 770 ELSE 678 !- use file to fill variable771 !- use mpp file to fill variable 679 772 680 773 WRITE(*,'(a)') "work on file "//TRIM(tl_multi%t_mpp(ji)%c_name) … … 683 776 CALL grid_get_info(tl_mpp) 684 777 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 794 ELSE 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 778 DO jl=1,ip_ncard 779 IF( tl_bdy(jl)%l_use )THEN 780 781 WRITE(*,'(2x,a,a)') 'work on '//TRIM(tl_bdy(jl)%c_card)//& 782 & ' boundary' 783 DO jk=1,tl_bdy(jl)%i_nseg 784 785 ! for each variable of this file 786 DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 806 787 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)) 811 ! open mpp file on domain 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") 837 ELSE 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) 843 ENDIF 844 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 855 tl_dom0=dom_init( tl_coord0, & 856 & il_imin0, il_imax0,& 857 & il_jmin0, il_jmax0 ) 858 859 ! add extra band (if possible) to compute 860 ! interpolation 861 CALL dom_add_extra(tl_dom0) 862 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 788 WRITE(*,'(4x,a,a)') "work on variable "//& 789 & TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 790 791 tl_var0=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)) 792 793 ! open mpp file 794 CALL iom_mpp_open(tl_mpp) 795 796 ! get or check depth value 797 CALL create_boundary_check_depth( tl_var0, tl_mpp, & 798 & in_nlevel, tl_depth ) 799 800 ! get or check time value 801 CALL create_boundary_check_time( tl_var0, tl_mpp, & 802 & tl_time ) 803 804 ! close mpp file 805 CALL iom_mpp_close(tl_mpp) 806 807 ! open mpp file on domain 808 SELECT CASE(TRIM(tl_var0%c_point)) 809 CASE DEFAULT !'T' 810 jpoint=jp_T 811 CASE('U') 812 jpoint=jp_U 813 CASE('V') 814 jpoint=jp_V 815 CASE('F') 816 jpoint=jp_F 817 END SELECT 818 819 tl_dom1=dom_copy(tl_segdom1(jpoint,jk,jl)) 820 821 CALL create_boundary_get_coord( tl_coord1, tl_dom1, & 822 & tl_var0%c_point, & 823 & tl_lon1, tl_lat1 ) 824 825 ! get coarse grid indices of this segment 826 il_ind(:,:)=grid_get_coarse_index(tl_coord0, & 827 & tl_lon1, tl_lat1, & 828 & id_rho=il_rho(:) ) 829 830 IF( ANY(il_ind(:,:)==0) )THEN 831 CALL logger_error("CREATE BOUNDARY: error "//& 832 & "computing coarse grid indices") 833 ELSE 834 il_imin0=il_ind(1,1) 835 il_imax0=il_ind(1,2) 836 837 il_jmin0=il_ind(2,1) 838 il_jmax0=il_ind(2,2) 839 ENDIF 840 841 il_offset(:,:)= grid_get_fine_offset( & 842 & tl_coord0, & 843 & il_imin0, il_jmin0,& 844 & il_imax0, il_jmax0,& 845 & tl_lon1%d_value(:,:,1,1),& 846 & tl_lat1%d_value(:,:,1,1),& 847 & il_rho(:),& 848 & TRIM(tl_var0%c_point) ) 849 850 ! compute coarse grid segment domain 851 tl_dom0=dom_init( tl_coord0, & 852 & il_imin0, il_imax0,& 853 & il_jmin0, il_jmax0 ) 854 855 ! add extra band (if possible) to compute interpolation 856 CALL dom_add_extra(tl_dom0) 857 858 ! open mpp files 859 CALL iom_dom_open(tl_mpp, tl_dom0) 860 861 cl_name=tl_var0%c_name 862 ! read variable value on domain 863 tl_segvar1(jvar+jj,jk,jl)= & 864 & iom_dom_read_var(tl_mpp, TRIM(cl_name), tl_dom0) 865 866 IF( ANY(il_rho(:)/=1) )THEN 867 WRITE(*,'(4x,a,a)') "interp variable "//TRIM(cl_name) 872 868 ! work on variable 873 869 CALL create_boundary_interp( & 874 870 & tl_segvar1(jvar+jj,jk,jl),& 875 871 & 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))) 872 ENDIF 873 874 ! remove extraband added to domain 875 CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), & 876 & tl_dom0, il_rho(:) ) 877 878 ! del extra point on fine grid 879 CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), & 880 & tl_dom1 ) 881 ! clean extra point information on coarse grid domain 882 CALL dom_clean_extra( tl_dom0 ) 883 884 ! add attribute to variable 885 tl_att=att_init('src_file',& 886 & TRIM(fct_basename(tl_mpp%c_name))) 887 CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), & 888 & tl_att) 889 890 ! 891 tl_att=att_init('src_i_indices',& 892 & (/tl_dom0%i_imin, tl_dom0%i_imax/)) 893 CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), & 894 & tl_att) 895 896 tl_att=att_init('src_j_indices', & 897 & (/tl_dom0%i_jmin, tl_dom0%i_jmax/)) 898 CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), & 899 & tl_att) 900 901 IF( ANY(il_rho(:)/=1) )THEN 902 tl_att=att_init("refinment_factor", & 903 & (/il_rho(jp_I),il_rho(jp_J)/)) 890 904 CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), & 891 905 & 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) 909 ENDIF 910 911 ! clean structure 912 CALL att_clean(tl_att) 913 914 ! clean 915 CALL dom_clean(tl_dom0) 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 906 ENDIF 907 908 ! clean structure 909 CALL att_clean(tl_att) 927 910 928 911 ! 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 939 ENDIF 912 CALL dom_clean(tl_dom0) 913 CALL dom_clean(tl_dom1) 914 915 ! close mpp files 916 CALL iom_dom_close(tl_mpp) 917 918 ! clean structure 919 CALL var_clean(tl_lon1) 920 CALL var_clean(tl_lat1) 921 CALL var_clean(tl_lvl1) 922 923 ENDDO ! jj 924 925 ! clean 926 CALL var_clean(tl_var0) 927 928 ENDDO ! jk 929 930 ENDIF 931 ENDDO ! jl 932 933 jvar=jvar+tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 940 934 941 935 ! clean … … 944 938 !- end of use file to fill variable 945 939 ENDIF 946 ENDDO 940 ENDDO ! ji 947 941 ENDIF 948 942 … … 1148 1142 ! clean 1149 1143 IF( ASSOCIATED(tl_depth%d_value) ) CALL var_clean(tl_depth) 1150 IF( ASSOCIATED(tl_time%d_value) ) 1144 IF( ASSOCIATED(tl_time%d_value) ) CALL var_clean(tl_time) 1151 1145 DEALLOCATE( tl_segdom1 ) 1152 1146 DEALLOCATE( tl_segvar1 ) … … 1163 1157 CALL logger_footer() 1164 1158 CALL logger_close() 1165 1166 CONTAINS 1159 CALL logger_clean() 1160 1161 END SUBROUTINE create__boundary 1167 1162 !------------------------------------------------------------------- 1168 1163 !> @brief … … 1294 1289 TYPE(TMPP) , INTENT(IN ) :: td_coord1 1295 1290 TYPE(TDOM) , INTENT(IN ) :: td_dom1 1291 CHARACTER(LEN=*), INTENT(IN ) :: cd_point 1296 1292 TYPE(TVAR) , INTENT( OUT) :: td_lon1 1297 1293 TYPE(TVAR) , INTENT( OUT) :: td_lat1 1298 CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: cd_point1299 1294 1300 1295 ! local variable 1301 TYPE(TMPP) :: tl_coord11296 TYPE(TMPP) :: tl_coord1 1302 1297 1303 1298 CHARACTER(LEN=lc) :: cl_name … … 1351 1346 INTEGER(i4), DIMENSION(:,:), INTENT(IN ) :: id_offset 1352 1347 1353 INTEGER(i4), INTENT(IN ), OPTIONAL :: id_iext1354 INTEGER(i4), INTENT(IN ), OPTIONAL :: id_jext1348 INTEGER(i4), INTENT(IN ), OPTIONAL :: id_iext 1349 INTEGER(i4), INTENT(IN ), OPTIONAL :: id_jext 1355 1350 1356 1351 … … 1404 1399 !> and with dimension of the coordinate file. 1405 1400 !> Then the variable array of value is split into equal subdomain. 1406 !> Each subdomain is fill with the linked value of the matrix.1401 !> Each subdomain is fill with the associated value of the matrix. 1407 1402 !> 1408 1403 !> @author J.Paul … … 1417 1412 IMPLICIT NONE 1418 1413 ! Argument 1419 TYPE(TVAR) , 1420 TYPE(TDOM) , 1421 INTEGER(i4), 1414 TYPE(TVAR) , INTENT(IN) :: td_var 1415 TYPE(TDOM) , INTENT(IN) :: td_dom 1416 INTEGER(i4), INTENT(IN) :: id_nlevel 1422 1417 1423 1418 ! function … … 1621 1616 !------------------------------------------------------------------- 1622 1617 !> @brief 1623 !> This subroutine get depth variable value in an open mpp structure 1618 !> This subroutine check if variable need depth dimension, 1619 !> get depth variable value in an open mpp structure 1624 1620 !> and check if agree with already input depth variable. 1625 1621 !> … … 1628 1624 !> @author J.Paul 1629 1625 !> @date November, 2014 - Initial Version 1626 !> @date January, 2016 1627 !> - check if variable need/use depth dimension 1630 1628 !> 1629 !> @param[in] td_var variable structure 1631 1630 !> @param[in] td_mpp mpp structure 1631 !> @param[in] id_nlevel mpp structure 1632 1632 !> @param[inout] td_depth depth variable structure 1633 1633 !------------------------------------------------------------------- 1634 SUBROUTINE create_boundary_check_depth( td_ mpp, td_depth )1634 SUBROUTINE create_boundary_check_depth( td_var, td_mpp, id_nlevel, td_depth ) 1635 1635 1636 1636 IMPLICIT NONE 1637 1637 1638 1638 ! Argument 1639 TYPE(TVAR) , INTENT(IN ) :: td_var 1639 1640 TYPE(TMPP) , INTENT(IN ) :: td_mpp 1641 INTEGER(i4), INTENT(IN ) :: id_nlevel 1640 1642 TYPE(TVAR) , INTENT(INOUT) :: td_depth 1641 1643 … … 1646 1648 !---------------------------------------------------------------- 1647 1649 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 1650 IF( td_var%t_dim(jp_K)%l_use .AND. & 1651 & ( TRIM(td_var%c_axis) == '' .OR. & 1652 & INDEX(TRIM(td_var%c_axis),'Z') /= 0 )& 1653 & )THEN 1654 1655 ! check vertical dimension 1656 IF( td_mpp%t_dim(jp_K)%l_use )THEN 1657 IF( td_mpp%t_dim(jp_K)%i_len /= id_nlevel .AND. & 1658 & td_mpp%t_dim(jp_K)%i_len /= 1 )THEN 1659 CALL logger_error("CREATE BOUNDARY: dimension in file "//& 1660 & TRIM(td_mpp%c_name)//" not agree with namelist in_nlevel ") 1662 1661 ENDIF 1663 CALL var_clean(tl_depth)1664 1665 ELSE1666 td_depth=iom_mpp_read_var(td_mpp,il_varid)1667 1662 ENDIF 1668 1663 1664 ! get or check depth value 1665 IF( td_mpp%t_proc(1)%i_depthid /= 0 )THEN 1666 1667 il_varid=td_mpp%t_proc(1)%i_depthid 1668 IF( ASSOCIATED(td_depth%d_value) )THEN 1669 1670 tl_depth=iom_mpp_read_var(td_mpp, il_varid) 1671 1672 IF( ANY( td_depth%d_value(:,:,:,:) /= & 1673 & tl_depth%d_value(:,:,:,:) ) )THEN 1674 1675 CALL logger_error("CREATE BOUNDARY: depth value "//& 1676 & "for variable "//TRIM(td_var%c_name)//& 1677 & "from "//TRIM(td_mpp%c_name)//" not conform "//& 1678 & " to those from former file(s).") 1679 1680 ENDIF 1681 CALL var_clean(tl_depth) 1682 1683 ELSE 1684 td_depth=iom_mpp_read_var(td_mpp,il_varid) 1685 ENDIF 1686 1687 ENDIF 1688 ELSE 1689 CALL logger_debug("CREATE BOUNDARY: no depth dimension use"//& 1690 & " for variable "//TRIM(td_var%c_name)) 1669 1691 ENDIF 1670 1692 … … 1672 1694 !------------------------------------------------------------------- 1673 1695 !> @brief 1674 !> This subroutine get date and time in an open mpp structure 1696 !> This subroutine check if variable need time dimension, 1697 !> get date and time in an open mpp structure 1675 1698 !> and check if agree with date and time already read. 1676 1699 !> … … 1679 1702 !> @author J.Paul 1680 1703 !> @date November, 2014 - Initial Version 1704 !> @date January, 2016 1705 !> - check if variable need/use time dimension 1681 1706 !> 1707 !> @param[in] td_var variable structure 1682 1708 !> @param[in] td_mpp mpp structure 1683 1709 !> @param[inout] td_time time variable structure 1684 1710 !------------------------------------------------------------------- 1685 SUBROUTINE create_boundary_check_time( td_ mpp, td_time )1711 SUBROUTINE create_boundary_check_time( td_var, td_mpp, td_time ) 1686 1712 1687 1713 IMPLICIT NONE 1688 1714 1689 1715 ! Argument 1716 TYPE(TVAR), INTENT(IN ) :: td_var 1690 1717 TYPE(TMPP), INTENT(IN ) :: td_mpp 1691 1718 TYPE(TVAR), INTENT(INOUT) :: td_time … … 1699 1726 ! loop indices 1700 1727 !---------------------------------------------------------------- 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 1728 IF( td_var%t_dim(jp_L)%l_use .AND. & 1729 & ( TRIM(td_var%c_axis) == '' .OR. & 1730 & INDEX(TRIM(td_var%c_axis),'T') /= 0 )& 1731 & )THEN 1732 1733 ! get or check depth value 1734 IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN 1735 1736 il_varid=td_mpp%t_proc(1)%i_timeid 1737 IF( ASSOCIATED(td_time%d_value) )THEN 1738 1739 tl_time=iom_mpp_read_var(td_mpp, il_varid) 1740 1741 tl_date1=var_to_date(td_time) 1742 tl_date2=var_to_date(tl_time) 1743 IF( tl_date1 - tl_date2 /= 0 )THEN 1744 1745 CALL logger_warn("CREATE BOUNDARY: date from "//& 1746 & TRIM(td_mpp%c_name)//" not conform "//& 1747 & " to those from former file(s).") 1748 1749 ENDIF 1750 CALL var_clean(tl_time) 1751 1752 ELSE 1753 td_time=iom_mpp_read_var(td_mpp,il_varid) 1718 1754 ENDIF 1719 CALL var_clean(tl_time) 1720 1721 ELSE 1722 td_time=iom_mpp_read_var(td_mpp,il_varid) 1755 1723 1756 ENDIF 1724 1757 1758 ELSE 1759 CALL logger_debug("CREATE BOUNDARY: no time dimension use"//& 1760 & " for variable "//TRIM(td_var%c_name)) 1725 1761 ENDIF 1726 1762 1727 1763 END SUBROUTINE create_boundary_check_time 1728 1764 END PROGRAM create_boundary
Note: See TracChangeset
for help on using the changeset viewer.
