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 6808 for branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/boundary.f90 – NEMO

Ignore:
Timestamp:
2016-07-19T10:38:35+02:00 (8 years ago)
Author:
jamesharle
Message:

merge with trunk@6232 for consistency with SSB code

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/TOOLS/SIREN/src/boundary.f90

    r5037 r6808  
    2626!>       - ld_west  is logical to force used of north boundary [optional] 
    2727!>       - cd_north is string character description of north boundary [optional] 
    28 !>       - cd_south is string character description of north boundary [optional] 
    29 !>       - cd_east  is string character description of north boundary [optional] 
    30 !>       - cd_west  is string character description of north boundary [optional] 
     28!>       - cd_south is string character description of south boundary [optional] 
     29!>       - cd_east  is string character description of east boundary [optional] 
     30!>       - cd_west  is string character description of west boundary [optional] 
    3131!>       - ld_oneseg is logical to force to use only one segment for each boundary [optional] 
    3232!> 
     
    3636!>    to know if boundary is use:<br/> 
    3737!>    - tl_bdy\%l_use 
     38!> 
     39!>    to know if boundary come from namelist (cn_north,..):<br/> 
     40!>    - tl_bdy\%l_nam 
    3841!> 
    3942!>    to get the number of segment in boundary:<br/> 
     
    105108! REVISION HISTORY: 
    106109!> @date November, 2013 - Initial Version 
    107 !> @date September, 2014 - add boundary description 
    108 !> @date November, 2014 - Fix memory leaks bug 
     110!> @date September, 2014  
     111!> - add boundary description 
     112!> @date November, 2014  
     113!> - Fix memory leaks bug 
     114!> @date February, 2015  
     115!> - Do not change indices read from namelist 
     116!> - Change string character format of boundary read from namelist,  
     117!>  see boundary__get_info 
    109118!>  
    110119!> @todo add schematic to boundary structure description 
     
    157166   PRIVATE :: seg__init       ! initialise segment structure 
    158167   PRIVATE :: seg__clean      ! clean segment structure 
    159    PRIVATE :: seg__clean_unit ! clean segment structure 
     168   PRIVATE :: seg__clean_unit ! clean one segment structure 
    160169   PRIVATE :: seg__clean_arr  ! clean array of segment structure 
    161170   PRIVATE :: seg__copy       ! copy segment structure in another 
     
    173182      CHARACTER(LEN=lc) :: c_card = ''          !< boundary cardinal 
    174183      LOGICAL           :: l_use  = .FALSE.     !< boundary use or not  
     184      LOGICAL           :: l_nam  = .FALSE.     !< boundary get from namelist 
    175185      INTEGER(i4)       :: i_nseg = 0           !< number of segment in boundary 
    176186      TYPE(TSEG), DIMENSION(:), POINTER :: t_seg => NULL() !<  array of segment structure 
    177187   END TYPE TBDY 
    178188 
     189   ! module variable 
    179190   INTEGER(i4), PARAMETER :: im_width=10 
    180191 
     
    223234   !> @date November, 2013 - Initial Version 
    224235   !> @date November, 2014 
    225    !>    - use function instead of overload assignment operator  
     236   !> - use function instead of overload assignment operator  
    226237   !> (to avoid memory leak) 
    227238   ! 
     
    260271   !> @date November, 2013 - Initial Version 
    261272   !> @date November, 2014 
    262    !>    - use function instead of overload assignment operator  
     273   !> - use function instead of overload assignment operator  
    263274   !> (to avoid memory leak) 
    264275   ! 
     
    353364   END SUBROUTINE boundary__clean_arr 
    354365   !-------------------------------------------------------------------  
    355    !> @brief This function put cardinal name inside file name. 
     366   !> @brief This function put cardinal name and date inside file name. 
    356367   !  
    357368   !> @details  
    358    !  
     369   !>    Examples : 
     370   !>       cd_file="boundary.nc" 
     371   !>       cd_card="west"  
     372   !>       id_seg =2 
     373   !>       cd_date=y2015m07d16 
     374   !>  
     375   !>       function return "boundary_west_2_y2015m07d16.nc" 
     376   !>  
     377   !>       cd_file="boundary.nc" 
     378   !>       cd_card="west"  
     379   !>  
     380   !>       function return "boundary_west.nc" 
     381   !>  
    359382   !> @author J.Paul  
    360383   !> @date November, 2013 - Initial Version  
     
    385408      CHARACTER(LEN=lc) :: cl_date 
    386409      CHARACTER(LEN=lc) :: cl_name 
     410 
     411      INTEGER(i4)       :: il_ind 
     412      INTEGER(i4)       :: il_indend 
     413 
    387414      ! loop indices  
    388415      !----------------------------------------------------------------  
     
    400427         cl_suffix=fct_split(TRIM(cl_basename),2,'.') 
    401428          
     429         ! add segment number 
    402430         IF( PRESENT(id_seg) )THEN 
    403             cl_segnum="_"//TRIM(fct_str(id_seg))//"_" 
     431            cl_segnum="_"//TRIM(fct_str(id_seg)) 
    404432         ELSE 
    405433            cl_segnum="" 
    406434         ENDIF 
    407435 
     436         ! add date 
    408437         IF( PRESENT(cd_date) )THEN 
    409             cl_date=TRIM(ADJUSTL(cd_date)) 
     438            cl_date="_"//TRIM(ADJUSTL(cd_date)) 
    410439         ELSE 
    411440            cl_date="" 
    412441         ENDIF 
    413442 
    414          cl_name=TRIM(cl_base)//"_"//TRIM(cd_card)//TRIM(cl_segnum)//& 
    415          &        TRIM(cl_date)//"."//TRIM(cl_suffix) 
     443         ! special case for obcdta 
     444         il_ind=INDEX(cl_base,'_obcdta_') 
     445         IF( il_ind/=0 )THEN 
     446            il_ind=il_ind-1+8 
     447            il_indend=LEN_TRIM(cl_base) 
     448 
     449            cl_name=TRIM(cl_base(1:il_ind))//TRIM(cd_card)//& 
     450               &     TRIM(cl_segnum)//"_"//TRIM(cl_base(il_ind+1:il_indend))//& 
     451               &     TRIM(cl_date)//"."//TRIM(cl_suffix) 
     452         ELSE 
     453            cl_name=TRIM(cl_base)//"_"//TRIM(cd_card)//TRIM(cl_segnum)//& 
     454               &     TRIM(cl_date)//"."//TRIM(cl_suffix) 
     455         ENDIF 
    416456 
    417457         boundary_set_filename=TRIM(cl_dirname)//"/"//TRIM(cl_name) 
     
    442482   !> ex : cn_north='index1,first1,last1(width)|index2,first2,last2' 
    443483   !> 
    444    !> @note boundaries are compute on T point. change will be done to get data 
    445    !> on other point when need be.  
     484   !> @note Boundaries are compute on T point, but expressed on U,V point. 
     485   !> change will be done to get data on other point when need be.  
    446486   !> 
    447487   !> @author J.Paul  
     
    581621 
    582622               ! get namelist information 
    583                tl_tmp=boundary__get_info(cl_card(jk)) 
     623               tl_tmp=boundary__get_info(cl_card(jk),jk) 
     624 
     625               ! get segments indices 
    584626               DO ji=1,tl_tmp%i_nseg 
    585627                  CALL boundary__add_seg(tl_bdy(jk),tl_tmp%t_seg(ji)) 
    586628               ENDDO 
     629               ! indices from namelist or not 
     630               tl_bdy(jk)%l_nam=tl_tmp%l_nam 
     631 
    587632               CALL boundary_clean(tl_tmp) 
    588633 
     
    642687   !> @return boundary structure 
    643688   !-------------------------------------------------------------------  
    644    FUNCTION boundary__init( cd_card, ld_use, td_seg )  
     689   FUNCTION boundary__init( cd_card, ld_use, ld_nam, td_seg )  
    645690      IMPLICIT NONE  
    646691      ! Argument 
    647692      CHARACTER(LEN=*), INTENT(IN) :: cd_card 
    648693      LOGICAL         , INTENT(IN), OPTIONAL :: ld_use  
     694      LOGICAL         , INTENT(IN), OPTIONAL :: ld_nam  
    649695      TYPE(TSEG)      , INTENT(IN), OPTIONAL :: td_seg 
    650696 
     
    664710            boundary__init%l_use=.TRUE. 
    665711            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 
    666715 
    667716            IF( PRESENT(td_seg) )THEN 
     
    778827   !> orthogonal index, first and last indices, of each segment.  
    779828   !> And also the width of all segments of this boundary. 
    780    !>   cn_north='index1,first1,last1(width)|index2,first2,last2' 
     829   !>   cn_north='index1,first1:last1(width)|index2,first2:last2' 
    781830   !>  
    782831   !> @author J.Paul  
    783832   !> @date November, 2013 - Initial Version  
     833   !> @date february, 2015  
     834   !> - do not change indices read from namelist 
     835   !> - change format cn_north 
    784836   !  
    785837   !> @param[in] cd_card   boundary description 
     838   !> @param[in] id_jcard  boundary index 
    786839   !> @return boundary structure 
    787840   !-------------------------------------------------------------------  
    788    FUNCTION boundary__get_info(cd_card)  
     841   FUNCTION boundary__get_info(cd_card, id_jcard)  
    789842      IMPLICIT NONE  
    790843      ! Argument  
    791844      CHARACTER(LEN=lc), INTENT(IN) :: cd_card 
     845      INTEGER(i4)      , INTENT(IN) :: id_jcard 
    792846 
    793847      ! function  
     
    802856      CHARACTER(LEN=lc) :: cl_index 
    803857      CHARACTER(LEN=lc) :: cl_width 
     858      CHARACTER(LEN=lc) :: cl_tmp 
    804859      CHARACTER(LEN=lc) :: cl_first 
    805860      CHARACTER(LEN=lc) :: cl_last  
     
    818873      ! width should be the same for all segment of one boundary 
    819874      IF( TRIM(cl_seg)   /= '' )THEN 
     875 
     876         ! initialise boundary 
     877         ! temporaty boundary, so it doesn't matter which caridnal is used 
     878         boundary__get_info=boundary__init('north',ld_nam=.TRUE.) 
     879 
    820880         il_ind1=SCAN(fct_lower(cl_seg),'(') 
    821881         IF( il_ind1 /=0 )THEN 
     
    831891            ENDIF 
    832892         ENDIF 
     893 
    833894      ENDIF  
    834895 
     
    839900         il_ind1=SCAN(fct_lower(cl_index),'(') 
    840901         IF( il_ind1 /=0 )THEN 
    841             il_ind2=SCAN(fct_lower(cl_index),'(') 
     902            il_ind2=SCAN(fct_lower(cl_index),')') 
    842903            IF( il_ind2 /=0 )THEN 
    843904               cl_index=TRIM(cl_index(:il_ind1-1))//TRIM(cl_index(il_ind2+1:)) 
     
    848909         ENDIF 
    849910       
    850          cl_first=fct_split(cl_seg,2,',') 
     911          
     912         cl_tmp=fct_split(cl_seg,2,',') 
     913 
     914 
     915         cl_first=fct_split(cl_tmp,1,':') 
    851916         ! remove potential width information 
    852917         il_ind1=SCAN(fct_lower(cl_first),'(') 
    853918         IF( il_ind1 /=0 )THEN 
    854             il_ind2=SCAN(fct_lower(cl_first),'(') 
     919            il_ind2=SCAN(fct_lower(cl_first),')') 
    855920            IF( il_ind2 /=0 )THEN 
    856921               cl_first=TRIM(cl_first(:il_ind1-1))//TRIM(cl_first(il_ind2+1:)) 
     
    861926         ENDIF          
    862927          
    863          cl_last =fct_split(cl_seg,3,',') 
     928         cl_last =fct_split(cl_tmp,2,':') 
    864929         ! remove potential width information 
    865930         il_ind1=SCAN(fct_lower(cl_last),'(') 
    866931         IF( il_ind1 /=0 )THEN 
    867             il_ind2=SCAN(fct_lower(cl_last),'(') 
     932            il_ind2=SCAN(fct_lower(cl_last),')') 
    868933            IF( il_ind2 /=0 )THEN 
    869934               cl_last=TRIM(cl_last(:il_ind1-1))//TRIM(cl_last(il_ind2+1:)) 
     
    879944         IF( TRIM(cl_first) /= '' ) READ(cl_first,*) tl_seg%i_first 
    880945         IF( TRIM(cl_last)  /= '' ) READ(cl_last ,*) tl_seg%i_last 
     946 
     947         ! index expressed on U,V point, move on T point. 
     948         SELECT CASE(id_jcard) 
     949            CASE(jp_north, jp_east) 
     950               tl_seg%i_index=tl_seg%i_index+1 
     951         END SELECT 
    881952 
    882953         IF( (tl_seg%i_first == 0 .AND.  tl_seg%i_last == 0) .OR. & 
     
    9431014 
    9441015      DO jk=1,ip_ncard 
    945          IF( .NOT. td_bdy(jk)%l_use .OR. td_bdy(jk)%i_nseg > 1 )THEN 
     1016         IF( .NOT. td_bdy(jk)%l_use .OR. td_bdy(jk)%l_nam )THEN 
    9461017            ! nothing to be done 
    9471018         ELSE 
     
    14801551      il_max(jp_east )=td_var%t_dim(2)%i_len 
    14811552      il_max(jp_west )=td_var%t_dim(2)%i_len 
    1482        
     1553  
    14831554      il_maxindex(jp_north)=td_var%t_dim(2)%i_len-ip_ghost 
    14841555      il_maxindex(jp_south)=td_var%t_dim(2)%i_len-ip_ghost 
     
    15151586         ENDIF 
    15161587      ENDDO 
    1517        
     1588  
    15181589      CALL boundary_check_corner(td_bdy, td_var) 
    15191590 
     
    16501721   !> @date November, 2013 - Initial Version 
    16511722   !> @date November, 2014 
    1652    !>    - use function instead of overload assignment operator  
     1723   !> - use function instead of overload assignment operator  
    16531724   !> (to avoid memory leak) 
    16541725   ! 
     
    16871758   !> @date November, 2013 - Initial Version 
    16881759   !> @date November, 2014 
    1689    !>    - use function instead of overload assignment operator  
     1760   !> - use function instead of overload assignment operator  
    16901761   !> (to avoid memory leak) 
    16911762   ! 
Note: See TracChangeset for help on using the changeset viewer.