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 10251 for branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/create_restart.f90 – NEMO

Ignore:
Timestamp:
2018-10-29T15:20:26+01:00 (5 years ago)
Author:
kingr
Message:

Rolled back to r10247 - i.e., undid merge of pkg br and 3.6_stable br

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/create_restart.f90

    r10248 r10251  
    2525!> @endcode 
    2626!>     
    27 !> @note  
    28 !>    you could find a template of the namelist in templates directory. 
    29 !> 
    3027!>    create_restart.nam comprise 9 namelists:<br/> 
    3128!>       - logger namelist (namlog) 
    … …  
    4643!>       - cn_logfile   : log filename 
    4744!>       - cn_verbosity : verbosity ('trace','debug','info', 
    48 !> 'warning','error','fatal','none') 
     45!> 'warning','error','fatal') 
    4946!>       - in_maxerror  : maximum number of error allowed 
    5047!> 
    … …  
    6259!>       - cn_bathy1 : bathymetry file 
    6360!>       - in_perio1 : NEMO periodicity index 
     61!>       - in_extrap : number of land point to be extrapolated  
     62!>       before writing file 
    6463!> 
    6564!>    * _vertical grid namelist (namzgr)_:<br/> 
    … …  
    8483!>       - cn_varinfo : list of variable and extra information about request(s)  
    8584!>       to be used.<br/> 
    86 !>          each elements of *cn_varinfo* is a string character 
    87 !>          (separated by ',').<br/> 
     85!>          each elements of *cn_varinfo* is a string character.<br/> 
    8886!>          it is composed of the variable name follow by ':',  
    8987!>          then request(s) to be used on this variable.<br/>  
    9088!>          request could be: 
    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) 
     89!>             - interpolation method 
     90!>             - extrapolation method 
     91!>             - filter method 
     92!>             - > minimum value 
     93!>             - < maximum value 
    9894!> 
    9995!>             requests must be separated by ';'.<br/> 
    … …  
    10298!>          informations about available method could be find in @ref interp, 
    10399!>          @ref extrap and @ref filter.<br/> 
    104 !>          Example: 'votemper: int=linear; flt=hann; ext=dist_weight','vosaline: int=cubic' 
     100!>          Example: 'votemper: linear; hann; dist_weight','vosaline: cubic' 
    105101!>          @note  
    106102!>             If you do not specify a method which is required,  
    … …  
    140136!>    * _output namelist (namout)_:<br/> 
    141137!>       - cn_fileout : output file 
    142 !>       - ln_extrap : extrapolate land point or not 
     138!>       - in_nproc  : total number of processor to be used 
    143139!>       - in_niproc : i-direction number of processor 
    144140!>       - in_njproc : j-direction numebr of processor 
    145 !>       - in_nproc  : total number of processor to be used 
    146141!>       - cn_type   : output format ('dimg', 'cdf') 
    147142!> 
    … …  
    153148!> - offset computed considering grid point 
    154149!> - 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. 
    158150!> 
    159151!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    173165   USE iom                             ! I/O manager 
    174166   USE grid                            ! grid manager 
    175    USE vgrid                            ! vertical grid manager 
     167   USE vgrid                           ! vertical grid manager 
    176168   USE extrap                          ! extrapolation manager 
    177169   USE interp                          ! interpolation manager 
    … …  
    257249   CHARACTER(LEN=lc) :: cn_bathy1 = '' 
    258250   INTEGER(i4)       :: in_perio1 = -1 
     251   INTEGER(i4)       :: in_extrap = 0 
    259252 
    260253   !namzgr 
    … …  
    286279   ! namout 
    287280   CHARACTER(LEN=lc) :: cn_fileout = 'restart.nc'  
    288    LOGICAL           :: ln_extrap  = .FALSE. 
    289281   INTEGER(i4)       :: in_nproc   = 0 
    290282   INTEGER(i4)       :: in_niproc  = 0 
    … …  
    309301   &  cn_coord1,   &    !< coordinate file 
    310302   &  cn_bathy1,   &    !< bathymetry file 
    311    &  in_perio1         !< periodicity index 
     303   &  in_perio1,   &    !< periodicity index 
     304   &  in_extrap 
    312305  
    313306   NAMELIST /namzgr/ & 
    … …  
    339332   NAMELIST /namout/ &  !< output namlist 
    340333   &  cn_fileout, &     !< fine grid bathymetry file 
    341    &  ln_extrap,  &     !< extrapolate or not 
     334   &  in_nproc,   &     !< number of processor to be used 
    342335   &  in_niproc,  &     !< i-direction number of processor 
    343336   &  in_njproc,  &     !< j-direction numebr of processor 
    344    &  in_nproc,   &     !< number of processor to be used 
    345337   &  cn_type           !< output type format (dimg, cdf) 
    346338   !------------------------------------------------------------------- 
    … …  
    355347      CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec 
    356348   ENDIF 
    357  
     349    
    358350   ! read namelist 
    359351   INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist) 
    … …  
    442434   ! check 
    443435   ! check output file do not already exist 
    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 
     436   cl_fileout=file_rename(cn_fileout,1) 
    449437   INQUIRE(FILE=TRIM(cl_fileout), EXIST=ll_exist) 
    450438   IF( ll_exist )THEN 
    … …  
    480468   &                            il_rho(:) ) 
    481469 
    482    ! fine grid ghost cell 
     470   ! compute level 
     471   ALLOCATE(tl_level(ip_npoint)) 
     472   tl_level(:)=vgrid_get_level(tl_bathy1, cl_namelist ) 
     473 
     474   ! remove ghost cell 
    483475   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) 
    484482 
    485483   ! work on variables 
    … …  
    516514               tl_var(jvar) = create_restart_matrix( & 
    517515               &  tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj), tl_coord1, & 
    518                &  in_nlevel, il_xghost(:,:) ) 
    519  
    520                ! add ghost cell 
    521                CALL grid_add_ghost(tl_var(jvar), il_xghost(:,:)) 
     516               &  in_nlevel, tl_level(:) ) 
    522517 
    523518            ENDDO 
    … …  
    540535            ! open mpp file 
    541536            CALL iom_mpp_open(tl_mpp) 
    542  
    543537 
    544538            ! get or check depth value 
    … …  
    585579               DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 
    586580 
    587                   WRITE(*,'(2x,a,a)') "work on (extract) variable "//& 
     581                  WRITE(*,'(2x,a,a)') "work on variable "//& 
    588582                  &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 
    589583 
    … …  
    606600                  CALL att_clean(tl_att) 
    607601 
     602                  ! use mask 
     603                  CALL create_restart_mask(tl_var(jvar), tl_level(:)) 
     604 
    608605                  ! add ghost cell 
    609                   CALL grid_add_ghost(tl_var(jvar), tl_dom1%i_ghost(:,:)) 
     606                  CALL grid_add_ghost( tl_var(jvar), tl_dom1%i_ghost(:,:) ) 
    610607 
    611608               ENDDO 
    … …  
    634631               DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar 
    635632 
    636                   WRITE(*,'(2x,a,a)') "work on (interp) variable "//& 
     633                  WRITE(*,'(2x,a,a)') "work on variable "//& 
    637634                  &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name) 
    638635 
    … …  
    649646                  &                                   id_rho=il_rho(:), & 
    650647                  &                                   cd_point=TRIM(tl_var(jvar)%c_point)) 
     648                   
    651649 
    652650                  ! interpolate variable 
    653                   CALL create_restart_interp(tl_var(jvar), &  
     651                  CALL create_restart_interp(tl_var(jvar), tl_level(:), & 
    654652                  &                          il_rho(:), & 
    655653                  &                          id_offset=il_offset(:,:)) 
    … …  
    677675                  CALL att_clean(tl_att) 
    678676 
     677                  ! use mask 
     678                  CALL create_restart_mask(tl_var(jvar), tl_level(:)) 
     679 
    679680                  ! add ghost cell 
    680                   CALL grid_add_ghost(tl_var(jvar), il_xghost(:,:)) 
     681                  CALL grid_add_ghost( tl_var(jvar), il_xghost(:,:) ) 
     682 
     683 
    681684               ENDDO 
    682685 
    … …  
    702705   CALL mpp_clean(tl_coord0) 
    703706 
    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  
    713707   ! use additional request 
    714708   DO jvar=1,il_nvar 
    715709 
    716       ! change unit and apply factor 
    717       CALL var_chg_unit(tl_var(jvar)) 
    718  
    719710      ! forced min and max value 
    720711      CALL var_limit_value(tl_var(jvar)) 
    … …  
    723714      CALL filter_fill_value(tl_var(jvar)) 
    724715 
    725       IF( .NOT. ln_extrap )THEN 
    726          ! use mask 
    727          CALL create_restart_mask(tl_var(jvar), tl_level(:)) 
    728       ENDIF 
     716      ! extrapolate 
     717      CALL extrap_fill_value(tl_var(jvar), id_iext=in_extrap, & 
     718      &                                    id_jext=in_extrap, & 
     719      &                                    id_kext=in_extrap) 
    729720 
    730721   ENDDO 
    … …  
    733724   IF( in_niproc == 0 .AND. & 
    734725   &   in_njproc == 0 .AND. & 
    735    &   in_nproc == 0 )THEN 
     726   &   in_nproc  == 0 )THEN 
    736727      in_niproc = 1 
    737728      in_njproc = 1 
    … …  
    791782         CALL mpp_add_var(tl_mppout, tl_depth) 
    792783      ELSE 
    793          CALL logger_warn("CREATE RESTART: no value for depth variable.") 
     784         CALL logger_error("CREATE RESTART: no value for depth variable.") 
    794785      ENDIF 
    795786   ENDIF 
    … …  
    801792         CALL mpp_add_var(tl_mppout, tl_time) 
    802793      ELSE 
    803          CALL logger_warn("CREATE RESTART: no value for time variable.") 
     794         CALL logger_error("CREATE RESTART: no value for time variable.") 
    804795      ENDIF 
    805796   ENDIF 
    … …  
    807798 
    808799   ! add other variable 
    809    DO jvar=il_nvar,1,-1 
     800   DO jvar=1,il_nvar 
    810801      ! check if variable already add 
    811802      il_index=var_get_index(tl_mppout%t_proc(1)%t_var(:), tl_var(jvar)%c_name) 
    … …  
    816807   ENDDO 
    817808 
     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 
    818814   ! add some attribute 
    819815   tl_att=att_init("Created_by","SIREN create_restart") 
    … …  
    843839   ENDIF 
    844840 
    845    ! print 
    846    CALL mpp_print(tl_mppout) 
    847  
    848841   ! create file 
    849842   CALL iom_mpp_create(tl_mppout) 
    … …  
    854847   CALL iom_mpp_close(tl_mppout) 
    855848 
     849   ! print 
     850   CALL mpp_print(tl_mppout) 
     851 
    856852   ! clean 
    857853   CALL att_clean(tl_att) 
    858854   CALL var_clean(tl_var(:)) 
    859855   DEALLOCATE(tl_var) 
    860    IF( .NOT. ln_extrap )THEN 
    861       CALL var_clean(tl_level(:)) 
    862       DEALLOCATE(tl_level) 
    863    ENDIF 
     856   CALL var_clean(tl_level(:)) 
     857   DEALLOCATE(tl_level) 
    864858 
    865859   CALL mpp_clean(tl_mppout) 
    … …  
    882876   !> 
    883877   !> @author J.Paul 
    884    !> @date November, 2013 - Initial Version 
    885    !> @date June, 2015 
    886    !> - do not use level anymore  
     878   !> - November, 2013- Initial Version 
    887879   !> 
    888880   !> @param[in] td_var    variable structure  
    889881   !> @param[in] td_coord  coordinate file structure  
    890882   !> @param[in] id_nlevel number of vertical level   
    891    !> @param[in] id_xghost ghost cell array 
     883   !> @param[in] td_level  array of level on T,U,V,F point (variable structure)  
    892884   !> @return variable structure  
    893885   !------------------------------------------------------------------- 
    894    FUNCTION create_restart_matrix(td_var, td_coord, id_nlevel, id_xghost) 
     886   FUNCTION create_restart_matrix(td_var, td_coord, id_nlevel, td_level) 
    895887      IMPLICIT NONE 
    896888      ! Argument 
    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 
     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 
    901893 
    902894      ! function 
    … …  
    907899      INTEGER(i4)      , DIMENSION(3)                    :: il_size 
    908900      INTEGER(i4)      , DIMENSION(3)                    :: il_rest 
     901      INTEGER(i4)      , DIMENSION(2,2)                  :: il_xghost 
    909902 
    910903      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_ishape 
    … …  
    922915      !---------------------------------------------------------------- 
    923916 
     917      ! look for ghost cell 
     918      il_xghost(:,:)=grid_get_ghost( td_coord ) 
     919 
    924920      ! write value on grid 
    925921      ! get matrix dimension 
    … …  
    933929 
    934930      ! remove ghost cell 
    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 
     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 
    937933 
    938934      ! split output domain in N subdomain depending of matrix dimension  
    … …  
    996992      DEALLOCATE(dl_value) 
    997993 
     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(:,:) ) 
     999 
    9981000      ! clean  
    9991001      DEALLOCATE(il_ishape) 
    … …  
    10071009   !>  
    10081010   !> @author J.Paul 
    1009    !> @date November, 2013 - Initial Version 
     1011   !> - November, 2013- Initial Version 
    10101012   !> 
    10111013   !> @param[inout] td_var variable structure 
    … …  
    10691071   !>  
    10701072   !> @author J.Paul 
    1071    !> @date November, 2013 - Initial Version 
    1072    !> @date June, 2015 
    1073    !> - do not use level anymore (for extrapolation) 
     1073   !> - Nov, 2013- Initial Version 
    10741074   !> 
    10751075   !> @param[inout] td_var    variable structure  
     1076   !> @param[inout] td_level  fine grid level, array of variable structure 
    10761077   !> @param[in] id_rho       array of refinment factor 
    10771078   !> @param[in] id_offset    array of offset between fine and coarse grid 
    … …  
    10791080   !> @param[in] id_jext      j-direction size of extra bands (default=im_minext) 
    10801081   !------------------------------------------------------------------- 
    1081    SUBROUTINE create_restart_interp( td_var, &  
     1082   SUBROUTINE create_restart_interp( td_var, td_level,& 
    10821083   &                                 id_rho,          & 
    10831084   &                                 id_offset,       & 
    … …  
    10881089      ! Argument 
    10891090      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var 
     1091      TYPE(TVAR) , DIMENSION(:)  , INTENT(INOUT) :: td_level 
    10901092      INTEGER(i4), DIMENSION(:)  , INTENT(IN   ) :: id_rho 
    10911093      INTEGER(i4), DIMENSION(:,:), INTENT(IN   ) :: id_offset 
    … …  
    11171119         il_jext=2 
    11181120      ENDIF 
     1121 
    11191122      ! work on variable 
    11201123      ! add extraband 
    … …  
    11221125 
    11231126      ! extrapolate variable 
    1124       CALL extrap_fill_value( td_var ) 
     1127      CALL extrap_fill_value( td_var, td_level(:),    & 
     1128      &                               id_offset(:,:), & 
     1129      &                               id_rho(:),      & 
     1130      &                               id_iext=il_iext, id_jext=il_jext ) 
    11251131 
    11261132      ! interpolate variable 
    … …  
    11401146   !> 
    11411147   !> @author J.Paul 
    1142    !> @date November, 2014 - Initial Version 
     1148   !> - November, 2014- Initial Version 
    11431149   !> 
    11441150   !> @param[in] td_mpp       mpp structure 
    … …  
    11911197   !> 
    11921198   !> @author J.Paul 
    1193    !> @date November, 2014 - Initial Version 
     1199   !> - November, 2014- Initial Version 
    11941200   !> 
    11951201   !> @param[in] td_mpp      mpp structure 
    … …  
    12141220 
    12151221      ! get or check depth value 
    1216  
    12171222      IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN 
    12181223 
Note: See TracChangeset for help on using the changeset viewer.