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 5609 for trunk/NEMOGCM/TOOLS/SIREN/src/create_restart.f90 – NEMO

Ignore:
Timestamp:
2015-07-17T17:42:15+02:00 (9 years ago)
Author:
jpaul
Message:

commit changes/bugfix/... for SIREN; see ticket #1580

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMOGCM/TOOLS/SIREN/src/create_restart.f90

    r5037 r5609  
    2525!> @endcode 
    2626!>     
     27!> @note  
     28!>    you could find a template of the namelist in templates directory. 
     29!> 
    2730!>    create_restart.nam comprise 9 namelists:<br/> 
    2831!>       - logger namelist (namlog) 
    … …  
    4346!>       - cn_logfile   : log filename 
    4447!>       - cn_verbosity : verbosity ('trace','debug','info', 
    45 !> 'warning','error','fatal') 
     48!> 'warning','error','fatal','none') 
    4649!>       - in_maxerror  : maximum number of error allowed 
    4750!> 
    … …  
    5962!>       - cn_bathy1 : bathymetry file 
    6063!>       - in_perio1 : NEMO periodicity index 
    61 !>       - in_extrap : number of land point to be extrapolated  
    62 !>       before writing file 
    6364!> 
    6465!>    * _vertical grid namelist (namzgr)_:<br/> 
    … …  
    8384!>       - cn_varinfo : list of variable and extra information about request(s)  
    8485!>       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/> 
    8688!>          it is composed of the variable name follow by ':',  
    8789!>          then request(s) to be used on this variable.<br/>  
    8890!>          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) 
    9498!> 
    9599!>             requests must be separated by ';'.<br/> 
    … …  
    98102!>          informations about available method could be find in @ref interp, 
    99103!>          @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' 
    101105!>          @note  
    102106!>             If you do not specify a method which is required,  
    … …  
    136140!>    * _output namelist (namout)_:<br/> 
    137141!>       - cn_fileout : output file 
    138 !>       - in_nproc  : total number of processor to be used 
     142!>       - ln_extrap : extrapolate land point or not 
    139143!>       - in_niproc : i-direction number of processor 
    140144!>       - in_njproc : j-direction numebr of processor 
     145!>       - in_nproc  : total number of processor to be used 
    141146!>       - cn_type   : output format ('dimg', 'cdf') 
    142147!> 
    … …  
    148153!> - offset computed considering grid point 
    149154!> - 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. 
    150158!> 
    151159!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    165173   USE iom                             ! I/O manager 
    166174   USE grid                            ! grid manager 
    167    USE vgrid                           ! vertical grid manager 
     175   USE vgrid                            ! vertical grid manager 
    168176   USE extrap                          ! extrapolation manager 
    169177   USE interp                          ! interpolation manager 
    … …  
    249257   CHARACTER(LEN=lc) :: cn_bathy1 = '' 
    250258   INTEGER(i4)       :: in_perio1 = -1 
    251    INTEGER(i4)       :: in_extrap = 0 
    252259 
    253260   !namzgr 
    … …  
    279286   ! namout 
    280287   CHARACTER(LEN=lc) :: cn_fileout = 'restart.nc'  
     288   LOGICAL           :: ln_extrap  = .FALSE. 
    281289   INTEGER(i4)       :: in_nproc   = 0 
    282290   INTEGER(i4)       :: in_niproc  = 0 
    … …  
    301309   &  cn_coord1,   &    !< coordinate file 
    302310   &  cn_bathy1,   &    !< bathymetry file 
    303    &  in_perio1,   &    !< periodicity index 
    304    &  in_extrap 
     311   &  in_perio1         !< periodicity index 
    305312  
    306313   NAMELIST /namzgr/ & 
    … …  
    332339   NAMELIST /namout/ &  !< output namlist 
    333340   &  cn_fileout, &     !< fine grid bathymetry file 
    334    &  in_nproc,   &     !< number of processor to be used 
     341   &  ln_extrap,  &     !< extrapolate or not 
    335342   &  in_niproc,  &     !< i-direction number of processor 
    336343   &  in_njproc,  &     !< j-direction numebr of processor 
     344   &  in_nproc,   &     !< number of processor to be used 
    337345   &  cn_type           !< output type format (dimg, cdf) 
    338346   !------------------------------------------------------------------- 
    … …  
    347355      CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec 
    348356   ENDIF 
    349     
     357 
    350358   ! read namelist 
    351359   INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist) 
    … …  
    434442   ! check 
    435443   ! 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 
    437449   INQUIRE(FILE=TRIM(cl_fileout), EXIST=ll_exist) 
    438450   IF( ll_exist )THEN 
    … …  
    468480   &                            il_rho(:) ) 
    469481 
    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 
    475483   il_xghost(:,:)=grid_get_ghost(tl_bathy1) 
    476    DO ji=1,ip_npoint 
    477       CALL grid_del_ghost(tl_level(ji), il_xghost(:,:)) 
    478    ENDDO 
    479  
    480    ! clean 
    481    CALL mpp_clean(tl_bathy1) 
    482484 
    483485   ! work on variables 
    … …  
    514516               tl_var(jvar) = create_restart_matrix( & 
    515517               &  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(:,:)) 
    517522 
    518523            ENDDO 
    … …  
    535540            ! open mpp file 
    536541            CALL iom_mpp_open(tl_mpp) 
     542 
    537543 
    538544            ! get or check depth value 
    … …  
    579585               DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 
    580586 
    581                   WRITE(*,'(2x,a,a)') "work on variable "//& 
     587                  WRITE(*,'(2x,a,a)') "work on (extract) variable "//& 
    582588                  &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 
    583589 
    … …  
    600606                  CALL att_clean(tl_att) 
    601607 
    602                   ! use mask 
    603                   CALL create_restart_mask(tl_var(jvar), tl_level(:)) 
    604  
    605608                  ! 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(:,:)) 
    607610 
    608611               ENDDO 
    … …  
    631634               DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 
    632635 
    633                   WRITE(*,'(2x,a,a)') "work on variable "//& 
     636                  WRITE(*,'(2x,a,a)') "work on (interp) variable "//& 
    634637                  &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 
    635638 
    … …  
    646649                  &                                   id_rho=il_rho(:), & 
    647650                  &                                   cd_point=TRIM(tl_var(jvar)%c_point)) 
    648                    
    649651 
    650652                  ! interpolate variable 
    651                   CALL create_restart_interp(tl_var(jvar), tl_level(:), & 
     653                  CALL create_restart_interp(tl_var(jvar), &  
    652654                  &                          il_rho(:), & 
    653655                  &                          id_offset=il_offset(:,:)) 
    … …  
    675677                  CALL att_clean(tl_att) 
    676678 
    677                   ! use mask 
    678                   CALL create_restart_mask(tl_var(jvar), tl_level(:)) 
    679  
    680679                  ! 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(:,:)) 
    684681               ENDDO 
    685682 
    … …  
    705702   CALL mpp_clean(tl_coord0) 
    706703 
     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 
    707713   ! use additional request 
    708714   DO jvar=1,il_nvar 
    709715 
     716      ! change unit and apply factor 
     717      CALL var_chg_unit(tl_var(jvar)) 
     718 
    710719      ! forced min and max value 
    711720      CALL var_limit_value(tl_var(jvar)) 
    … …  
    714723      CALL filter_fill_value(tl_var(jvar)) 
    715724 
    716       ! extrapolate 
    717       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 
    720729 
    721730   ENDDO 
    … …  
    724733   IF( in_niproc == 0 .AND. & 
    725734   &   in_njproc == 0 .AND. & 
    726    &   in_nproc  == 0 )THEN 
     735   &   in_nproc == 0 )THEN 
    727736      in_niproc = 1 
    728737      in_njproc = 1 
    … …  
    782791         CALL mpp_add_var(tl_mppout, tl_depth) 
    783792      ELSE 
    784          CALL logger_error("CREATE RESTART: no value for depth variable.") 
     793         CALL logger_warn("CREATE RESTART: no value for depth variable.") 
    785794      ENDIF 
    786795   ENDIF 
    … …  
    792801         CALL mpp_add_var(tl_mppout, tl_time) 
    793802      ELSE 
    794          CALL logger_error("CREATE RESTART: no value for time variable.") 
     803         CALL logger_warn("CREATE RESTART: no value for time variable.") 
    795804      ENDIF 
    796805   ENDIF 
    … …  
    798807 
    799808   ! add other variable 
    800    DO jvar=1,il_nvar 
     809   DO jvar=il_nvar,1,-1 
    801810      ! check if variable already add 
    802811      il_index=var_get_index(tl_mppout%t_proc(1)%t_var(:), tl_var(jvar)%c_name) 
    … …  
    807816   ENDDO 
    808817 
    809 !   DO ji=1,4 
    810 !      CALL grid_add_ghost( tl_level(ji), il_xghost(:,:) ) 
    811 !      CALL var_clean(tl_level(ji)) 
    812 !   ENDDO 
    813  
    814818   ! add some attribute 
    815819   tl_att=att_init("Created_by","SIREN create_restart") 
    … …  
    839843   ENDIF 
    840844 
     845   ! print 
     846   CALL mpp_print(tl_mppout) 
     847 
    841848   ! create file 
    842849   CALL iom_mpp_create(tl_mppout) 
    … …  
    847854   CALL iom_mpp_close(tl_mppout) 
    848855 
    849    ! print 
    850    CALL mpp_print(tl_mppout) 
    851  
    852856   ! clean 
    853857   CALL att_clean(tl_att) 
    854858   CALL var_clean(tl_var(:)) 
    855859   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 
    858864 
    859865   CALL mpp_clean(tl_mppout) 
    … …  
    876882   !> 
    877883   !> @author J.Paul 
    878    !> - November, 2013- Initial Version 
     884   !> @date November, 2013- Initial Version 
     885   !> @date June, 2015 
     886   !> - do not use level anymore  
    879887   !> 
    880888   !> @param[in] td_var    variable structure  
    881889   !> @param[in] td_coord  coordinate file structure  
    882890   !> @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 
    884892   !> @return variable structure  
    885893   !------------------------------------------------------------------- 
    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) 
    887895      IMPLICIT NONE 
    888896      ! Argument 
    889       TYPE(TVAR)              , INTENT(IN) :: td_var 
    890       TYPE(TMPP)              , INTENT(IN) :: td_coord 
    891       INTEGER(i4)             , INTENT(IN) :: id_nlevel 
    892       TYPE(TVAR), DIMENSION(:), INTENT(IN) :: td_level 
     897      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 
    893901 
    894902      ! function 
    … …  
    899907      INTEGER(i4)      , DIMENSION(3)                    :: il_size 
    900908      INTEGER(i4)      , DIMENSION(3)                    :: il_rest 
    901       INTEGER(i4)      , DIMENSION(2,2)                  :: il_xghost 
    902909 
    903910      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_ishape 
    … …  
    915922      !---------------------------------------------------------------- 
    916923 
    917       ! look for ghost cell 
    918       il_xghost(:,:)=grid_get_ghost( td_coord ) 
    919  
    920924      ! write value on grid 
    921925      ! get matrix dimension 
    … …  
    929933 
    930934      ! remove ghost cell 
    931       tl_dim(jp_I)%i_len=tl_dim(jp_I)%i_len - SUM(il_xghost(jp_I,:))*ip_ghost 
    932       tl_dim(jp_J)%i_len=tl_dim(jp_J)%i_len - SUM(il_xghost(jp_J,:))*ip_ghost 
     935      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 
    933937 
    934938      ! split output domain in N subdomain depending of matrix dimension  
    … …  
    991995 
    992996      DEALLOCATE(dl_value) 
    993  
    994       ! use mask 
    995       CALL create_restart_mask(create_restart_matrix, td_level(:)) 
    996  
    997       ! add ghost cell 
    998       CALL grid_add_ghost( create_restart_matrix, il_xghost(:,:) ) 
    999997 
    1000998      ! clean  
    … …  
    10711069   !>  
    10721070   !> @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) 
    10741074   !> 
    10751075   !> @param[inout] td_var    variable structure  
    1076    !> @param[inout] td_level  fine grid level, array of variable structure 
    10771076   !> @param[in] id_rho       array of refinment factor 
    10781077   !> @param[in] id_offset    array of offset between fine and coarse grid 
    … …  
    10801079   !> @param[in] id_jext      j-direction size of extra bands (default=im_minext) 
    10811080   !------------------------------------------------------------------- 
    1082    SUBROUTINE create_restart_interp( td_var, td_level,& 
     1081   SUBROUTINE create_restart_interp( td_var, &  
    10831082   &                                 id_rho,          & 
    10841083   &                                 id_offset,       & 
    … …  
    10891088      ! Argument 
    10901089      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var 
    1091       TYPE(TVAR) , DIMENSION(:)  , INTENT(INOUT) :: td_level 
    10921090      INTEGER(i4), DIMENSION(:)  , INTENT(IN   ) :: id_rho 
    10931091      INTEGER(i4), DIMENSION(:,:), INTENT(IN   ) :: id_offset 
    … …  
    11191117         il_jext=2 
    11201118      ENDIF 
    1121  
    11221119      ! work on variable 
    11231120      ! add extraband 
    … …  
    11251122 
    11261123      ! 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 ) 
    11311125 
    11321126      ! interpolate variable 
    … …  
    12201214 
    12211215      ! get or check depth value 
     1216 
    12221217      IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN 
    12231218 
Note: See TracChangeset for help on using the changeset viewer.