New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 5951 for branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/TOOLS/SIREN/src/create_coord.f90 – NEMO

Ignore:
Timestamp:
2015-11-30T12:48:01+01:00 (8 years ago)
Author:
timgraham
Message:

Merged trunk r5936 into branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/TOOLS/SIREN/src/create_coord.f90

    r5950 r5951  
    2424!> @endcode 
    2525!>     
     26!> @note  
     27!>    you could find a template of the namelist in templates directory. 
     28!> 
    2629!>    create_coord.nam comprise 6 namelists:<br/> 
    2730!>       - logger namelist (namlog) 
     
    3942!>       - cn_logfile   : log filename 
    4043!>       - cn_verbosity : verbosity ('trace','debug','info', 
    41 !> 'warning','error','fatal') 
     44!> 'warning','error','fatal','none') 
    4245!>       - in_maxerror  : maximum number of error allowed 
    4346!> 
     
    5457!>       - cn_varinfo : list of variable and extra information about request(s) 
    5558!> to be used.<br/> 
    56 !>          each elements of *cn_varinfo* is a string character.<br/> 
     59!>          each elements of *cn_varinfo* is a string character  
     60!>          (separated by ',').<br/> 
    5761!>          it is composed of the variable name follow by ':',  
    5862!>          then request(s) to be used on this variable.<br/>  
    5963!>          request could be: 
    60 !>             - interpolation method 
    61 !>             - extrapolation method 
    62 !>             - filter method 
     64!>             - int = interpolation method 
     65!>             - ext = extrapolation method 
     66!>             - flt = filter method 
    6367!>  
    6468!>                requests must be separated by ';' .<br/> 
     
    6872!>          @ref extrap and @ref filter modules.<br/> 
    6973!> 
    70 !>          Example: 'votemper: linear; hann(2,3); dist_weight',  
    71 !>          'vosaline: cubic'<br/> 
     74!>          Example: 'votemper: int=linear; flt=hann(2,3); ext=dist_weight',  
     75!>          'vosaline: int=cubic'<br/> 
    7276!>          @note  
    7377!>             If you do not specify a method which is required,  
     
    9094!> 
    9195!>    * _output namelist (namout)_: 
    92 !>       - cn_fileout : output coordinate file 
     96!>       - cn_fileout : output coordinate file name 
    9397!> 
    9498!> @author J.Paul 
     
    152156   TYPE(TFILE)                                          :: tl_fileout 
    153157 
    154    ! check  
    155 !   INTEGER(i4)                                          :: il_imin0 
    156 !   INTEGER(i4)                                          :: il_imax0 
    157 !   INTEGER(i4)                                          :: il_jmin0 
    158 !   INTEGER(i4)                                          :: il_jmax0 
    159 !   INTEGER(i4)      , DIMENSION(2,2)                    :: il_ind2 
    160 !   TYPE(TMPP)                                           :: tl_mppout 
    161  
    162158   ! loop indices 
    163159   INTEGER(i4) :: ji 
     
    165161 
    166162   ! namelist variable 
     163   ! namlog 
    167164   CHARACTER(LEN=lc) :: cn_logfile = 'create_coord.log'  
    168165   CHARACTER(LEN=lc) :: cn_verbosity = 'warning'  
    169166   INTEGER(i4)       :: in_maxerror = 5 
    170167 
     168   ! namcfg 
     169   CHARACTER(LEN=lc) :: cn_varcfg = '../cfg/variable.cfg'  
     170 
     171   ! namcrs 
    171172   CHARACTER(LEN=lc) :: cn_coord0 = ''  
    172173   INTEGER(i4)       :: in_perio0 = -1 
    173174 
    174    CHARACTER(LEN=lc) :: cn_varcfg = '../cfg/variable.cfg'  
    175  
     175   ! namvar 
    176176   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = '' 
    177177 
     178   !namnst 
    178179   INTEGER(i4)       :: in_imin0 = 0 
    179180   INTEGER(i4)       :: in_imax0 = 0 
     
    183184   INTEGER(i4)       :: in_rhoj  = 1 
    184185 
     186   !namout 
    185187   CHARACTER(LEN=lc) :: cn_fileout= 'coord_fine.nc' 
    186188   !------------------------------------------------------------------- 
     
    305307 
    306308      il_offset(:,:,:)=create_coord_get_offset(il_rho(:)) 
    307  
    308309   ENDIF 
    309310 
     
    348349      CALL dom_del_extra( tl_var(ji), tl_dom, il_rho(:), .true. ) 
    349350 
    350       ! do not add ghost cell.  
    351       ! ghost cell already replace by value for coordinates  
    352       ! CALL grid_add_ghost(tl_var(ji),tl_dom%i_ghost(:,:)) 
    353  
    354351      ! filter 
    355352      CALL filter_fill_value(tl_var(ji))       
     
    375372 
    376373   ! add variables 
    377    DO ji=1,il_nvar 
     374   DO ji=il_nvar,1,-1 
    378375      CALL file_add_var(tl_fileout, tl_var(ji)) 
     376      CALL var_clean(tl_var(ji)) 
    379377   ENDDO 
    380  
    381    ! recompute some attribute 
    382378 
    383379   ! add some attribute 
     
    440436 
    441437   CALL file_clean(tl_fileout) 
    442  
    443 !   ! check domain 
    444 !   tl_coord0=mpp_init( file_init(TRIM(cn_coord0)), id_perio=in_perio0) 
    445 !   tl_mppout=mpp_init( file_init(TRIM(cn_fileout)) ) 
    446 !   CALL grid_get_info(tl_coord0) 
    447 !   CALL iom_mpp_open(tl_mppout) 
    448 ! 
    449 !   il_ind2(:,:)=grid_get_coarse_index( tl_coord0, tl_mppout, & 
    450 !   &                                   id_rho=il_rho(:) ) 
    451 ! 
    452 !   il_imin0=il_ind2(1,1) ; il_imax0=il_ind2(1,2) 
    453 !   il_jmin0=il_ind2(2,1) ; il_jmax0=il_ind2(2,2) 
    454 ! 
    455 !   IF( il_imin0 /= in_imin0 .OR. & 
    456 !   &   il_imax0 /= in_imax0 .OR. & 
    457 !   &   il_jmin0 /= in_jmin0 .OR. & 
    458 !   &   il_jmax0 /= in_jmax0 )THEN 
    459 !      CALL logger_debug("CREATE COORD: output indices ("//& 
    460 !      &                 TRIM(fct_str(il_imin0))//","//& 
    461 !      &                 TRIM(fct_str(il_imax0))//") ("//& 
    462 !      &                 TRIM(fct_str(il_jmin0))//","//& 
    463 !      &                 TRIM(fct_str(il_jmax0))//")" )  
    464 !      CALL logger_debug("CREATE COORD: input indices ("//& 
    465 !      &                 TRIM(fct_str(in_imin0))//","//& 
    466 !      &                 TRIM(fct_str(in_imax0))//") ("//& 
    467 !      &                 TRIM(fct_str(in_jmin0))//","//& 
    468 !      &                 TRIM(fct_str(in_jmax0))//")" )  
    469 !      CALL logger_fatal("CREATE COORD: output domain not confrom "//& 
    470 !      &                 "with input indices") 
    471 !   ENDIF 
    472 ! 
    473 !   CALL iom_mpp_close(tl_coord0) 
    474 !   CALL iom_mpp_close(tl_mppout) 
    475438 
    476439   ! close log file 
     
    539502   !> @param[in] id_iext   number of points to be extrapolated in i-direction 
    540503   !> @param[in] id_jext   number of points to be extrapolated in j-direction 
     504   !> 
     505   !> @todo check if mask is really needed 
    541506   !------------------------------------------------------------------- 
    542507   SUBROUTINE create_coord_interp( td_var,          & 
     
    626591 
    627592         ! extrapolate variable 
    628          CALL extrap_fill_value( td_var, id_iext=il_iext, id_jext=il_jext ) 
     593         CALL extrap_fill_value( td_var ) 
    629594 
    630595         ! interpolate variable 
Note: See TracChangeset for help on using the changeset viewer.