!---------------------------------------------------------------------- ! NEMO system team, System and Interface for oceanic RElocable Nesting !---------------------------------------------------------------------- ! ! ! PROGRAM: create_bathy ! ! DESCRIPTION: !> @brief !> This program create bathymetry file. !> !> @details !> Bathymetry could be extracted from fine grid Bathymetry file, or interpolated !> from coarse grid Bathymetry file. !> !> @author !> J.Paul ! REVISION HISTORY: !> @date Nov, 2013 - Initial Version ! !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) !> !> @todo !> - add attributes indices and refinement in output file !---------------------------------------------------------------------- !> @code PROGRAM create_bathy ! USE netcdf ! nf90 library USE global ! global variable USE kind ! F90 kind parameter USE logger ! log file manager USE fct ! basic useful function USE date ! date manager USE att ! attribute manager USE dim ! dimension manager USE var ! variable manager USE file ! file manager USE multi ! multi file manager USE iom ! I/O manager USE dom ! domain manager USE grid ! grid manager USE extrap ! extrapolation manager USE interp ! interpolation manager USE filter ! filter manager USE mpp ! MPP manager USE iom_mpp ! MPP I/O manager IMPLICIT NONE ! local variable CHARACTER(LEN=lc) :: cl_namelist CHARACTER(LEN=lc) :: cl_date CHARACTER(LEN=lc) :: cl_data INTEGER(i4) :: il_narg INTEGER(i4) :: il_status INTEGER(i4) :: il_fileid INTEGER(i4) :: il_attid INTEGER(i4) :: il_imin INTEGER(i4) :: il_imax INTEGER(i4) :: il_jmin INTEGER(i4) :: il_jmax INTEGER(i4) , DIMENSION(ip_maxdim) :: il_rho INTEGER(i4) , DIMENSION(2,2) :: il_offset INTEGER(i4) , DIMENSION(2,2,2) :: il_ind INTEGER(i4) , DIMENSION(:,:) , ALLOCATABLE :: il_mask LOGICAL :: ll_exist TYPE(TFILE) :: tl_coord0 TYPE(TFILE) :: tl_coord1 TYPE(TFILE) :: tl_file TYPE(TFILE) :: tl_fileout TYPE(TATT) :: tl_att TYPE(TVAR) :: tl_lon TYPE(TVAR) :: tl_lat TYPE(TVAR) :: tl_depth TYPE(TVAR) :: tl_time TYPE(TVAR) :: tl_tmp TYPE(TVAR) , DIMENSION(:), ALLOCATABLE :: tl_var TYPE(TDIM) , DIMENSION(ip_maxdim) :: tl_dim TYPE(TMULTI) :: tl_multi ! loop indices INTEGER(i4) :: ji INTEGER(i4) :: jj INTEGER(i4) :: jk ! namelist variable CHARACTER(LEN=lc) :: cn_logfile = 'create_bathy.log' CHARACTER(LEN=lc) :: cn_verbosity = 'warning' CHARACTER(LEN=lc) :: cn_varcfg = 'variable.cfg' CHARACTER(LEN=lc) :: cn_coord0 = '' INTEGER(i4) :: in_perio0 = -1 CHARACTER(LEN=lc) :: cn_coord1 = '' INTEGER(i4) :: in_perio1 = -1 LOGICAL :: ln_fillclosed = .TRUE. CHARACTER(LEN=lc), DIMENSION(ig_maxvar) :: cn_varinfo = '' CHARACTER(LEN=lc), DIMENSION(ig_maxvar) :: cn_varfile = '' INTEGER(i4) :: in_imin0 = 0 INTEGER(i4) :: in_imax0 = 0 INTEGER(i4) :: in_jmin0 = 0 INTEGER(i4) :: in_jmax0 = 0 INTEGER(i4) :: in_rhoi = 1 INTEGER(i4) :: in_rhoj = 1 CHARACTER(LEN=lc) :: cn_fileout = 'bathy_fine.nc' !------------------------------------------------------------------- NAMELIST /namlog/ & !< logger namelist & cn_logfile, & !< log file & cn_verbosity !< log verbosity NAMELIST /namcfg/ & !< configuration namelist & cn_varcfg !< variable configuration file NAMELIST /namcrs/ & !< coarse grid namelist & cn_coord0, & !< coordinate file & in_perio0 !< periodicity index NAMELIST /namfin/ & !< fine grid namelist & cn_coord1, & !< coordinate file & in_perio1, & !< periodicity index & ln_fillclosed !< fill closed sea NAMELIST /namvar/ & !< variable namelist & cn_varinfo, & !< list of variable and interpolation method to be used. (ex: 'votemper:linear','vosaline:cubic' ) & cn_varfile !< list of variable file NAMELIST /namnst/ & !< nesting namelist & in_imin0, & !< i-direction lower left point indice & in_imax0, & !< i-direction upper right point indice & in_jmin0, & !< j-direction lower left point indice & in_jmax0, & !< j-direction upper right point indice & in_rhoi, & !< refinement factor in i-direction & in_rhoj !< refinement factor in j-direction NAMELIST /namout/ & !< output namlist & cn_fileout !< fine grid bathymetry file !------------------------------------------------------------------- !1- namelist !1-1 get namelist il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec IF( il_narg/=1 )THEN PRINT *,"ERROR in create_bathy: need a namelist" STOP ELSE CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec ENDIF !1-2 read namelist INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist) IF( ll_exist )THEN il_fileid=fct_getunit() OPEN( il_fileid, FILE=TRIM(cl_namelist), & & FORM='FORMATTED', & & ACCESS='SEQUENTIAL', & & STATUS='OLD', & & ACTION='READ', & & IOSTAT=il_status) CALL fct_err(il_status) IF( il_status /= 0 )THEN PRINT *,"ERROR in create_bathy: error opening "//TRIM(cl_namelist) STOP ENDIF READ( il_fileid, NML = namlog ) !1-2-1 define log file CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity)) CALL logger_header() READ( il_fileid, NML = namcfg ) !1-2-2 get variable extra information CALL var_def_extra(TRIM(cn_varcfg)) READ( il_fileid, NML = namcrs ) READ( il_fileid, NML = namfin ) READ( il_fileid, NML = namvar ) !1-2-3 add user change in extra information CALL var_chg_extra(cn_varinfo) !1-2-4 match variable with file tl_multi=multi_init(cn_varfile) READ( il_fileid, NML = namnst ) READ( il_fileid, NML = namout ) CLOSE( il_fileid, IOSTAT=il_status ) CALL fct_err(il_status) IF( il_status /= 0 )THEN CALL logger_error("CREATE BATHY: closing "//TRIM(cl_namelist)) ENDIF ELSE PRINT *,"ERROR in create_bathy: can't find "//TRIM(cl_namelist) ENDIF !2- open files IF( cn_coord0 /= '' )THEN tl_coord0=file_init(TRIM(cn_coord0),id_perio=in_perio0) CALL iom_open(tl_coord0) ELSE CALL logger_fatal("CREATE BATHY: no coarse grid coordinate found. "//& & "check namelist") ENDIF IF( TRIM(cn_coord1) /= '' )THEN tl_coord1=file_init(TRIM(cn_coord1),id_perio=in_perio1) CALL iom_open(tl_coord1) ELSE CALL logger_fatal("CREATE BATHY: no fine grid coordinate found. "//& & "check namelist") ENDIF !3- check !3-1 check output file do not already exist INQUIRE(FILE=TRIM(cn_fileout), EXIST=ll_exist) IF( ll_exist )THEN CALL logger_fatal("CREATE BATHY: output file "//TRIM(cn_fileout)//& & " already exist.") ENDIF !3-2 check namelist !3-2-1 check refinement factor il_rho(:)=1 IF( in_rhoi < 1 .OR. in_rhoj < 1 )THEN CALL logger_error("CREATE BATHY: invalid refinement factor."//& & " check namelist "//TRIM(cl_namelist)) ELSE il_rho(jp_I)=in_rhoi il_rho(jp_J)=in_rhoj ENDIF !3-2-2 check domain indices IF( in_imin0 < 1 .OR. in_imax0 < 1 .OR. & & in_jmin0 < 1 .OR. in_jmax0 < 1)THEN ! compute coarse grid indices around fine grid IF( cn_coord0 /= '' )THEN il_ind(:,:,:)=grid_get_coarse_index( tl_coord0, tl_coord1, & & id_rho=il_rho(:) ) ENDIF il_imin=il_ind(1,1,1) ; il_imax=il_ind(1,2,1) il_jmin=il_ind(2,1,1) ; il_jmax=il_ind(2,2,1) il_offset(:,:)=il_ind(:,:,2) ELSE il_imin=in_imin0 ; il_imax=in_imax0 il_jmin=in_jmin0 ; il_jmax=in_jmax0 il_offset(jp_I,:)=FLOOR(REAL(il_rho(jp_I)-1,dp)*0.5) il_offset(jp_J,:)=FLOOR(REAL(il_rho(jp_J)-1,dp)*0.5) ENDIF !3-2-3 check domain validity IF( cn_coord0 /= '' )THEN CALL grid_check_dom(tl_coord0, il_imin, il_imax, il_jmin, il_jmax) ENDIF !3-2-4 check coincidence between coarse and fine grid IF( cn_coord0 /= '' )THEN CALL grid_check_coincidence( tl_coord0, tl_coord1, & & il_imin, il_imax, & & il_jmin, il_jmax, & & il_rho(:) ) ENDIF IF( .NOT. ASSOCIATED(tl_multi%t_file) )THEN CALL logger_error("CREATE BATHY: no file to work on. "//& & "check cn_varfile in namelist.") ELSE ALLOCATE( tl_var( tl_multi%i_nvar ) ) jk=0 DO ji=1,tl_multi%i_nfile WRITE(cl_data,'(a,i2.2)') 'data_',jk+1 IF( .NOT. ASSOCIATED(tl_multi%t_file(ji)%t_var) )THEN CALL logger_error("CREATE BATHY: no variable to work on for "//& & "file"//TRIM(tl_multi%t_file(ji)%c_name)//& & ". check cn_varfile in namelist.") ELSEIF( TRIM(tl_multi%t_file(ji)%c_name) == TRIM(cl_data) )THEN DO jj=1,tl_multi%t_file(ji)%i_nvar jk=jk+1 tl_tmp=tl_multi%t_file(ji)%t_var(jj) !- use input matrix to initialise variable tl_var(jk)=create_bathy_matrix(tl_tmp, tl_coord1) ENDDO ELSE ! open file tl_file=file_init(TRIM(tl_multi%t_file(ji)%c_name)) CALL iom_open(tl_file) ! get or check depth value IF( tl_file%i_depthid /= 0 )THEN IF( ASSOCIATED(tl_depth%d_value) )THEN IF( ANY( tl_depth%d_value(:,:,:,:) /= & & tl_tmp%d_value(:,:,:,:) ) )THEN CALL logger_fatal("CREATE BATHY: depth value from "//& & TRIM(tl_multi%t_file(ji)%c_name)//" not conform "//& & " to those from former file(s).") ENDIF ELSE tl_depth=iom_read_var(tl_file,tl_file%i_depthid) ENDIF ENDIF ! get or check time value IF( tl_file%i_timeid /= 0 )THEN IF( ASSOCIATED(tl_time%d_value) )THEN IF( ANY( tl_time%d_value(:,:,:,:) /= & & tl_tmp%d_value(:,:,:,:) ) )THEN CALL logger_fatal("CREATE BATHY: time value from "//& & TRIM(tl_multi%t_file(ji)%c_name)//" not conform "//& & " to those from former file(s).") ENDIF ELSE tl_time=iom_read_var(tl_file,tl_file%i_timeid) ENDIF ENDIF IF( ANY( tl_file%t_dim(1:2)%i_len /= & & tl_coord0%t_dim(1:2)%i_len) )THEN DO jj=1,tl_multi%t_file(ji)%i_nvar jk=jk+1 tl_tmp=tl_multi%t_file(ji)%t_var(jj) !- extract bathymetry from fine grid bathymetry tl_var(jk)=create_bathy_extract( tl_tmp, tl_file, & & tl_coord1 ) ENDDO ELSE DO jj=1,tl_multi%t_file(ji)%i_nvar jk=jk+1 tl_tmp=tl_multi%t_file(ji)%t_var(jj) !- get bathymetry from coarse grid bathymetry tl_var(jk)=create_bathy_get_var( tl_tmp, tl_file, & & il_imin, il_jmin, & & il_imax, il_jmax, & & il_offset(:,:), & & il_rho(:) ) ENDDO ENDIF ! close file CALL iom_close(tl_file) ! clean structure CALL file_clean(tl_file) ENDIF ENDDO ENDIF DO jk=1,tl_multi%i_nvar !6- forced min and max value CALL var_limit_value(tl_var(jk)) !7- fill closed sea IF( TRIM(tl_var(jk)%c_stdname) == 'bathymetry' .AND. & ln_fillclosed )THEN ALLOCATE( il_mask(tl_var(jk)%t_dim(1)%i_len, & & tl_var(jk)%t_dim(2)%i_len) ) !7-1 split domain in N sea subdomain il_mask(:,:)=grid_split_domain(tl_var(jk)) !7-2 fill smallest domain CALL grid_fill_small_dom( tl_var(jk), il_mask(:,:) ) DEALLOCATE( il_mask ) ENDIF !8- filter CALL filter_fill_value(tl_var(jk)) !9- check bathymetry IF( TRIM(tl_var(jk)%c_stdname) == 'bathymetry' .AND. & & MINVAL(tl_var(jk)%d_value(:,:,:,:)) <= 0._dp )THEN CALL logger_error("CREATE BATHY: Bathymetry has value <= 0") ENDIF ENDDO !10- create file tl_fileout=file_init(TRIM(cn_fileout),id_perio=in_perio1) !10-1 add dimension tl_dim(:)=var_max_dim(tl_var(:)) DO ji=1,ip_maxdim IF( tl_dim(ji)%l_use ) CALL file_add_dim(tl_fileout, tl_dim(ji)) ENDDO !10-2 add variables IF( ALL( tl_dim(1:2)%l_use ) )THEN ! add longitude tl_lon=iom_read_var(tl_coord1,'longitude') CALL file_add_var(tl_fileout, tl_lon) CALL var_clean(tl_lon) ! add latitude tl_lat=iom_read_var(tl_coord1,'latitude') CALL file_add_var(tl_fileout, tl_lat) CALL var_clean(tl_lat) ENDIF IF( tl_dim(3)%l_use )THEN ! add depth CALL file_add_var(tl_fileout, tl_depth) CALL var_clean(tl_depth) ENDIF IF( tl_dim(4)%l_use )THEN ! add time CALL file_add_var(tl_fileout, tl_time) CALL var_clean(tl_time) ENDIF ! add other variables DO jk=1,tl_multi%i_nvar CALL file_add_var(tl_fileout, tl_var(jk)) CALL var_clean(tl_var(jk)) ENDDO !10-3 add some attribute tl_att=att_init("Created_by","SIREN create_bathy") CALL file_add_att(tl_fileout, tl_att) cl_date=date_print(date_now()) tl_att=att_init("Creation_date",cl_date) CALL file_add_att(tl_fileout, tl_att) ! add attribute periodicity il_attid=0 IF( ASSOCIATED(tl_fileout%t_att) )THEN il_attid=att_get_id(tl_fileout%t_att(:),'periodicity') ENDIF IF( tl_coord1%i_perio >= 0 .AND. il_attid == 0 )THEN tl_att=att_init('periodicity',tl_coord1%i_perio) CALL file_add_att(tl_fileout,tl_att) ENDIF il_attid=0 IF( ASSOCIATED(tl_fileout%t_att) )THEN il_attid=att_get_id(tl_fileout%t_att(:),'ew_overlap') ENDIF IF( tl_coord1%i_ew >= 0 .AND. il_attid == 0 )THEN tl_att=att_init('ew_overlap',tl_coord1%i_ew) CALL file_add_att(tl_fileout,tl_att) ENDIF !10-4 create file CALL iom_create(tl_fileout) !10-5 write file CALL iom_write_file(tl_fileout) !10-6 close file CALL iom_close(tl_fileout) IF( cn_coord0 /= '' ) CALL iom_close(tl_coord0) !11- clean DEALLOCATE(tl_var) CALL file_clean(tl_fileout) CALL file_clean(tl_coord1) CALL file_clean(tl_coord0) ! close log file CALL logger_footer() CALL logger_close() !> @endcode CONTAINS !------------------------------------------------------------------- !> @brief !> This subroutine !> !> @details !> !> @author J.Paul !> - Nov, 2013- Initial Version !> !> @param[in] !------------------------------------------------------------------- !> @code FUNCTION create_bathy_matrix(td_var, td_coord) IMPLICIT NONE ! Argument TYPE(TVAR) , INTENT(IN) :: td_var TYPE(TFILE), INTENT(IN) :: td_coord ! function TYPE(TVAR) :: create_bathy_matrix ! local variable INTEGER(i4) :: il_ighost INTEGER(i4) :: il_jghost INTEGER(i4) , DIMENSION(2) :: il_xghost INTEGER(i4) , DIMENSION(3) :: il_dim INTEGER(i4) , DIMENSION(3) :: il_size INTEGER(i4) , DIMENSION(3) :: il_rest INTEGER(i4) , DIMENSION(:) , ALLOCATABLE :: il_ishape INTEGER(i4) , DIMENSION(:) , ALLOCATABLE :: il_jshape INTEGER(i4) , DIMENSION(:) , ALLOCATABLE :: il_kshape REAL(dp) , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value TYPE(TVAR) :: tl_lon TYPE(TVAR) :: tl_lat TYPE(TVAR) :: tl_var TYPE(TDIM) , DIMENSION(ip_maxdim) :: tl_dim ! loop indices INTEGER(i4) :: ji INTEGER(i4) :: jj INTEGER(i4) :: jk !---------------------------------------------------------------- !1- read output grid tl_lon=iom_read_var(td_coord,'longitude') tl_lat=iom_read_var(td_coord,'latitude') !2- look for ghost cell il_xghost(:)=grid_get_ghost( tl_lon, tl_lat ) il_ighost=il_xghost(1)*ig_ghost il_jghost=il_xghost(2)*ig_ghost !3- write value on grid !3-1 get matrix dimension il_dim(:)=td_var%t_dim(1:3)%i_len !3-2 output dimension tl_dim(:)=tl_lon%t_dim(:) ! remove ghost cell tl_dim(1)%i_len=tl_dim(1)%i_len - 2*il_xghost(1)*ig_ghost tl_dim(2)%i_len=tl_dim(2)%i_len - 2*il_xghost(2)*ig_ghost !3-3 split output domain in N subdomain depending of matrix dimension il_size(:) = tl_dim(1:3)%i_len / il_dim(:) il_rest(:) = MOD(tl_dim(1:3)%i_len, il_dim(:)) ALLOCATE( il_ishape(il_dim(1)+1) ) il_ishape(:)=0 DO ji=2,il_dim(1)+1 il_ishape(ji)=il_ishape(ji-1)+il_size(1) ENDDO ! add rest to last cell il_ishape(il_dim(1)+1)=il_ishape(il_dim(1)+1)+il_rest(1) ALLOCATE( il_jshape(il_dim(2)+1) ) il_jshape(:)=0 DO jj=2,il_dim(2)+1 il_jshape(jj)=il_jshape(jj-1)+il_size(2) ENDDO ! add rest to last cell il_jshape(il_dim(2)+1)=il_jshape(il_dim(2)+1)+il_rest(2) ALLOCATE( il_kshape(il_dim(3)+1) ) il_kshape(:)=0 DO jk=2,il_dim(3)+1 il_kshape(jk)=il_kshape(jk-1)+il_size(3) ENDDO ! add rest to last cell il_kshape(il_dim(3)+1)=il_kshape(il_dim(3)+1)+il_rest(3) !3-3 write ouput table of value ALLOCATE(dl_value( tl_dim(1)%i_len, & & tl_dim(2)%i_len, & & tl_dim(3)%i_len, & & tl_dim(4)%i_len) ) dl_value(:,:,:,:)=0 DO jk=2,il_dim(3)+1 DO jj=2,il_dim(2)+1 DO ji=2,il_dim(1)+1 dl_value( 1+il_ishape(ji-1):il_ishape(ji), & & 1+il_jshape(jj-1):il_jshape(jj), & & 1+il_kshape(jk-1):il_kshape(jk), & & 1 ) = td_var%d_value(ji-1,jj-1,jk-1,1) ENDDO ENDDO ENDDO !3-4 initialise variable with value tl_var=var_init(TRIM(td_var%c_name),dl_value(:,:,:,:)) DEALLOCATE(dl_value) !4- add ghost cell CALL grid_add_ghost(tl_var,il_ighost,il_jghost) !5- save result create_bathy_matrix=tl_var END FUNCTION create_bathy_matrix !> @endcode !------------------------------------------------------------------- !> @brief !> This subroutine !> !> @details !> !> @author J.Paul !> - Nov, 2013- Initial Version !> !> @param[in] !------------------------------------------------------------------- !> @code FUNCTION create_bathy_extract(td_var, td_file, & & td_coord) IMPLICIT NONE ! Argument TYPE(TVAR) , INTENT(IN) :: td_var TYPE(TFILE), INTENT(IN) :: td_file TYPE(TFILE), INTENT(IN) :: td_coord ! function TYPE(TVAR) :: create_bathy_extract ! local variable INTEGER(i4), DIMENSION(2,2,2) :: il_ind INTEGER(i4) :: il_pivot INTEGER(i4) :: il_perio INTEGER(i4) :: il_imin INTEGER(i4) :: il_jmin INTEGER(i4) :: il_imax INTEGER(i4) :: il_jmax TYPE(TFILE) :: tl_file TYPE(TMPP) :: tl_mpp TYPE(TATT) :: tl_att TYPE(TVAR) :: tl_var TYPE(TDOM) :: tl_dom ! loop indices !---------------------------------------------------------------- IF( td_file%i_id == 0 )THEN CALL logger_error("CREATE BATHY EXTRACT: file "//& & TRIM(td_file%c_name)//" not opened ") ELSE !init tl_file=td_file !1- open file CALL iom_open(tl_file) ! get periodicity il_pivot=grid_get_pivot(tl_file) il_perio=grid_get_perio(tl_file,il_pivot) tl_file%i_perio=il_perio !2- compute file grid indices around coord grid il_ind(:,:,:)=grid_get_coarse_index(tl_file, td_coord ) il_imin=il_ind(1,1,1) ; il_imax=il_ind(1,2,1) il_jmin=il_ind(2,1,1) ; il_jmax=il_ind(2,2,1) IF( ANY( il_ind(:,:,2) /= 0 ) )THEN CALL logger_error("CREATE BATHY EXTRACT: something wrong "//& & " find offset when extracting data") ENDIF !3- check grid coincidence CALL grid_check_coincidence( tl_file, td_coord, & & il_imin, il_imax, & & il_jmin, il_jmax, & & (/1, 1, 1/) ) !4- compute domain tl_dom=dom_init(tl_file, & & il_imin, il_imax, & & il_jmin, il_jmax) ! close file CALL iom_close(tl_file) !5- read bathymetry on domain (ugly way to do it, have to work on it) !5-1 init mpp structure tl_mpp=mpp_init(tl_file) CALL file_clean(tl_file) !5-2 get processor to be used CALL mpp_get_use( tl_mpp, tl_dom ) !5-3 open mpp files CALL iom_mpp_open(tl_mpp) !5-4 read variable on domain tl_var=iom_mpp_read_var(tl_mpp,TRIM(td_var%c_name),td_dom=tl_dom) !5-5 close mpp file CALL iom_mpp_close(tl_mpp) !6- add ghost cell CALL grid_add_ghost(tl_var,tl_dom%i_ighost,tl_dom%i_jghost) !7- check result IF( ANY( tl_var%t_dim(:)%l_use .AND. & & tl_var%t_dim(:)%i_len /= td_coord%t_dim(:)%i_len) )THEN CALL logger_debug("CREATE BATHY EXTRACT: "//& & "dimensoin of variable "//TRIM(td_var%c_name)//" "//& & TRIM(fct_str(tl_var%t_dim(1)%i_len))//","//& & TRIM(fct_str(tl_var%t_dim(2)%i_len))//","//& & TRIM(fct_str(tl_var%t_dim(3)%i_len))//","//& & TRIM(fct_str(tl_var%t_dim(4)%i_len)) ) CALL logger_debug("CREATE BATHY EXTRACT: "//& & "dimensoin of coordinate file "//& & TRIM(fct_str(td_coord%t_dim(1)%i_len))//","//& & TRIM(fct_str(td_coord%t_dim(2)%i_len))//","//& & TRIM(fct_str(td_coord%t_dim(3)%i_len))//","//& & TRIM(fct_str(td_coord%t_dim(4)%i_len)) ) CALL logger_fatal("CREATE BATHY EXTRACT: "//& & "dimensoin of extracted "//& & "variable and coordinate file dimension differ") ENDIF !8- add attribute to variable tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name))) CALL var_move_att(tl_var, tl_att) tl_att=att_init('src_i-indices',(/tl_dom%i_imin, tl_dom%i_imax/)) CALL var_move_att(tl_var, tl_att) tl_att=att_init('src_j-indices',(/tl_dom%i_jmin, tl_dom%i_jmax/)) CALL var_move_att(tl_var, tl_att) !9- save result create_bathy_extract=tl_var ! clean structure CALL var_clean(tl_var) CALL mpp_clean(tl_mpp) ENDIF END FUNCTION create_bathy_extract !> @endcode !------------------------------------------------------------------- !> @brief !> This subroutine !> !> @details !> !> @author J.Paul !> - Nov, 2013- Initial Version !> !> @param[in] td_var : variable structure !> @param[in] td_file : file structure !> @param[in] id_imin : i-direction lower left corner indice !> @param[in] id_imax : i-direction upper right corner indice !> @param[in] id_jmin : j-direction lower left corner indice !> @param[in] id_jmax : j-direction upper right corner indice !> @param[in] id_rho : table of refinement factor !------------------------------------------------------------------- !> @code FUNCTION create_bathy_get_var(td_var, td_file, & & id_imin, id_jmin, & & id_imax, id_jmax, & & id_offset, & & id_rho ) IMPLICIT NONE ! Argument TYPE(TVAR) , INTENT(IN) :: td_var TYPE(TFILE), INTENT(IN) :: td_file INTEGER(i4), INTENT(IN) :: id_imin INTEGER(i4), INTENT(IN) :: id_imax INTEGER(i4), INTENT(IN) :: id_jmin INTEGER(i4), INTENT(IN) :: id_jmax INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_offset INTEGER(i4), DIMENSION(:) , INTENT(IN) :: id_rho ! function TYPE(TVAR) :: create_bathy_get_var ! local variable INTEGER(i4) :: il_pivot INTEGER(i4) :: il_perio TYPE(TFILE) :: tl_file TYPE(TMPP) :: tl_mpp TYPE(TATT) :: tl_att TYPE(TVAR) :: tl_var TYPE(TDOM) :: tl_dom ! loop indices !---------------------------------------------------------------- IF( ANY(SHAPE(id_offset(:,:)) /= 2) )THEN CALL logger_error("CREATE BATHY GET VAR: invalid dimensio of "//& & "offset table") ENDIF !init tl_file=td_file !1- open file CALL iom_open(tl_file) ! get periodicity il_pivot=grid_get_pivot(tl_file) il_perio=grid_get_perio(tl_file,il_pivot) tl_file%i_perio=il_perio !2- compute domain tl_dom=dom_init(tl_file, & & id_imin, id_imax, & & id_jmin, id_jmax) CALL dom_print(tl_dom) print *,'id_offset ',id_offset(:,:) !3- close file CALL iom_close(tl_file) !4- add extra band (if possible) to compute interpolation CALL dom_add_extra(tl_dom) !5- read bathymetry on domain (ugly way to do it, have to work on it) !5-1 init mpp sturcutre tl_mpp=mpp_init(tl_file) CALL file_clean(tl_file) !5-2 get processor to be used CALL mpp_get_use( tl_mpp, tl_dom ) !5-3 open mpp files CALL iom_mpp_open(tl_mpp) !5-4 read variable value on domain tl_var=iom_mpp_read_var(tl_mpp,TRIM(td_var%c_name),td_dom=tl_dom) !5-5 close mpp files CALL iom_mpp_close(tl_mpp) !6- interpolate variable CALL create_bathy_interp(tl_var, id_rho(:), id_offset(:,:)) !7- remove extraband added to domain CALL dom_del_extra( tl_var, tl_dom, id_rho(:) ) !8- add ghost cell CALL grid_add_ghost(tl_var,tl_dom%i_ighost,tl_dom%i_jghost) !9- add attribute to variable tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name))) CALL var_move_att(tl_var, tl_att) tl_att=att_init('src_i-indices',(/tl_dom%i_imin, tl_dom%i_imax/)) CALL var_move_att(tl_var, tl_att) tl_att=att_init('src_j-indices',(/tl_dom%i_jmin, tl_dom%i_jmax/)) CALL var_move_att(tl_var, tl_att) !10- save result create_bathy_get_var=tl_var !11- clean structure CALL mpp_clean(tl_mpp) END FUNCTION create_bathy_get_var !> @endcode !------------------------------------------------------------------- !> @brief !> This subroutine !> !> @details !> !> @author J.Paul !> - Nov, 2013- Initial Version !> !> @param[in] !> @todo !------------------------------------------------------------------- !> @code SUBROUTINE create_bathy_interp( td_var, & & id_rho, & & id_offset, & & id_iext, id_jext) IMPLICIT NONE ! Argument TYPE(TVAR) , INTENT(INOUT) :: td_var INTEGER(i4), DIMENSION(:) , INTENT(IN ) :: id_rho INTEGER(i4), DIMENSION(:,:), INTENT(IN ) :: id_offset INTEGER(i4), INTENT(IN ), OPTIONAL :: id_iext INTEGER(i4), INTENT(IN ), OPTIONAL :: id_jext ! local variable TYPE(TVAR) :: tl_var TYPE(TVAR) :: tl_mask INTEGER(i1), DIMENSION(:,:,:,:), ALLOCATABLE :: bl_mask INTEGER(i4) :: il_iext INTEGER(i4) :: il_jext ! loop indices !---------------------------------------------------------------- ! copy variable tl_var=td_var !WARNING: two extrabands are required for cubic interpolation il_iext=3 IF( PRESENT(id_iext) ) il_iext=id_iext il_jext=3 IF( PRESENT(id_jext) ) il_jext=id_jext IF( il_iext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN CALL logger_warn("CREATE BATHY INTERP: at least extrapolation "//& & "on two points are required with cubic interpolation ") il_iext=2 ENDIF IF( il_jext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN CALL logger_warn("CREATE BATHY INTERP: at least extrapolation "//& & "on two points are required with cubic interpolation ") il_jext=2 ENDIF !1- work on mask !1-1 create mask ALLOCATE(bl_mask(tl_var%t_dim(1)%i_len, & & tl_var%t_dim(2)%i_len, & & tl_var%t_dim(3)%i_len, & & tl_var%t_dim(4)%i_len) ) bl_mask(:,:,:,:)=1 WHERE(tl_var%d_value(:,:,:,:)==tl_var%d_fill) bl_mask(:,:,:,:)=0 SELECT CASE(TRIM(tl_var%c_point)) CASE DEFAULT ! 'T' tl_mask=var_init('tmask', bl_mask(:,:,:,:), td_dim=tl_var%t_dim(:)) CASE('U') tl_mask=var_init('umask', bl_mask(:,:,:,:), td_dim=tl_var%t_dim(:)) CASE('V') tl_mask=var_init('vmask', bl_mask(:,:,:,:), td_dim=tl_var%t_dim(:)) CASE('F') tl_mask=var_init('fmask', bl_mask(:,:,:,:), td_dim=tl_var%t_dim(:)) END SELECT DEALLOCATE(bl_mask) !1-2 interpolate mask CALL interp_fill_value( tl_mask, id_rho(:), & & id_offset=id_offset(:,:) ) !2- work on variable !2-0 add extraband CALL extrap_add_extrabands(tl_var, il_iext, il_jext) !2-1 extrapolate variable CALL extrap_fill_value( tl_var, id_offset=id_offset(:,:), & & id_rho=id_rho(:), & & id_iext=il_iext, id_jext=il_jext ) !2-2 interpolate Bathymetry CALL interp_fill_value( tl_var, id_rho(:), & & id_offset=id_offset(:,:) ) !2-3 remove extraband CALL extrap_del_extrabands(tl_var, il_iext*id_rho(jp_I), il_jext*id_rho(jp_J)) !2-2-5 keep original mask WHERE( tl_mask%d_value(:,:,:,:) == 0 ) tl_var%d_value(:,:,:,:)=tl_var%d_fill END WHERE !3- save result td_var=tl_var ! clean variable structure CALL var_clean(tl_mask) CALL var_clean(tl_var) END SUBROUTINE create_bathy_interp !> @endcode END PROGRAM create_bathy