- Timestamp:
- 2016-11-18T09:34:22+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/SIREN/src/create_restart.f90
r5602 r7261 9 9 !> @file 10 10 !> @brief 11 !> This program create restart file.11 !> This program creates restart file. 12 12 !> 13 13 !> @details 14 14 !> @section sec1 method 15 15 !> Variables could be extracted from fine grid file, interpolated from coarse 16 !> grid file or restart file , ormanually written.<br/>17 !> Then they are split over new decomposition.16 !> grid file or restart file. Variables could also be manually written.<br/> 17 !> Then they are split over new layout. 18 18 !> @note 19 19 !> method could be different for each variable. … … 25 25 !> @endcode 26 26 !> 27 !> create_restart.nam comprise 9 namelists:<br/> 27 !> @note 28 !> you could find a template of the namelist in templates directory. 29 !> 30 !> create_restart.nam contains 9 namelists:<br/> 28 31 !> - logger namelist (namlog) 29 32 !> - config namelist (namcfg) … … 36 39 !> - output namelist (namout) 37 40 !> 38 !> @note39 !> All namelists have to be in file create_restart.nam40 !> however variables of those namelists are all optional.41 !>42 41 !> * _logger namelist (namlog)_:<br/> 43 42 !> - cn_logfile : log filename 44 43 !> - cn_verbosity : verbosity ('trace','debug','info', 45 !> 'warning','error','fatal' )44 !> 'warning','error','fatal','none') 46 45 !> - in_maxerror : maximum number of error allowed 47 46 !> … … 49 48 !> - cn_varcfg : variable configuration file 50 49 !> (see ./SIREN/cfg/variable.cfg) 50 !> - cn_dumcfg : useless (dummy) configuration file, for useless 51 !> dimension or variable (see ./SIREN/cfg/dummy.cfg). 51 52 !> 52 53 !> * _coarse grid namelist (namcrs):<br/> … … 59 60 !> - cn_bathy1 : bathymetry file 60 61 !> - in_perio1 : NEMO periodicity index 61 !> - in_extrap : number of land point to be extrapolated62 !> before writing file63 62 !> 64 63 !> * _vertical grid namelist (namzgr)_:<br/> … … 81 80 !> 82 81 !> * _variable namelist (namvar)_:<br/> 83 !> - cn_varinfo : list of variable and extra information about request(s) 84 !> to be used.<br/> 85 !> each elements of *cn_varinfo* is a string character.<br/> 86 !> it is composed of the variable name follow by ':', 87 !> then request(s) to be used on this variable.<br/> 88 !> request could be: 89 !> - interpolation method 90 !> - extrapolation method 91 !> - filter method 92 !> - > minimum value 93 !> - < maximum value 94 !> 95 !> requests must be separated by ';'.<br/> 96 !> order of requests does not matter.<br/> 97 !> 98 !> informations about available method could be find in @ref interp, 99 !> @ref extrap and @ref filter.<br/> 100 !> Example: 'votemper: linear; hann; dist_weight','vosaline: cubic' 101 !> @note 102 !> If you do not specify a method which is required, 103 !> default one is apply. 104 !> - cn_varfile : list of variable, and corresponding file<br/> 82 !> - cn_varfile : list of variable, and associated file<br/> 105 83 !> *cn_varfile* is the path and filename of the file where find 106 84 !> variable.<br/> … … 127 105 !> - 'all:restart.dimg' 128 106 !> 107 !> - cn_varinfo : list of variable and extra information about request(s) 108 !> to be used.<br/> 109 !> each elements of *cn_varinfo* is a string character 110 !> (separated by ',').<br/> 111 !> it is composed of the variable name follow by ':', 112 !> then request(s) to be used on this variable.<br/> 113 !> request could be: 114 !> - int = interpolation method 115 !> - ext = extrapolation method 116 !> - flt = filter method 117 !> - min = minimum value 118 !> - max = maximum value 119 !> - unt = new units 120 !> - unf = unit scale factor (linked to new units) 121 !> 122 !> requests must be separated by ';'.<br/> 123 !> order of requests does not matter.<br/> 124 !> 125 !> informations about available method could be find in @ref interp, 126 !> @ref extrap and @ref filter.<br/> 127 !> Example: 'votemper: int=linear; flt=hann; ext=dist_weight', 128 !> 'vosaline: int=cubic' 129 !> @note 130 !> If you do not specify a method which is required, 131 !> default one is apply. 132 !> 129 133 !> * _nesting namelist (namnst)_:<br/> 130 134 !> - in_rhoi : refinement factor in i-direction 131 135 !> - in_rhoj : refinement factor in j-direction 132 136 !> @note 133 !> coarse grid indices will be deduced from fine grid137 !> coarse grid indices will be computed from fine grid 134 138 !> coordinate file. 135 139 !> 136 140 !> * _output namelist (namout)_:<br/> 137 141 !> - cn_fileout : output file 142 !> - ln_extrap : extrapolate land point or not 143 !> - in_niproc : number of processor in i-direction 144 !> - in_njproc : number of processor in j-direction 138 145 !> - in_nproc : total number of processor to be used 139 !> - in_niproc : i-direction number of processor140 !> - in_njproc : j-direction numebr of processor141 146 !> - cn_type : output format ('dimg', 'cdf') 142 147 !> … … 148 153 !> - offset computed considering grid point 149 154 !> - add attributes in output variable 155 !> @date June, 2015 156 !> - extrapolate all land points, and add ln_extrap in namelist. 157 !> - allow to change unit. 158 !> @date September, 2015 159 !> - manage useless (dummy) variable, attributes, and dimension 150 160 !> 151 161 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 176 186 IMPLICIT NONE 177 187 178 179 188 ! local variable 180 189 CHARACTER(LEN=lc) :: cl_namelist … … 204 213 205 214 LOGICAL :: ll_exist 215 LOGICAL :: ll_sameGrid 206 216 207 217 TYPE(TDOM) :: tl_dom1 … … 234 244 ! namelist variable 235 245 ! namlog 236 CHARACTER(LEN=lc) :: cn_logfile = 'create_restart.log'237 CHARACTER(LEN=lc) :: cn_verbosity = 'warning'238 INTEGER(i4) :: in_maxerror = 5246 CHARACTER(LEN=lc) :: cn_logfile = 'create_restart.log' 247 CHARACTER(LEN=lc) :: cn_verbosity = 'warning' 248 INTEGER(i4) :: in_maxerror = 5 239 249 240 250 ! namcfg 241 CHARACTER(LEN=lc) :: cn_varcfg = 'variable.cfg' 251 CHARACTER(LEN=lc) :: cn_varcfg = 'variable.cfg' 252 CHARACTER(LEN=lc) :: cn_dumcfg = 'dummy.cfg' 242 253 243 254 ! namcrs 244 CHARACTER(LEN=lc) :: cn_coord0 = ''245 INTEGER(i4) :: in_perio0 = -1255 CHARACTER(LEN=lc) :: cn_coord0 = '' 256 INTEGER(i4) :: in_perio0 = -1 246 257 247 258 ! namfin 248 CHARACTER(LEN=lc) :: cn_coord1 = '' 249 CHARACTER(LEN=lc) :: cn_bathy1 = '' 250 INTEGER(i4) :: in_perio1 = -1 251 INTEGER(i4) :: in_extrap = 0 259 CHARACTER(LEN=lc) :: cn_coord1 = '' 260 CHARACTER(LEN=lc) :: cn_bathy1 = '' 261 INTEGER(i4) :: in_perio1 = -1 252 262 253 263 !namzgr 254 REAL(dp) :: dn_pp_to_be_computed = 0._dp255 REAL(dp) :: dn_ppsur= -3958.951371276829_dp256 REAL(dp) :: dn_ppa0 = 103.9530096000000_dp257 REAL(dp) :: dn_ppa1 = 2.4159512690000_dp258 REAL(dp) :: dn_ppa2 = 100.7609285000000_dp259 REAL(dp) :: dn_ppkth = 15.3510137000000_dp260 REAL(dp) :: dn_ppkth2 = 48.0298937200000_dp261 REAL(dp) :: dn_ppacr = 7.0000000000000_dp262 REAL(dp) :: dn_ppacr2= 13.000000000000_dp263 REAL(dp) :: dn_ppdzmin= 6._dp264 REAL(dp) :: dn_pphmax= 5750._dp265 INTEGER(i4) :: in_nlevel= 75264 REAL(dp) :: dn_pp_to_be_computed = 0._dp 265 REAL(dp) :: dn_ppsur = -3958.951371276829_dp 266 REAL(dp) :: dn_ppa0 = 103.953009600000_dp 267 REAL(dp) :: dn_ppa1 = 2.415951269000_dp 268 REAL(dp) :: dn_ppa2 = 100.760928500000_dp 269 REAL(dp) :: dn_ppkth = 15.351013700000_dp 270 REAL(dp) :: dn_ppkth2 = 48.029893720000_dp 271 REAL(dp) :: dn_ppacr = 7.000000000000_dp 272 REAL(dp) :: dn_ppacr2 = 13.000000000000_dp 273 REAL(dp) :: dn_ppdzmin = 6._dp 274 REAL(dp) :: dn_pphmax = 5750._dp 275 INTEGER(i4) :: in_nlevel = 75 266 276 267 277 !namzps 268 REAL(dp) :: dn_e3zps_min = 25._dp269 REAL(dp) :: dn_e3zps_rat = 0.2_dp278 REAL(dp) :: dn_e3zps_min = 25._dp 279 REAL(dp) :: dn_e3zps_rat = 0.2_dp 270 280 271 281 ! namvar 282 CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = '' 272 283 CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = '' 273 CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = ''274 284 275 285 ! namnst 276 INTEGER(i4) :: in_rhoi = 0277 INTEGER(i4) :: in_rhoj = 0286 INTEGER(i4) :: in_rhoi = 0 287 INTEGER(i4) :: in_rhoj = 0 278 288 279 289 ! namout 280 CHARACTER(LEN=lc) :: cn_fileout = 'restart.nc' 281 INTEGER(i4) :: in_nproc = 0 282 INTEGER(i4) :: in_niproc = 0 283 INTEGER(i4) :: in_njproc = 0 284 CHARACTER(LEN=lc) :: cn_type = '' 290 CHARACTER(LEN=lc) :: cn_fileout = 'restart.nc' 291 LOGICAL :: ln_extrap = .FALSE. 292 INTEGER(i4) :: in_nproc = 0 293 INTEGER(i4) :: in_niproc = 0 294 INTEGER(i4) :: in_njproc = 0 295 CHARACTER(LEN=lc) :: cn_type = '' 285 296 286 297 !------------------------------------------------------------------- … … 292 303 293 304 NAMELIST /namcfg/ & !< configuration namelist 294 & cn_varcfg !< variable configuration file 305 & cn_varcfg, & !< variable configuration file 306 & cn_dumcfg !< dummy configuration file 295 307 296 308 NAMELIST /namcrs/ & !< coarse grid namelist … … 301 313 & cn_coord1, & !< coordinate file 302 314 & cn_bathy1, & !< bathymetry file 303 & in_perio1, & !< periodicity index 304 & in_extrap 315 & in_perio1 !< periodicity index 305 316 306 317 NAMELIST /namzgr/ & … … 323 334 324 335 NAMELIST /namvar/ & !< variable namelist 325 & cn_var info, & !< list of variable and interpolation method to be used.326 & cn_var file !< list of variable file336 & cn_varfile, & !< list of variable file 337 & cn_varinfo !< list of variable and interpolation method to be used. 327 338 328 339 NAMELIST /namnst/ & !< nesting namelist … … 332 343 NAMELIST /namout/ & !< output namlist 333 344 & cn_fileout, & !< fine grid bathymetry file 334 & in_nproc, & !< number of processor to be used345 & ln_extrap, & !< extrapolate or not 335 346 & in_niproc, & !< i-direction number of processor 336 347 & in_njproc, & !< j-direction numebr of processor 348 & in_nproc, & !< number of processor to be used 337 349 & cn_type !< output type format (dimg, cdf) 338 350 !------------------------------------------------------------------- … … 347 359 CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec 348 360 ENDIF 349 361 350 362 ! read namelist 351 363 INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist) … … 374 386 ! get variable extra information 375 387 CALL var_def_extra(TRIM(cn_varcfg)) 388 389 ! get dummy variable 390 CALL var_get_dummy(TRIM(cn_dumcfg)) 391 ! get dummy dimension 392 CALL dim_get_dummy(TRIM(cn_dumcfg)) 393 ! get dummy attribute 394 CALL att_get_dummy(TRIM(cn_dumcfg)) 376 395 377 396 READ( il_fileid, NML = namcrs ) … … 434 453 ! check 435 454 ! check output file do not already exist 436 cl_fileout=file_rename(cn_fileout,1) 455 IF( in_nproc > 0 )THEN 456 cl_fileout=file_rename(cn_fileout,1) 457 ELSE 458 cl_fileout=file_rename(cn_fileout) 459 ENDIF 437 460 INQUIRE(FILE=TRIM(cl_fileout), EXIST=ll_exist) 438 461 IF( ll_exist )THEN … … 468 491 & il_rho(:) ) 469 492 470 ! compute level 471 ALLOCATE(tl_level(ip_npoint)) 472 tl_level(:)=vgrid_get_level(tl_bathy1, cl_namelist ) 473 474 ! remove ghost cell 493 ! fine grid ghost cell 475 494 il_xghost(:,:)=grid_get_ghost(tl_bathy1) 476 DO ji=1,ip_npoint477 CALL grid_del_ghost(tl_level(ji), il_xghost(:,:))478 ENDDO479 480 ! clean481 CALL mpp_clean(tl_bathy1)482 495 483 496 ! work on variables … … 507 520 508 521 jvar=jvar+1 509 522 510 523 WRITE(*,'(2x,a,a)') "work on variable "//& 511 524 & TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) … … 514 527 tl_var(jvar) = create_restart_matrix( & 515 528 & tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj), tl_coord1, & 516 & in_nlevel, tl_level(:) ) 529 & in_nlevel, il_xghost(:,:) ) 530 531 ! add ghost cell 532 CALL grid_add_ghost(tl_var(jvar), il_xghost(:,:)) 517 533 518 534 ENDDO … … 545 561 CALL iom_mpp_close(tl_mpp) 546 562 547 IF( ANY( tl_mpp%t_dim(1:2)%i_len /=&548 & tl_coord0%t_dim(1:2)%i_len) )THEN563 IF( ANY(tl_mpp%t_dim(1:2)%i_len /= tl_coord0%t_dim(1:2)%i_len) .OR.& 564 & ALL(il_rho(:)==1) )THEN 549 565 !!! extract value from fine grid 550 566 551 IF( ANY( tl_mpp%t_dim(1:2)%i_len < =&567 IF( ANY( tl_mpp%t_dim(1:2)%i_len < & 552 568 & tl_coord1%t_dim(1:2)%i_len) )THEN 553 CALL logger_fatal("CREATE RESTART: dimension in file "//&569 CALL logger_fatal("CREATE RESTART: dimensions in file "//& 554 570 & TRIM(tl_mpp%c_name)//" smaller than those in fine"//& 555 571 & " grid coordinates.") 556 572 ENDIF 557 573 574 ! use coord0 instead of mpp for restart file case 575 ! (without lon,lat) 576 ll_sameGrid=.FALSE. 577 IF( ALL(tl_mpp%t_dim(1:2)%i_len /= tl_coord0%t_dim(1:2)%i_len) & 578 & )THEN 579 ll_sameGrid=.TRUE. 580 ENDIF 581 558 582 ! compute domain on fine grid 559 il_ind(:,:)=grid_get_coarse_index(tl_mpp, tl_coord1 ) 583 IF( ll_sameGrid )THEN 584 il_ind(:,:)=grid_get_coarse_index(tl_mpp, tl_coord1 ) 585 ELSE 586 il_ind(:,:)=grid_get_coarse_index(tl_coord0, tl_coord1 ) 587 ENDIF 560 588 561 589 il_imin1=il_ind(1,1) ; il_imax1=il_ind(1,2) … … 563 591 564 592 !- check grid coincidence 565 CALL grid_check_coincidence( tl_mpp, tl_coord1, & 566 & il_imin1, il_imax1, & 567 & il_jmin1, il_jmax1, & 568 & il_rho(:) ) 593 IF( ll_sameGrid )THEN 594 CALL grid_check_coincidence( tl_mpp, tl_coord1, & 595 & il_imin1, il_imax1, & 596 & il_jmin1, il_jmax1, & 597 & il_rho(:) ) 598 ELSE 599 CALL grid_check_coincidence( tl_coord0, tl_coord1, & 600 & il_imin1, il_imax1, & 601 & il_jmin1, il_jmax1, & 602 & il_rho(:) ) 603 ENDIF 569 604 570 605 ! compute domain … … 579 614 DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 580 615 581 WRITE(*,'(2x,a,a)') "work on variable "//&616 WRITE(*,'(2x,a,a)') "work on (extract) variable "//& 582 617 & TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 583 618 … … 600 635 CALL att_clean(tl_att) 601 636 602 ! use mask603 CALL create_restart_mask(tl_var(jvar), tl_level(:))604 605 637 ! add ghost cell 606 CALL grid_add_ghost( tl_var(jvar), tl_dom1%i_ghost(:,:))638 CALL grid_add_ghost(tl_var(jvar), tl_dom1%i_ghost(:,:)) 607 639 608 640 ENDDO … … 631 663 DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 632 664 633 WRITE(*,'(2x,a,a)') "work on variable "//&665 WRITE(*,'(2x,a,a)') "work on (interp) variable "//& 634 666 & TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 635 667 … … 646 678 & id_rho=il_rho(:), & 647 679 & cd_point=TRIM(tl_var(jvar)%c_point)) 648 649 680 650 681 ! interpolate variable 651 CALL create_restart_interp(tl_var(jvar), tl_level(:), &682 CALL create_restart_interp(tl_var(jvar), & 652 683 & il_rho(:), & 653 684 & id_offset=il_offset(:,:)) … … 675 706 CALL att_clean(tl_att) 676 707 677 ! use mask678 CALL create_restart_mask(tl_var(jvar), tl_level(:))679 680 708 ! add ghost cell 681 CALL grid_add_ghost( tl_var(jvar), il_xghost(:,:) ) 682 683 709 CALL grid_add_ghost(tl_var(jvar), il_xghost(:,:)) 684 710 ENDDO 685 711 … … 705 731 CALL mpp_clean(tl_coord0) 706 732 733 IF( .NOT. ln_extrap )THEN 734 ! compute level 735 ALLOCATE(tl_level(ip_npoint)) 736 tl_level(:)=vgrid_get_level(tl_bathy1, cl_namelist ) 737 ENDIF 738 739 ! clean 740 CALL mpp_clean(tl_bathy1) 741 707 742 ! use additional request 708 743 DO jvar=1,il_nvar 709 744 745 ! change unit and apply factor 746 CALL var_chg_unit(tl_var(jvar)) 747 710 748 ! forced min and max value 711 749 CALL var_limit_value(tl_var(jvar)) … … 714 752 CALL filter_fill_value(tl_var(jvar)) 715 753 716 ! extrapolate717 CALL extrap_fill_value(tl_var(jvar), id_iext=in_extrap, &718 & id_jext=in_extrap, &719 & id_kext=in_extrap)754 IF( .NOT. ln_extrap )THEN 755 ! use mask 756 CALL create_restart_mask(tl_var(jvar), tl_level(:)) 757 ENDIF 720 758 721 759 ENDDO … … 724 762 IF( in_niproc == 0 .AND. & 725 763 & in_njproc == 0 .AND. & 726 & in_nproc 764 & in_nproc == 0 )THEN 727 765 in_niproc = 1 728 766 in_njproc = 1 … … 745 783 746 784 DO ji=1,ip_maxdim 785 747 786 IF( tl_dim(ji)%l_use )THEN 748 787 CALL mpp_move_dim(tl_mppout, tl_dim(ji)) … … 754 793 END SELECT 755 794 ENDIF 795 756 796 ENDDO 757 797 … … 782 822 CALL mpp_add_var(tl_mppout, tl_depth) 783 823 ELSE 784 CALL logger_ error("CREATE RESTART: no value for depth variable.")824 CALL logger_warn("CREATE RESTART: no value for depth variable.") 785 825 ENDIF 786 826 ENDIF … … 792 832 CALL mpp_add_var(tl_mppout, tl_time) 793 833 ELSE 794 CALL logger_ error("CREATE RESTART: no value for time variable.")834 CALL logger_warn("CREATE RESTART: no value for time variable.") 795 835 ENDIF 796 836 ENDIF … … 798 838 799 839 ! add other variable 800 DO jvar= 1,il_nvar840 DO jvar=il_nvar,1,-1 801 841 ! check if variable already add 802 842 il_index=var_get_index(tl_mppout%t_proc(1)%t_var(:), tl_var(jvar)%c_name) … … 807 847 ENDDO 808 848 809 ! DO ji=1,4810 ! CALL grid_add_ghost( tl_level(ji), il_xghost(:,:) )811 ! CALL var_clean(tl_level(ji))812 ! ENDDO813 814 849 ! add some attribute 815 850 tl_att=att_init("Created_by","SIREN create_restart") … … 839 874 ENDIF 840 875 876 ! print 877 CALL mpp_print(tl_mppout) 878 841 879 ! create file 842 880 CALL iom_mpp_create(tl_mppout) … … 847 885 CALL iom_mpp_close(tl_mppout) 848 886 849 ! print850 CALL mpp_print(tl_mppout)851 852 887 ! clean 853 888 CALL att_clean(tl_att) 854 889 CALL var_clean(tl_var(:)) 855 890 DEALLOCATE(tl_var) 856 CALL var_clean(tl_level(:)) 857 DEALLOCATE(tl_level) 891 IF( .NOT. ln_extrap )THEN 892 CALL var_clean(tl_level(:)) 893 DEALLOCATE(tl_level) 894 ENDIF 858 895 859 896 CALL mpp_clean(tl_mppout) … … 873 910 !> and with dimension of the coordinate file.<br/> 874 911 !> Then the variable array of value is split into equal subdomain. 875 !> Each subdomain is filled with the correspondingvalue of the matrix.912 !> Each subdomain is filled with the associated value of the matrix. 876 913 !> 877 914 !> @author J.Paul 878 !> - November, 2013- Initial Version 915 !> @date November, 2013 - Initial Version 916 !> @date June, 2015 917 !> - do not use level anymore 879 918 !> 880 919 !> @param[in] td_var variable structure 881 920 !> @param[in] td_coord coordinate file structure 882 921 !> @param[in] id_nlevel number of vertical level 883 !> @param[in] td_level array of level on T,U,V,F point (variable structure)922 !> @param[in] id_xghost ghost cell array 884 923 !> @return variable structure 885 924 !------------------------------------------------------------------- 886 FUNCTION create_restart_matrix(td_var, td_coord, id_nlevel, td_level)925 FUNCTION create_restart_matrix(td_var, td_coord, id_nlevel, id_xghost) 887 926 IMPLICIT NONE 888 927 ! Argument 889 TYPE(TVAR) , INTENT(IN) :: td_var890 TYPE(TMPP) , INTENT(IN) :: td_coord891 INTEGER(i4) , INTENT(IN) :: id_nlevel892 TYPE(TVAR), DIMENSION(:), INTENT(IN) :: td_level928 TYPE(TVAR) , INTENT(IN) :: td_var 929 TYPE(TMPP) , INTENT(IN) :: td_coord 930 INTEGER(i4) , INTENT(IN) :: id_nlevel 931 INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_xghost 893 932 894 933 ! function … … 899 938 INTEGER(i4) , DIMENSION(3) :: il_size 900 939 INTEGER(i4) , DIMENSION(3) :: il_rest 901 INTEGER(i4) , DIMENSION(2,2) :: il_xghost902 940 903 941 INTEGER(i4) , DIMENSION(:) , ALLOCATABLE :: il_ishape … … 915 953 !---------------------------------------------------------------- 916 954 917 ! look for ghost cell918 il_xghost(:,:)=grid_get_ghost( td_coord )919 920 955 ! write value on grid 921 956 ! get matrix dimension … … 929 964 930 965 ! remove ghost cell 931 tl_dim(jp_I)%i_len=tl_dim(jp_I)%i_len - SUM(i l_xghost(jp_I,:))*ip_ghost932 tl_dim(jp_J)%i_len=tl_dim(jp_J)%i_len - SUM(i l_xghost(jp_J,:))*ip_ghost966 tl_dim(jp_I)%i_len=tl_dim(jp_I)%i_len - SUM(id_xghost(jp_I,:))*ip_ghost 967 tl_dim(jp_J)%i_len=tl_dim(jp_J)%i_len - SUM(id_xghost(jp_J,:))*ip_ghost 933 968 934 969 ! split output domain in N subdomain depending of matrix dimension … … 992 1027 DEALLOCATE(dl_value) 993 1028 994 ! use mask995 CALL create_restart_mask(create_restart_matrix, td_level(:))996 997 ! add ghost cell998 CALL grid_add_ghost( create_restart_matrix, il_xghost(:,:) )999 1000 1029 ! clean 1001 1030 DEALLOCATE(il_ishape) … … 1009 1038 !> 1010 1039 !> @author J.Paul 1011 !> - November, 2013- Initial Version1040 !> @date November, 2013 - Initial Version 1012 1041 !> 1013 1042 !> @param[inout] td_var variable structure … … 1071 1100 !> 1072 1101 !> @author J.Paul 1073 !> - Nov, 2013- Initial Version 1102 !> @date November, 2013 - Initial Version 1103 !> @date June, 2015 1104 !> - do not use level anymore (for extrapolation) 1074 1105 !> 1075 1106 !> @param[inout] td_var variable structure 1076 !> @param[inout] td_level fine grid level, array of variable structure1077 1107 !> @param[in] id_rho array of refinment factor 1078 1108 !> @param[in] id_offset array of offset between fine and coarse grid … … 1080 1110 !> @param[in] id_jext j-direction size of extra bands (default=im_minext) 1081 1111 !------------------------------------------------------------------- 1082 SUBROUTINE create_restart_interp( td_var, td_level,&1112 SUBROUTINE create_restart_interp( td_var, & 1083 1113 & id_rho, & 1084 1114 & id_offset, & … … 1089 1119 ! Argument 1090 1120 TYPE(TVAR) , INTENT(INOUT) :: td_var 1091 TYPE(TVAR) , DIMENSION(:) , INTENT(INOUT) :: td_level1092 1121 INTEGER(i4), DIMENSION(:) , INTENT(IN ) :: id_rho 1093 1122 INTEGER(i4), DIMENSION(:,:), INTENT(IN ) :: id_offset … … 1119 1148 il_jext=2 1120 1149 ENDIF 1121 1122 1150 ! work on variable 1123 1151 ! add extraband … … 1125 1153 1126 1154 ! extrapolate variable 1127 CALL extrap_fill_value( td_var, td_level(:), & 1128 & id_offset(:,:), & 1129 & id_rho(:), & 1130 & id_iext=il_iext, id_jext=il_jext ) 1155 CALL extrap_fill_value( td_var ) 1131 1156 1132 1157 ! interpolate variable … … 1146 1171 !> 1147 1172 !> @author J.Paul 1148 !> - November, 2014- Initial Version1173 !> @date November, 2014 - Initial Version 1149 1174 !> 1150 1175 !> @param[in] td_mpp mpp structure … … 1175 1200 & tl_depth%d_value(:,:,:,:) ) )THEN 1176 1201 1177 CALL logger_ fatal("CREATE BOUNDARY: depth value from "//&1178 & TRIM(t l_multi%t_mpp(ji)%c_name)//" not conform "//&1202 CALL logger_warn("CREATE BOUNDARY: depth value from "//& 1203 & TRIM(td_mpp%c_name)//" not conform "//& 1179 1204 & " to those from former file(s).") 1180 1205 … … 1197 1222 !> 1198 1223 !> @author J.Paul 1199 !> - November, 2014- Initial Version1224 !> @date November, 2014 - Initial Version 1200 1225 !> 1201 1226 !> @param[in] td_mpp mpp structure … … 1220 1245 1221 1246 ! get or check depth value 1247 1222 1248 IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN 1223 1249 … … 1231 1257 IF( tl_date1 - tl_date2 /= 0 )THEN 1232 1258 1233 CALL logger_ fatal("CREATE BOUNDARY: date from "//&1234 & TRIM(t l_multi%t_mpp(ji)%c_name)//" not conform "//&1259 CALL logger_warn("CREATE BOUNDARY: date from "//& 1260 & TRIM(td_mpp%c_name)//" not conform "//& 1235 1261 & " to those from former file(s).") 1236 1262
Note: See TracChangeset
for help on using the changeset viewer.
