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 12080 for utils/tools/SIREN/src/boundary.f90 – NEMO

Ignore:
Timestamp:
2019-12-06T10:30:14+01:00 (4 years ago)
Author:
jpaul
Message:

update nemo trunk

File:
1 edited

Legend:

Unmodified
Added
Removed

  • utils/tools/SIREN/src/boundary.f90

    r9598 r12080  
    22! NEMO system team, System and Interface for oceanic RElocable Nesting 
    33!---------------------------------------------------------------------- 
    4 ! 
    5 ! MODULE: boundary 
    64! 
    75! DESCRIPTION: 
    … …  
    106104!> 
    107105!> @author J.Paul 
    108 ! REVISION HISTORY: 
     106!> 
    109107!> @date November, 2013 - Initial Version 
    110108!> @date September, 2014  
    … …  
    119117!> @todo add schematic to boundary structure description 
    120118!>  
    121 !> @note Software governed by the CeCILL licence     (./LICENSE) 
     119!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    122120!---------------------------------------------------------------------- 
    123121MODULE boundary 
     122 
    124123   USE netcdf                          ! nf90 library                            
    125124   USE global                          ! global parameter 
    … …  
    131130 
    132131   IMPLICIT NONE 
     132 
    133133   ! NOTE_avoid_public_variables_if_possible 
    134134 
    … …  
    220220 
    221221CONTAINS 
     222   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     223   FUNCTION boundary__copy_arr(td_bdy) & 
     224         & RESULT (tf_bdy) 
    222225   !------------------------------------------------------------------- 
    223226   !> @brief 
    … …  
    240243   !> @return copy of input array of boundary structure  
    241244   !------------------------------------------------------------------- 
    242    FUNCTION boundary__copy_arr( td_bdy ) 
     245 
    243246      IMPLICIT NONE 
     247 
    244248      ! Argument 
    245       TYPE(TBDY), DIMENSION(:), INTENT(IN)  :: td_bdy 
     249      TYPE(TBDY), DIMENSION(:)   , INTENT(IN) :: td_bdy 
     250 
    246251      ! function 
    247       TYPE(TBDY), DIMENSION(SIZE(td_bdy(:))) :: boundary__copy_arr 
     252      TYPE(TBDY), DIMENSION(SIZE(td_bdy(:)))  :: tf_bdy 
    248253 
    249254      ! local variable 
    … …  
    253258 
    254259      DO jk=1,SIZE(td_bdy(:)) 
    255          boundary__copy_arr(jk)=boundary_copy(td_bdy(jk)) 
     260         tf_bdy(jk)=boundary_copy(td_bdy(jk)) 
    256261      ENDDO 
    257262 
    258263   END FUNCTION boundary__copy_arr 
     264   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     265   FUNCTION boundary__copy_unit(td_bdy) & 
     266         & RESULT (tf_bdy) 
    259267   !------------------------------------------------------------------- 
    260268   !> @brief 
    … …  
    277285   !> @return copy of input boundary structure 
    278286   !------------------------------------------------------------------- 
    279    FUNCTION boundary__copy_unit( td_bdy ) 
     287 
    280288      IMPLICIT NONE 
     289 
    281290      ! Argument 
    282291      TYPE(TBDY), INTENT(IN)  :: td_bdy 
     292 
    283293      ! function 
    284       TYPE(TBDY) :: boundary__copy_unit 
     294      TYPE(TBDY)              :: tf_bdy 
    285295 
    286296      ! local variable 
    … …  
    290300 
    291301      ! copy variable name, id, .. 
    292       boundary__copy_unit%c_card     = TRIM(td_bdy%c_card) 
    293       boundary__copy_unit%i_nseg     = td_bdy%i_nseg 
    294       boundary__copy_unit%l_use      = td_bdy%l_use 
     302      tf_bdy%c_card     = TRIM(td_bdy%c_card) 
     303      tf_bdy%i_nseg     = td_bdy%i_nseg 
     304      tf_bdy%l_use      = td_bdy%l_use 
    295305 
    296306      ! copy segment 
    297       IF( ASSOCIATED(boundary__copy_unit%t_seg) )THEN 
    298          CALL seg__clean(boundary__copy_unit%t_seg(:)) 
    299          DEALLOCATE(boundary__copy_unit%t_seg) 
     307      IF( ASSOCIATED(tf_bdy%t_seg) )THEN 
     308         CALL seg__clean(tf_bdy%t_seg(:)) 
     309         DEALLOCATE(tf_bdy%t_seg) 
    300310      ENDIF 
    301       IF( ASSOCIATED(td_bdy%t_seg) .AND. boundary__copy_unit%i_nseg > 0 )THEN 
    302          ALLOCATE( boundary__copy_unit%t_seg(boundary__copy_unit%i_nseg) ) 
    303          DO ji=1,boundary__copy_unit%i_nseg 
    304             boundary__copy_unit%t_seg(ji)=td_bdy%t_seg(ji) 
     311      IF( ASSOCIATED(td_bdy%t_seg) .AND. tf_bdy%i_nseg > 0 )THEN 
     312         ALLOCATE( tf_bdy%t_seg(tf_bdy%i_nseg) ) 
     313         DO ji=1,tf_bdy%i_nseg 
     314            tf_bdy%t_seg(ji)=td_bdy%t_seg(ji) 
    305315         ENDDO 
    306316      ENDIF 
    307317 
    308318   END FUNCTION boundary__copy_unit 
     319   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     320   SUBROUTINE boundary__clean_unit(td_bdy) 
    309321   !------------------------------------------------------------------- 
    310322   !> @brief This subroutine clean boundary structure 
    … …  
    312324   !> @author J.Paul 
    313325   !> @date November, 2013 - Initial Version 
     326   !> @date January, 2019 
     327   !> - nullify segment structure inside boundary structure  
    314328   ! 
    315329   !> @param[inout] td_bdy boundary strucutre 
    316330   !------------------------------------------------------------------- 
    317    SUBROUTINE boundary__clean_unit( td_bdy ) 
     331 
    318332      IMPLICIT NONE 
     333 
    319334      ! Argument 
    320335      TYPE(TBDY), INTENT(INOUT) :: td_bdy 
    … …  
    334349         CALL seg__clean(td_bdy%t_seg(:) ) 
    335350         DEALLOCATE( td_bdy%t_seg ) 
     351         NULLIFY(td_bdy%t_seg) 
    336352      ENDIF 
    337353 
    … …  
    340356 
    341357   END SUBROUTINE boundary__clean_unit 
     358   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     359   SUBROUTINE boundary__clean_arr(td_bdy) 
    342360   !------------------------------------------------------------------- 
    343361   !> @brief This subroutine clean array of boundary structure 
    … …  
    348366   !> @param[inout] td_bdy boundary strucutre 
    349367   !------------------------------------------------------------------- 
    350    SUBROUTINE boundary__clean_arr( td_bdy ) 
     368 
    351369      IMPLICIT NONE 
     370 
    352371      ! Argument 
    353372      TYPE(TBDY), DIMENSION(:), INTENT(INOUT) :: td_bdy 
    … …  
    363382 
    364383   END SUBROUTINE boundary__clean_arr 
     384   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     385   FUNCTION boundary_set_filename(cd_file, cd_card, id_seg, cd_date) & 
     386         &  RESULT (cf_file) 
    365387   !-------------------------------------------------------------------  
    366388   !> @brief This function put cardinal name and date inside file name. 
    … …  
    389411   !> @return file name with cardinal name inside 
    390412   !-------------------------------------------------------------------  
    391    FUNCTION boundary_set_filename(cd_file, cd_card, id_seg, cd_date)  
     413 
    392414      IMPLICIT NONE  
     415 
    393416      ! Argument 
    394417      CHARACTER(LEN=*), INTENT(IN) :: cd_file 
    … …  
    398421 
    399422      ! function  
    400       CHARACTER(LEN=lc) :: boundary_set_filename 
     423      CHARACTER(LEN=lc)            :: cf_file 
    401424 
    402425      ! local variable  
    … …  
    415438      !----------------------------------------------------------------  
    416439      ! init 
    417       boundary_set_filename='' 
     440      cf_file='' 
    418441 
    419442      IF( TRIM(cd_file) /= '' .AND. TRIM(cd_card) /= '' )THEN 
    … …  
    455478         ENDIF 
    456479 
    457          boundary_set_filename=TRIM(cl_dirname)//"/"//TRIM(cl_name) 
     480         cf_file=TRIM(cl_dirname)//"/"//TRIM(cl_name) 
    458481      ELSE 
    459482         CALL logger_error("BOUNDARY SET FILENAME: file or cardinal name "//& 
    … …  
    462485  
    463486   END FUNCTION boundary_set_filename  
     487   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     488   FUNCTION boundary__init_wrapper(td_var,                               & 
     489         &                         ld_north, ld_south, ld_east, ld_west, & 
     490         &                         cd_north, cd_south, cd_east, cd_west, & 
     491         &                         ld_oneseg) & 
     492         &  RESULT (tf_bdy) 
    464493   !-------------------------------------------------------------------  
    465494   !> @brief This function initialise a boundary structure. 
    … …  
    503532   !> @return boundary structure 
    504533   !-------------------------------------------------------------------  
    505    FUNCTION boundary__init_wrapper(td_var, & 
    506    &                               ld_north, ld_south, ld_east, ld_west, & 
    507    &                               cd_north, cd_south, cd_east, cd_west, & 
    508    &                               ld_oneseg )  
     534 
    509535      IMPLICIT NONE  
     536 
    510537      ! Argument 
    511538      TYPE(TVAR)       , INTENT(IN) :: td_var 
    … …  
    521548 
    522549      ! function  
    523       TYPE(TBDY), DIMENSION(ip_ncard) :: boundary__init_wrapper 
     550      TYPE(TBDY)       , DIMENSION(ip_ncard)  :: tf_bdy 
    524551 
    525552      ! local variable  
    … …  
    532559      CHARACTER(LEN=lc), DIMENSION(ip_ncard) :: cl_card 
    533560 
    534       TYPE(TBDY)       , DIMENSION(ip_ncard) :: tl_bdy 
    535561      TYPE(TBDY)                             :: tl_tmp 
    536562 
    … …  
    555581 
    556582         ! init 
    557          tl_bdy(jp_north)=boundary__init('north',ld_north) 
    558          tl_bdy(jp_south)=boundary__init('south',ld_south) 
    559          tl_bdy(jp_east )=boundary__init('east ',ld_east ) 
    560          tl_bdy(jp_west )=boundary__init('west ',ld_west ) 
     583         tf_bdy(jp_north)=boundary__init('north',ld_north) 
     584         tf_bdy(jp_south)=boundary__init('south',ld_south) 
     585         tf_bdy(jp_east )=boundary__init('east ',ld_east ) 
     586         tf_bdy(jp_west )=boundary__init('west ',ld_west ) 
    561587 
    562588         ! if EW cyclic no east west boundary and force to use one segment 
    … …  
    564590            CALL logger_info("BOUNDARY INIT: cyclic domain, "//& 
    565591            &  "no East West boundary") 
    566             tl_bdy(jp_east )%l_use=.FALSE. 
    567             tl_bdy(jp_west )%l_use=.FALSE. 
     592            tf_bdy(jp_east )%l_use=.FALSE. 
     593            tf_bdy(jp_west )%l_use=.FALSE. 
    568594 
    569595            CALL logger_info("BOUNDARY INIT: force to use one segment due"//& 
    … …  
    618644            tl_seg=seg__init(il_index(jk),il_width,il_min(jk),il_max(jk)) 
    619645 
    620             IF( tl_bdy(jk)%l_use )THEN 
     646            IF( tf_bdy(jk)%l_use )THEN 
    621647 
    622648               ! get namelist information 
    … …  
    625651               ! get segments indices 
    626652               DO ji=1,tl_tmp%i_nseg 
    627                   CALL boundary__add_seg(tl_bdy(jk),tl_tmp%t_seg(ji)) 
     653                  CALL boundary__add_seg(tf_bdy(jk),tl_tmp%t_seg(ji)) 
    628654               ENDDO 
    629655               ! indices from namelist or not 
    630                tl_bdy(jk)%l_nam=tl_tmp%l_nam 
     656               tf_bdy(jk)%l_nam=tl_tmp%l_nam 
    631657 
    632658               CALL boundary_clean(tl_tmp) 
    633659 
    634                IF( tl_bdy(jk)%i_nseg == 0 )THEN 
     660               IF( tf_bdy(jk)%i_nseg == 0 )THEN 
    635661                  ! add default segment 
    636                   CALL boundary__add_seg(tl_bdy(jk),tl_seg) 
     662                  CALL boundary__add_seg(tf_bdy(jk),tl_seg) 
    637663               ELSE 
    638664                  ! fill undefined value 
    639                   WHERE( tl_bdy(jk)%t_seg(:)%i_index == 0 )  
    640                      tl_bdy(jk)%t_seg(:)%i_index = tl_seg%i_index 
     665                  WHERE( tf_bdy(jk)%t_seg(:)%i_index == 0 )  
     666                     tf_bdy(jk)%t_seg(:)%i_index = tl_seg%i_index 
    641667                  END WHERE                
    642                   WHERE( tl_bdy(jk)%t_seg(:)%i_width == 0 )  
    643                      tl_bdy(jk)%t_seg(:)%i_width = tl_seg%i_width 
     668                  WHERE( tf_bdy(jk)%t_seg(:)%i_width == 0 )  
     669                     tf_bdy(jk)%t_seg(:)%i_width = tl_seg%i_width 
    644670                  END WHERE 
    645                   WHERE( tl_bdy(jk)%t_seg(:)%i_first == 0 )  
    646                      tl_bdy(jk)%t_seg(:)%i_first = tl_seg%i_first 
     671                  WHERE( tf_bdy(jk)%t_seg(:)%i_first == 0 )  
     672                     tf_bdy(jk)%t_seg(:)%i_first = tl_seg%i_first 
    647673                  END WHERE 
    648                   WHERE( tl_bdy(jk)%t_seg(:)%i_last == 0 )  
    649                      tl_bdy(jk)%t_seg(:)%i_last = tl_seg%i_last 
     674                  WHERE( tf_bdy(jk)%t_seg(:)%i_last == 0 )  
     675                     tf_bdy(jk)%t_seg(:)%i_last = tl_seg%i_last 
    650676                  END WHERE 
    651677               ENDIF 
    … …  
    657683         ENDDO 
    658684 
    659          CALL boundary_get_indices(tl_bdy(:), td_var, ll_oneseg) 
    660  
    661          CALL boundary_check(tl_bdy, td_var) 
    662  
    663          boundary__init_wrapper(:)=boundary_copy(tl_bdy(:)) 
    664  
    665          ! clean 
    666          DO jk=1,ip_ncard 
    667             CALL boundary_clean(tl_bdy(jk)) 
    668          ENDDO 
     685         CALL boundary_get_indices(tf_bdy(:), td_var, ll_oneseg) 
     686 
     687         CALL boundary_check(tf_bdy, td_var) 
    669688 
    670689      ENDIF 
    671690  
    672691   END FUNCTION boundary__init_wrapper  
     692   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     693   FUNCTION boundary__init(cd_card, ld_use, ld_nam, td_seg) & 
     694         &  RESULT (tf_bdy) 
    673695   !-------------------------------------------------------------------  
    674696   !> @brief This function initialise basically a boundary structure with 
    … …  
    687709   !> @return boundary structure 
    688710   !-------------------------------------------------------------------  
    689    FUNCTION boundary__init( cd_card, ld_use, ld_nam, td_seg )  
     711 
    690712      IMPLICIT NONE  
     713 
    691714      ! Argument 
    692715      CHARACTER(LEN=*), INTENT(IN) :: cd_card 
    … …  
    696719 
    697720      ! function  
    698       TYPE(TBDY) :: boundary__init 
     721      TYPE(TBDY)                   :: tf_bdy 
    699722 
    700723      ! local variable  
    701        
    702724      ! loop indices  
    703725      !----------------------------------------------------------------  
    … …  
    706728         CASE ('north','south','east','west') 
    707729          
    708             boundary__init%c_card=TRIM(cd_card) 
    709  
    710             boundary__init%l_use=.TRUE. 
    711             IF( PRESENT(ld_use) ) boundary__init%l_use=ld_use 
    712  
    713             boundary__init%l_nam=.FALSE. 
    714             IF( PRESENT(ld_nam) ) boundary__init%l_nam=ld_nam 
     730            tf_bdy%c_card=TRIM(cd_card) 
     731 
     732            tf_bdy%l_use=.TRUE. 
     733            IF( PRESENT(ld_use) ) tf_bdy%l_use=ld_use 
     734 
     735            tf_bdy%l_nam=.FALSE. 
     736            IF( PRESENT(ld_nam) ) tf_bdy%l_nam=ld_nam 
    715737 
    716738            IF( PRESENT(td_seg) )THEN 
    717                CALL boundary__add_seg(boundary__init, td_seg) 
     739               CALL boundary__add_seg(tf_bdy, td_seg) 
    718740            ENDIF 
    719741 
    … …  
    723745 
    724746   END FUNCTION boundary__init 
     747   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     748   SUBROUTINE boundary__add_seg(td_bdy, td_seg)  
    725749   !-------------------------------------------------------------------  
    726750   !> @brief This subroutine add one segment structure to a boundary structure  
    … …  
    734758   !> @param[in] td_seg    segment structure   
    735759   !-------------------------------------------------------------------  
    736    SUBROUTINE boundary__add_seg(td_bdy, td_seg)  
     760 
    737761      IMPLICIT NONE  
     762 
    738763      ! Argument  
    739764      TYPE(TBDY), INTENT(INOUT) :: td_bdy 
    … …  
    793818 
    794819   END SUBROUTINE boundary__add_seg  
     820   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     821   SUBROUTINE boundary__del_seg(td_bdy)  
    795822   !-------------------------------------------------------------------  
    796823   !> @brief This subroutine remove all segments of a boundary structure  
    … …  
    803830   !> @param[inout]  td_bdy   boundary structure 
    804831   !-------------------------------------------------------------------  
    805    SUBROUTINE boundary__del_seg(td_bdy)  
     832 
    806833      IMPLICIT NONE  
     834 
    807835      ! Argument  
    808836      TYPE(TBDY), INTENT(INOUT) :: td_bdy 
    … …  
    820848 
    821849   END SUBROUTINE boundary__del_seg  
     850   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     851   FUNCTION boundary__get_info(cd_card, id_jcard) & 
     852         & RESULT (tf_bdy) 
    822853   !-------------------------------------------------------------------  
    823854   !> @brief This function get information about boundary from string character.  
    … …  
    839870   !> @return boundary structure 
    840871   !-------------------------------------------------------------------  
    841    FUNCTION boundary__get_info(cd_card, id_jcard)  
     872 
    842873      IMPLICIT NONE  
     874 
    843875      ! Argument  
    844876      CHARACTER(LEN=lc), INTENT(IN) :: cd_card 
    … …  
    846878 
    847879      ! function  
    848       TYPE(TBDY) :: boundary__get_info 
     880      TYPE(TBDY)                    :: tf_bdy 
    849881 
    850882      ! local variable  
    … …  
    876908         ! initialise boundary 
    877909         ! temporaty boundary, so it doesn't matter which caridnal is used 
    878          boundary__get_info=boundary__init('north',ld_nam=.TRUE.) 
     910         tf_bdy=boundary__init('north',ld_nam=.TRUE.) 
    879911 
    880912         il_ind1=SCAN(fct_lower(cl_seg),'(') 
    … …  
    953985         IF( (tl_seg%i_first == 0 .AND.  tl_seg%i_last == 0) .OR. & 
    954986         &   (tl_seg%i_first /= 0 .AND.  tl_seg%i_last /= 0) )THEN 
    955             CALL boundary__add_seg(boundary__get_info, tl_seg) 
     987            CALL boundary__add_seg(tf_bdy, tl_seg) 
    956988         ELSE 
    957989            CALL logger_error("BOUNDARY INIT: first or last segment indices "//& 
    … …  
    967999 
    9681000   END FUNCTION boundary__get_info  
     1001   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1002   SUBROUTINE boundary_get_indices(td_bdy, td_var, ld_oneseg)  
    9691003   !-------------------------------------------------------------------  
    9701004   !> @brief This subroutine get indices of each semgent for each boundary. 
    … …  
    9891023   !> @param[in] ld_onseg  use only one sgment for each boundary  
    9901024   !-------------------------------------------------------------------  
    991    SUBROUTINE boundary_get_indices( td_bdy, td_var, ld_oneseg)  
     1025 
    9921026      IMPLICIT NONE  
     1027 
    9931028      ! Argument 
    9941029      TYPE(TBDY) , DIMENSION(ip_ncard), INTENT(INOUT) :: td_bdy 
    … …  
    10571092 
    10581093   END SUBROUTINE boundary_get_indices  
     1094   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1095   SUBROUTINE boundary__get_seg_number(td_bdy, td_var)  
    10591096   !-------------------------------------------------------------------  
    10601097   !> @brief This subroutine compute the number of sea segment.  
    … …  
    10731110   !> @param[in] td_var    variable structure  
    10741111   !-------------------------------------------------------------------  
    1075    SUBROUTINE boundary__get_seg_number( td_bdy, td_var)  
     1112 
    10761113      IMPLICIT NONE  
     1114 
    10771115      ! Argument 
    10781116      TYPE(TBDY) , INTENT(INOUT) :: td_bdy 
    … …  
    11551193  
    11561194   END SUBROUTINE boundary__get_seg_number  
     1195   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1196   SUBROUTINE boundary__get_seg_indices(td_bdy, td_var, & 
     1197         &                              id_index, id_width, id_first, id_last)  
    11571198   !-------------------------------------------------------------------  
    11581199   !> @brief This subroutine get segment indices for one boundary. 
    … …  
    11701211   !> @param[in] id_last   boundary last  indice 
    11711212   !-------------------------------------------------------------------  
    1172    SUBROUTINE boundary__get_seg_indices( td_bdy, td_var, & 
    1173    &                                     id_index, id_width, id_first, id_last)  
     1213 
    11741214      IMPLICIT NONE  
     1215 
    11751216      ! Argument 
    11761217      TYPE(TBDY) , INTENT(INOUT) :: td_bdy 
    … …  
    13051346       
    13061347   END SUBROUTINE boundary__get_seg_indices  
     1348   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1349   SUBROUTINE boundary_check_corner(td_bdy, td_var) 
    13071350   !-------------------------------------------------------------------  
    13081351   !> @brief This subroutine check if there is boundary at corner, and  
    … …  
    13221365   !> @param[in] td_var    variable structure 
    13231366   !-------------------------------------------------------------------  
    1324    SUBROUTINE boundary_check_corner( td_bdy, td_var ) 
     1367 
    13251368      IMPLICIT NONE  
     1369 
    13261370      ! Argument 
    13271371      TYPE(TBDY) , DIMENSION(ip_ncard), INTENT(INOUT) :: td_bdy 
    … …  
    15201564 
    15211565   END SUBROUTINE boundary_check_corner  
     1566   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1567   SUBROUTINE boundary_check(td_bdy, td_var)  
    15221568   !-------------------------------------------------------------------  
    15231569   !> @brief This subroutine check boundary. 
    … …  
    15361582   !> @param[in] td_var    variable structure  
    15371583   !-------------------------------------------------------------------  
    1538    SUBROUTINE boundary_check(td_bdy, td_var)  
     1584 
    15391585      IMPLICIT NONE  
     1586 
    15401587      ! Argument 
    15411588      TYPE(TBDY) , DIMENSION(ip_ncard), INTENT(INOUT) :: td_bdy 
    … …  
    15941641 
    15951642   END SUBROUTINE boundary_check 
     1643   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1644   SUBROUTINE boundary_swap(td_var, td_bdy) 
    15961645   !------------------------------------------------------------------- 
    15971646   !> @brief This subroutine swap array for east and north boundary. 
    … …  
    16051654   !> @param[in   ] td_bdy boundary strucutre 
    16061655   !------------------------------------------------------------------- 
    1607    SUBROUTINE boundary_swap( td_var, td_bdy ) 
     1656 
    16081657      IMPLICIT NONE 
     1658 
    16091659      ! Argument 
    16101660      TYPE(TVAR), INTENT(INOUT) :: td_var 
    … …  
    16591709      ENDIF 
    16601710   END SUBROUTINE boundary_swap 
     1711   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1712   SUBROUTINE boundary__print_unit(td_bdy)  
    16611713   !-------------------------------------------------------------------  
    16621714   !> @brief This subroutine print information about one boundary.  
    … …  
    16671719   !> @param[in] td_bdy boundary structure  
    16681720   !-------------------------------------------------------------------  
    1669    SUBROUTINE boundary__print_unit( td_bdy )  
     1721 
    16701722      IMPLICIT NONE  
     1723 
    16711724      ! Argument 
    16721725      TYPE(TBDY), INTENT(IN) :: td_bdy 
     1726 
    16731727      ! local variable  
    16741728      ! loop indices  
    … …  
    16881742  
    16891743   END SUBROUTINE boundary__print_unit 
     1744   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1745   SUBROUTINE boundary__print_arr(td_bdy)  
    16901746   !-------------------------------------------------------------------  
    16911747   !> @brief This subroutine print information about a array of boundary  
    … …  
    16981754   !> @param[in] td_bdy boundary structure  
    16991755   !-------------------------------------------------------------------  
    1700    SUBROUTINE boundary__print_arr( td_bdy )  
     1756 
    17011757      IMPLICIT NONE  
     1758 
    17021759      ! Argument 
    17031760      TYPE(TBDY), DIMENSION(:), INTENT(IN) :: td_bdy 
     1761 
    17041762      ! local variable  
    17051763      ! loop indices  
    … …  
    17121770  
    17131771   END SUBROUTINE boundary__print_arr 
     1772   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1773   FUNCTION seg__copy_unit(td_seg) & 
     1774         & RESULT (tf_seg) 
    17141775   !------------------------------------------------------------------- 
    17151776   !> @brief 
    … …  
    17311792   !> @return copy of input segment structure 
    17321793   !------------------------------------------------------------------- 
    1733    FUNCTION seg__copy_unit( td_seg ) 
     1794 
    17341795      IMPLICIT NONE 
     1796 
    17351797      ! Argument 
    17361798      TYPE(TSEG), INTENT(IN)  :: td_seg 
     1799 
    17371800      ! function 
    1738       TYPE(TSEG) :: seg__copy_unit 
     1801      TYPE(TSEG)              :: tf_seg 
    17391802 
    17401803      ! local variable 
    … …  
    17431806 
    17441807      ! copy segment index, width, .. 
    1745       seg__copy_unit%i_index    = td_seg%i_index 
    1746       seg__copy_unit%i_width    = td_seg%i_width 
    1747       seg__copy_unit%i_first    = td_seg%i_first 
    1748       seg__copy_unit%i_last     = td_seg%i_last  
     1808      tf_seg%i_index    = td_seg%i_index 
     1809      tf_seg%i_width    = td_seg%i_width 
     1810      tf_seg%i_first    = td_seg%i_first 
     1811      tf_seg%i_last     = td_seg%i_last  
    17491812 
    17501813   END FUNCTION seg__copy_unit 
     1814   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1815   FUNCTION seg__copy_arr(td_seg) & 
     1816         & RESULT (tf_seg) 
    17511817   !------------------------------------------------------------------- 
    17521818   !> @brief 
    … …  
    17681834   !> @return copy of input array of segment structure 
    17691835   !------------------------------------------------------------------- 
    1770    FUNCTION seg__copy_arr( td_seg ) 
     1836 
    17711837      IMPLICIT NONE 
     1838 
    17721839      ! Argument 
    1773       TYPE(TSEG), DIMENSION(:), INTENT(IN)  :: td_seg 
     1840      TYPE(TSEG), DIMENSION(:), INTENT(IN)   :: td_seg 
     1841 
    17741842      ! function 
    1775       TYPE(TSEG), DIMENSION(SIZE(td_seg(:))) :: seg__copy_arr 
     1843      TYPE(TSEG), DIMENSION(SIZE(td_seg(:))) :: tf_seg 
    17761844 
    17771845      ! local variable 
    … …  
    17811849 
    17821850      DO ji=1,SIZE(td_seg(:)) 
    1783          seg__copy_arr(ji)=seg__copy(td_seg(ji)) 
     1851         tf_seg(ji)=seg__copy(td_seg(ji)) 
    17841852      ENDDO 
    17851853 
    17861854   END FUNCTION seg__copy_arr 
     1855   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1856   FUNCTION seg__init(id_index, id_width, id_first, id_last) & 
     1857         &  RESULT(tf_seg) 
    17871858   !-------------------------------------------------------------------  
    17881859   !> @brief This function  initialise segment structure. 
    … …  
    18011872   !> @return segment structure 
    18021873   !-------------------------------------------------------------------  
    1803    FUNCTION seg__init( id_index, id_width, id_first, id_last )  
     1874 
    18041875      IMPLICIT NONE  
     1876 
    18051877      ! Argument 
    18061878      INTEGER(i4), INTENT(IN) :: id_index 
    … …  
    18101882 
    18111883      ! function  
    1812       TYPE(TSEG) :: seg__init 
     1884      TYPE(TSEG)              :: tf_seg 
    18131885 
    18141886      ! local variable  
    … …  
    18171889      !----------------------------------------------------------------  
    18181890 
    1819       seg__init%i_index=id_index 
    1820  
    1821       IF( PRESENT(id_width) ) seg__init%i_width=id_width 
    1822       IF( PRESENT(id_first) ) seg__init%i_first=id_first 
    1823       IF( PRESENT(id_last ) ) seg__init%i_last =id_last 
     1891      tf_seg%i_index=id_index 
     1892 
     1893      IF( PRESENT(id_width) ) tf_seg%i_width=id_width 
     1894      IF( PRESENT(id_first) ) tf_seg%i_first=id_first 
     1895      IF( PRESENT(id_last ) ) tf_seg%i_last =id_last 
    18241896 
    18251897   END FUNCTION seg__init  
     1898   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1899   SUBROUTINE seg__clean_unit(td_seg)  
    18261900   !-------------------------------------------------------------------  
    18271901   !> @brief This subroutine clean segment structure.  
    … …  
    18321906   !> @param[inout] td_seg segment structure 
    18331907   !-------------------------------------------------------------------  
    1834    SUBROUTINE seg__clean_unit(td_seg)  
     1908 
    18351909      IMPLICIT NONE  
     1910 
    18361911      ! Argument        
    18371912      TYPE(TSEG), INTENT(INOUT) :: td_seg 
     1913 
    18381914      ! local variable  
    18391915      TYPE(TSEG) :: tl_seg 
    … …  
    18441920  
    18451921   END SUBROUTINE seg__clean_unit 
     1922   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1923   SUBROUTINE seg__clean_arr(td_seg)  
    18461924   !-------------------------------------------------------------------  
    18471925   !> @brief This subroutine clean segment structure.  
    … …  
    18521930   !> @param[inout] td_seg array of segment structure 
    18531931   !-------------------------------------------------------------------  
    1854    SUBROUTINE seg__clean_arr(td_seg)  
     1932 
    18551933      IMPLICIT NONE  
     1934 
    18561935      ! Argument        
    18571936      TYPE(TSEG), DIMENSION(:), INTENT(INOUT) :: td_seg 
     1937 
    18581938      ! local variable  
    18591939      ! loop indices  
    … …  
    18661946  
    18671947   END SUBROUTINE seg__clean_arr  
     1948   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    18681949END MODULE boundary 
Note: See TracChangeset for help on using the changeset viewer.