Changeset 7731 for branches/UKMO/dev_r5518_v3.6_asm_nemovar_community/NEMOGCM/TOOLS/SIREN/src/create_restart.f90
- Timestamp:
- 2017-02-23T14:23:32+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_v3.6_asm_nemovar_community/NEMOGCM/TOOLS/SIREN/src/create_restart.f90
r5037 r7731 25 25 !> @endcode 26 26 !> 27 !> @note 28 !> you could find a template of the namelist in templates directory. 29 !> 27 30 !> create_restart.nam comprise 9 namelists:<br/> 28 31 !> - logger namelist (namlog) … … 43 46 !> - cn_logfile : log filename 44 47 !> - cn_verbosity : verbosity ('trace','debug','info', 45 !> 'warning','error','fatal' )48 !> 'warning','error','fatal','none') 46 49 !> - in_maxerror : maximum number of error allowed 47 50 !> … … 59 62 !> - cn_bathy1 : bathymetry file 60 63 !> - in_perio1 : NEMO periodicity index 61 !> - in_extrap : number of land point to be extrapolated62 !> before writing file63 64 !> 64 65 !> * _vertical grid namelist (namzgr)_:<br/> … … 83 84 !> - cn_varinfo : list of variable and extra information about request(s) 84 85 !> to be used.<br/> 85 !> each elements of *cn_varinfo* is a string character.<br/> 86 !> each elements of *cn_varinfo* is a string character 87 !> (separated by ',').<br/> 86 88 !> it is composed of the variable name follow by ':', 87 89 !> then request(s) to be used on this variable.<br/> 88 90 !> request could be: 89 !> - interpolation method 90 !> - extrapolation method 91 !> - filter method 92 !> - > minimum value 93 !> - < maximum value 91 !> - int = interpolation method 92 !> - ext = extrapolation method 93 !> - flt = filter method 94 !> - min = minimum value 95 !> - max = maximum value 96 !> - unt = new units 97 !> - unf = unit scale factor (linked to new units) 94 98 !> 95 99 !> requests must be separated by ';'.<br/> … … 98 102 !> informations about available method could be find in @ref interp, 99 103 !> @ref extrap and @ref filter.<br/> 100 !> Example: 'votemper: linear; hann; dist_weight','vosaline:cubic'104 !> Example: 'votemper: int=linear; flt=hann; ext=dist_weight','vosaline: int=cubic' 101 105 !> @note 102 106 !> If you do not specify a method which is required, … … 136 140 !> * _output namelist (namout)_:<br/> 137 141 !> - cn_fileout : output file 138 !> - in_nproc : total number of processor to be used142 !> - ln_extrap : extrapolate land point or not 139 143 !> - in_niproc : i-direction number of processor 140 144 !> - in_njproc : j-direction numebr of processor 145 !> - in_nproc : total number of processor to be used 141 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. 150 158 !> 151 159 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 165 173 USE iom ! I/O manager 166 174 USE grid ! grid manager 167 USE vgrid ! vertical grid manager175 USE vgrid ! vertical grid manager 168 176 USE extrap ! extrapolation manager 169 177 USE interp ! interpolation manager … … 249 257 CHARACTER(LEN=lc) :: cn_bathy1 = '' 250 258 INTEGER(i4) :: in_perio1 = -1 251 INTEGER(i4) :: in_extrap = 0252 259 253 260 !namzgr … … 279 286 ! namout 280 287 CHARACTER(LEN=lc) :: cn_fileout = 'restart.nc' 288 LOGICAL :: ln_extrap = .FALSE. 281 289 INTEGER(i4) :: in_nproc = 0 282 290 INTEGER(i4) :: in_niproc = 0 … … 301 309 & cn_coord1, & !< coordinate file 302 310 & cn_bathy1, & !< bathymetry file 303 & in_perio1, & !< periodicity index 304 & in_extrap 311 & in_perio1 !< periodicity index 305 312 306 313 NAMELIST /namzgr/ & … … 332 339 NAMELIST /namout/ & !< output namlist 333 340 & cn_fileout, & !< fine grid bathymetry file 334 & in_nproc, & !< number of processor to be used341 & ln_extrap, & !< extrapolate or not 335 342 & in_niproc, & !< i-direction number of processor 336 343 & in_njproc, & !< j-direction numebr of processor 344 & in_nproc, & !< number of processor to be used 337 345 & cn_type !< output type format (dimg, cdf) 338 346 !------------------------------------------------------------------- … … 347 355 CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec 348 356 ENDIF 349 357 350 358 ! read namelist 351 359 INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist) … … 434 442 ! check 435 443 ! check output file do not already exist 436 cl_fileout=file_rename(cn_fileout,1) 444 IF( in_nproc > 0 )THEN 445 cl_fileout=file_rename(cn_fileout,1) 446 ELSE 447 cl_fileout=file_rename(cn_fileout) 448 ENDIF 437 449 INQUIRE(FILE=TRIM(cl_fileout), EXIST=ll_exist) 438 450 IF( ll_exist )THEN … … 468 480 & il_rho(:) ) 469 481 470 ! compute level 471 ALLOCATE(tl_level(ip_npoint)) 472 tl_level(:)=vgrid_get_level(tl_bathy1, cl_namelist ) 473 474 ! remove ghost cell 482 ! fine grid ghost cell 475 483 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 484 483 485 ! work on variables … … 514 516 tl_var(jvar) = create_restart_matrix( & 515 517 & tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj), tl_coord1, & 516 & in_nlevel, tl_level(:) ) 518 & in_nlevel, il_xghost(:,:) ) 519 520 ! add ghost cell 521 CALL grid_add_ghost(tl_var(jvar), il_xghost(:,:)) 517 522 518 523 ENDDO … … 535 540 ! open mpp file 536 541 CALL iom_mpp_open(tl_mpp) 542 537 543 538 544 ! get or check depth value … … 579 585 DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 580 586 581 WRITE(*,'(2x,a,a)') "work on variable "//&587 WRITE(*,'(2x,a,a)') "work on (extract) variable "//& 582 588 & TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 583 589 … … 600 606 CALL att_clean(tl_att) 601 607 602 ! use mask603 CALL create_restart_mask(tl_var(jvar), tl_level(:))604 605 608 ! add ghost cell 606 CALL grid_add_ghost( tl_var(jvar), tl_dom1%i_ghost(:,:))609 CALL grid_add_ghost(tl_var(jvar), tl_dom1%i_ghost(:,:)) 607 610 608 611 ENDDO … … 631 634 DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 632 635 633 WRITE(*,'(2x,a,a)') "work on variable "//&636 WRITE(*,'(2x,a,a)') "work on (interp) variable "//& 634 637 & TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 635 638 … … 646 649 & id_rho=il_rho(:), & 647 650 & cd_point=TRIM(tl_var(jvar)%c_point)) 648 649 651 650 652 ! interpolate variable 651 CALL create_restart_interp(tl_var(jvar), tl_level(:), &653 CALL create_restart_interp(tl_var(jvar), & 652 654 & il_rho(:), & 653 655 & id_offset=il_offset(:,:)) … … 675 677 CALL att_clean(tl_att) 676 678 677 ! use mask678 CALL create_restart_mask(tl_var(jvar), tl_level(:))679 680 679 ! add ghost cell 681 CALL grid_add_ghost( tl_var(jvar), il_xghost(:,:) ) 682 683 680 CALL grid_add_ghost(tl_var(jvar), il_xghost(:,:)) 684 681 ENDDO 685 682 … … 705 702 CALL mpp_clean(tl_coord0) 706 703 704 IF( .NOT. ln_extrap )THEN 705 ! compute level 706 ALLOCATE(tl_level(ip_npoint)) 707 tl_level(:)=vgrid_get_level(tl_bathy1, cl_namelist ) 708 ENDIF 709 710 ! clean 711 CALL mpp_clean(tl_bathy1) 712 707 713 ! use additional request 708 714 DO jvar=1,il_nvar 709 715 716 ! change unit and apply factor 717 CALL var_chg_unit(tl_var(jvar)) 718 710 719 ! forced min and max value 711 720 CALL var_limit_value(tl_var(jvar)) … … 714 723 CALL filter_fill_value(tl_var(jvar)) 715 724 716 ! extrapolate717 CALL extrap_fill_value(tl_var(jvar), id_iext=in_extrap, &718 & id_jext=in_extrap, &719 & id_kext=in_extrap)725 IF( .NOT. ln_extrap )THEN 726 ! use mask 727 CALL create_restart_mask(tl_var(jvar), tl_level(:)) 728 ENDIF 720 729 721 730 ENDDO … … 724 733 IF( in_niproc == 0 .AND. & 725 734 & in_njproc == 0 .AND. & 726 & in_nproc 735 & in_nproc == 0 )THEN 727 736 in_niproc = 1 728 737 in_njproc = 1 … … 782 791 CALL mpp_add_var(tl_mppout, tl_depth) 783 792 ELSE 784 CALL logger_ error("CREATE RESTART: no value for depth variable.")793 CALL logger_warn("CREATE RESTART: no value for depth variable.") 785 794 ENDIF 786 795 ENDIF … … 792 801 CALL mpp_add_var(tl_mppout, tl_time) 793 802 ELSE 794 CALL logger_ error("CREATE RESTART: no value for time variable.")803 CALL logger_warn("CREATE RESTART: no value for time variable.") 795 804 ENDIF 796 805 ENDIF … … 798 807 799 808 ! add other variable 800 DO jvar= 1,il_nvar809 DO jvar=il_nvar,1,-1 801 810 ! check if variable already add 802 811 il_index=var_get_index(tl_mppout%t_proc(1)%t_var(:), tl_var(jvar)%c_name) … … 807 816 ENDDO 808 817 809 ! DO ji=1,4810 ! CALL grid_add_ghost( tl_level(ji), il_xghost(:,:) )811 ! CALL var_clean(tl_level(ji))812 ! ENDDO813 814 818 ! add some attribute 815 819 tl_att=att_init("Created_by","SIREN create_restart") … … 839 843 ENDIF 840 844 845 ! print 846 CALL mpp_print(tl_mppout) 847 841 848 ! create file 842 849 CALL iom_mpp_create(tl_mppout) … … 847 854 CALL iom_mpp_close(tl_mppout) 848 855 849 ! print850 CALL mpp_print(tl_mppout)851 852 856 ! clean 853 857 CALL att_clean(tl_att) 854 858 CALL var_clean(tl_var(:)) 855 859 DEALLOCATE(tl_var) 856 CALL var_clean(tl_level(:)) 857 DEALLOCATE(tl_level) 860 IF( .NOT. ln_extrap )THEN 861 CALL var_clean(tl_level(:)) 862 DEALLOCATE(tl_level) 863 ENDIF 858 864 859 865 CALL mpp_clean(tl_mppout) … … 876 882 !> 877 883 !> @author J.Paul 878 !> - November, 2013- Initial Version 884 !> @date November, 2013 - Initial Version 885 !> @date June, 2015 886 !> - do not use level anymore 879 887 !> 880 888 !> @param[in] td_var variable structure 881 889 !> @param[in] td_coord coordinate file structure 882 890 !> @param[in] id_nlevel number of vertical level 883 !> @param[in] td_level array of level on T,U,V,F point (variable structure)891 !> @param[in] id_xghost ghost cell array 884 892 !> @return variable structure 885 893 !------------------------------------------------------------------- 886 FUNCTION create_restart_matrix(td_var, td_coord, id_nlevel, td_level)894 FUNCTION create_restart_matrix(td_var, td_coord, id_nlevel, id_xghost) 887 895 IMPLICIT NONE 888 896 ! 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_level897 TYPE(TVAR) , INTENT(IN) :: td_var 898 TYPE(TMPP) , INTENT(IN) :: td_coord 899 INTEGER(i4) , INTENT(IN) :: id_nlevel 900 INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_xghost 893 901 894 902 ! function … … 899 907 INTEGER(i4) , DIMENSION(3) :: il_size 900 908 INTEGER(i4) , DIMENSION(3) :: il_rest 901 INTEGER(i4) , DIMENSION(2,2) :: il_xghost902 909 903 910 INTEGER(i4) , DIMENSION(:) , ALLOCATABLE :: il_ishape … … 915 922 !---------------------------------------------------------------- 916 923 917 ! look for ghost cell918 il_xghost(:,:)=grid_get_ghost( td_coord )919 920 924 ! write value on grid 921 925 ! get matrix dimension … … 929 933 930 934 ! 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_ghost935 tl_dim(jp_I)%i_len=tl_dim(jp_I)%i_len - SUM(id_xghost(jp_I,:))*ip_ghost 936 tl_dim(jp_J)%i_len=tl_dim(jp_J)%i_len - SUM(id_xghost(jp_J,:))*ip_ghost 933 937 934 938 ! split output domain in N subdomain depending of matrix dimension … … 992 996 DEALLOCATE(dl_value) 993 997 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 998 ! clean 1001 999 DEALLOCATE(il_ishape) … … 1009 1007 !> 1010 1008 !> @author J.Paul 1011 !> - November, 2013- Initial Version1009 !> @date November, 2013 - Initial Version 1012 1010 !> 1013 1011 !> @param[inout] td_var variable structure … … 1071 1069 !> 1072 1070 !> @author J.Paul 1073 !> - Nov, 2013- Initial Version 1071 !> @date November, 2013 - Initial Version 1072 !> @date June, 2015 1073 !> - do not use level anymore (for extrapolation) 1074 1074 !> 1075 1075 !> @param[inout] td_var variable structure 1076 !> @param[inout] td_level fine grid level, array of variable structure1077 1076 !> @param[in] id_rho array of refinment factor 1078 1077 !> @param[in] id_offset array of offset between fine and coarse grid … … 1080 1079 !> @param[in] id_jext j-direction size of extra bands (default=im_minext) 1081 1080 !------------------------------------------------------------------- 1082 SUBROUTINE create_restart_interp( td_var, td_level,&1081 SUBROUTINE create_restart_interp( td_var, & 1083 1082 & id_rho, & 1084 1083 & id_offset, & … … 1089 1088 ! Argument 1090 1089 TYPE(TVAR) , INTENT(INOUT) :: td_var 1091 TYPE(TVAR) , DIMENSION(:) , INTENT(INOUT) :: td_level1092 1090 INTEGER(i4), DIMENSION(:) , INTENT(IN ) :: id_rho 1093 1091 INTEGER(i4), DIMENSION(:,:), INTENT(IN ) :: id_offset … … 1119 1117 il_jext=2 1120 1118 ENDIF 1121 1122 1119 ! work on variable 1123 1120 ! add extraband … … 1125 1122 1126 1123 ! 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 ) 1124 CALL extrap_fill_value( td_var ) 1131 1125 1132 1126 ! interpolate variable … … 1146 1140 !> 1147 1141 !> @author J.Paul 1148 !> - November, 2014- Initial Version1142 !> @date November, 2014 - Initial Version 1149 1143 !> 1150 1144 !> @param[in] td_mpp mpp structure … … 1197 1191 !> 1198 1192 !> @author J.Paul 1199 !> - November, 2014- Initial Version1193 !> @date November, 2014 - Initial Version 1200 1194 !> 1201 1195 !> @param[in] td_mpp mpp structure … … 1220 1214 1221 1215 ! get or check depth value 1216 1222 1217 IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN 1223 1218
Note: See TracChangeset
for help on using the changeset viewer.