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/mpp.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/mpp.f90

    r5037 r5609  
    165165!>    to get processors to be used:<br/> 
    166166!> @code 
    167 !>    CALL mpp_get_use( td_mpp, id_imin, id_imax, id_idim, &  
    168 !>    &                         id_jmin, id_jmax, id_jdim ) 
     167!>    CALL mpp_get_use( td_mpp, id_imin, id_imax, &  
     168!>    &                         id_jmin, id_jmax ) 
    169169!> @endcode 
    170170!>       - id_imin  
    171171!>       - id_imax  
    172 !>       - id_idim  
    173172!>       - id_jmin  
    174173!>       - id_jmax  
    175 !>       - id_jdim  
    176174!> 
    177175!>    to get sub domains which form global domain contour:<br/> 
    … …  
    379377      ! copy mpp variable 
    380378      mpp__copy_unit%c_name     = TRIM(td_mpp%c_name) 
     379      mpp__copy_unit%i_id       = td_mpp%i_id 
    381380      mpp__copy_unit%i_niproc   = td_mpp%i_niproc 
    382381      mpp__copy_unit%i_njproc   = td_mpp%i_njproc 
    … …  
    495494      ! print dimension 
    496495      IF(  td_mpp%i_ndim /= 0 )THEN 
    497          WRITE(*,'(/a)') " File dimension" 
     496         WRITE(*,'(/a)') " MPP dimension" 
    498497         DO ji=1,ip_maxdim 
    499498            IF( td_mpp%t_dim(ji)%l_use )THEN 
    … …  
    698697      CALL dim_clean(tl_dim) 
    699698 
    700       IF( (       PRESENT(id_niproc)  .AND. (.NOT. PRESENT(id_niproc))) .OR. & 
     699      IF( (       PRESENT(id_niproc)  .AND. (.NOT. PRESENT(id_njproc))) .OR. & 
    701700          ((.NOT. PRESENT(id_niproc)) .AND.        PRESENT(id_njproc) ) )THEN 
    702701          CALL logger_warn( "MPP INIT: number of processors following I and J "//& 
    … …  
    10281027            ! create some attributes for domain decomposition (use with dimg file) 
    10291028            tl_att=att_init( "DOMAIN_number_total", mpp__init_file%i_nproc ) 
    1030             CALL mpp_add_att(mpp__init_file, tl_att) 
     1029            CALL mpp_move_att(mpp__init_file, tl_att) 
    10311030 
    10321031            tl_att=att_init( "DOMAIN_I_position_first", mpp__init_file%t_proc(:)%i_impp ) 
    1033             CALL mpp_add_att(mpp__init_file, tl_att) 
     1032            CALL mpp_move_att(mpp__init_file, tl_att) 
    10341033 
    10351034            tl_att=att_init( "DOMAIN_J_position_first", mpp__init_file%t_proc(:)%i_jmpp ) 
    1036             CALL mpp_add_att(mpp__init_file, tl_att) 
     1035            CALL mpp_move_att(mpp__init_file, tl_att) 
    10371036 
    10381037            tl_att=att_init( "DOMAIN_I_position_last", mpp__init_file%t_proc(:)%i_lci ) 
    1039             CALL mpp_add_att(mpp__init_file, tl_att) 
     1038            CALL mpp_move_att(mpp__init_file, tl_att) 
    10401039 
    10411040            tl_att=att_init( "DOMAIN_J_position_last", mpp__init_file%t_proc(:)%i_lcj ) 
    1042             CALL mpp_add_att(mpp__init_file, tl_att) 
     1041            CALL mpp_move_att(mpp__init_file, tl_att) 
    10431042 
    10441043            tl_att=att_init( "DOMAIN_I_halo_size_start", mpp__init_file%t_proc(:)%i_ldi ) 
    1045             CALL mpp_add_att(mpp__init_file, tl_att) 
     1044            CALL mpp_move_att(mpp__init_file, tl_att) 
    10461045 
    10471046            tl_att=att_init( "DOMAIN_J_halo_size_start", mpp__init_file%t_proc(:)%i_ldj ) 
    1048             CALL mpp_add_att(mpp__init_file, tl_att) 
     1047            CALL mpp_move_att(mpp__init_file, tl_att) 
    10491048 
    10501049            tl_att=att_init( "DOMAIN_I_halo_size_end", mpp__init_file%t_proc(:)%i_lei ) 
    1051             CALL mpp_add_att(mpp__init_file, tl_att) 
     1050            CALL mpp_move_att(mpp__init_file, tl_att) 
    10521051 
    10531052            tl_att=att_init( "DOMAIN_J_halo_size_end", mpp__init_file%t_proc(:)%i_lej ) 
    1054             CALL mpp_add_att(mpp__init_file, tl_att) 
     1053            CALL mpp_move_att(mpp__init_file, tl_att) 
    10551054             
    10561055            ! clean 
    … …  
    11221121      CALL file_clean(tl_file) 
    11231122 
    1124       CALL logger_debug("MPP INIT READ: fin init_read ") 
    11251123   END FUNCTION mpp__init_file 
    11261124   !------------------------------------------------------------------- 
    … …  
    11311129   ! 
    11321130   !> @author J.Paul 
    1133    !> - November, 2013- Initial Version 
     1131   !> - November, 2013 - Initial Version 
     1132   !> @date July, 2015 - add only use dimension in MPP structure 
    11341133   !> 
    11351134   !> @param[in] td_file   file strcuture 
    … …  
    11631162         IF( td_file%i_id == 0 )THEN 
    11641163            CALL logger_info(" id "//TRIM(fct_str(td_file%i_id)))  
    1165             CALL logger_error("MPP INIT READ: netcdf file "//TRIM(td_file%c_name)//& 
    1166             &  " not opened") 
     1164            CALL logger_error("MPP INIT READ: netcdf file "//& 
     1165               &  TRIM(td_file%c_name)//" not opened") 
    11671166         ELSE 
    11681167 
    … …  
    11911190               CALL mpp_add_dim(mpp__init_file_cdf,tl_dim) 
    11921191            ENDIF 
    1193             tl_dim=dim_init( td_file%t_dim(3)%c_name, td_file%t_dim(3)%i_len) 
    1194             CALL mpp_add_dim(mpp__init_file_cdf,tl_dim) 
    1195  
    1196             tl_dim=dim_init( td_file%t_dim(4)%c_name, td_file%t_dim(4)%i_len) 
    1197             CALL mpp_add_dim(mpp__init_file_cdf,tl_dim) 
     1192 
     1193            IF( td_file%t_dim(3)%l_use )THEN 
     1194               tl_dim=dim_init( td_file%t_dim(3)%c_name, td_file%t_dim(3)%i_len) 
     1195               CALL mpp_add_dim(mpp__init_file_cdf,tl_dim) 
     1196            ENDIF 
     1197 
     1198            IF( td_file%t_dim(4)%l_use )THEN 
     1199               tl_dim=dim_init( td_file%t_dim(4)%c_name, td_file%t_dim(4)%i_len) 
     1200               CALL mpp_add_dim(mpp__init_file_cdf,tl_dim) 
     1201            ENDIF 
    11981202 
    11991203            ! initialise file/processor 
    … …  
    16241628            IF( il_varid /= 0 )THEN 
    16251629 
    1626                CALL logger_error( " MPP ADD VAR: variable "//TRIM(td_var%c_name)//& 
    1627                &  ", standard name "//TRIM(td_var%c_stdname)//& 
    1628                &  ", already in mpp "//TRIM(td_mpp%c_name) ) 
    1629  
    16301630               DO ji=1,td_mpp%t_proc(1)%i_nvar 
    16311631                  CALL logger_debug( " MPP ADD VAR: in mpp structure : & 
    … …  
    16341634                  &  TRIM(td_mpp%t_proc(1)%t_var(ji)%c_stdname) ) 
    16351635               ENDDO 
     1636               CALL logger_error( " MPP ADD VAR: variable "//TRIM(td_var%c_name)//& 
     1637               &  ", standard name "//TRIM(td_var%c_stdname)//& 
     1638               &  ", already in mpp "//TRIM(td_mpp%c_name) ) 
    16361639 
    16371640            ELSE 
    … …  
    18401843   !> @author J.Paul 
    18411844   !> @date November, 2013 - Initial version 
     1845   !> @date February, 2015 - define local variable structure to avoid mistake 
     1846   !> with pointer 
    18421847   ! 
    18431848   !> @param[inout] td_mpp    mpp strcuture 
    … …  
    18521857      ! local variable 
    18531858      INTEGER(i4)       :: il_varid 
     1859      TYPE(TVAR)        :: tl_var 
    18541860      !---------------------------------------------------------------- 
    18551861      ! check if mpp exist 
    … …  
    18821888            ELSE 
    18831889 
    1884                CALL mpp_del_var(td_mpp, td_mpp%t_proc(1)%t_var(il_varid))  
     1890               tl_var=var_copy(td_mpp%t_proc(1)%t_var(il_varid)) 
     1891               CALL mpp_del_var(td_mpp, tl_var) 
    18851892 
    18861893            ENDIF 
    … …  
    21942201   !> @author J.Paul 
    21952202   !> - November, 2013- Initial Version 
     2203   !> @date July, 2015 - rewrite the same as way var_add_dim 
    21962204   !> 
    21972205   !> @param[inout] td_mpp mpp structure 
    … …  
    22082216 
    22092217      ! loop indices 
    2210       INTEGER(i4) :: ji 
    22112218      !---------------------------------------------------------------- 
    22122219      IF( td_mpp%i_ndim <= ip_maxdim )THEN 
    22132220 
    2214          ! check if dimension already in mpp structure 
    2215          il_ind=dim_get_index(td_mpp%t_dim(:), td_dim%c_name, td_dim%c_sname) 
    2216          IF( il_ind /= 0 )THEN 
    2217  
    2218             IF( td_mpp%t_dim(il_ind)%l_use )THEN 
    2219                CALL logger_error( & 
    2220                &  "MPP ADD DIM: dimension "//TRIM(td_dim%c_name)//& 
    2221                &  ", short name "//TRIM(td_dim%c_sname)//& 
    2222                &  ", already used in mpp "//TRIM(td_mpp%c_name) ) 
    2223             ELSE 
    2224                ! replace dimension 
    2225                td_mpp%t_dim(il_ind)=dim_copy(td_dim) 
    2226                td_mpp%t_dim(il_ind)%i_id=il_ind 
    2227                td_mpp%t_dim(il_ind)%l_use=.TRUE. 
    2228             ENDIF 
    2229  
     2221         ! check if dimension already used in mpp structure 
     2222         il_ind=SCAN(TRIM(cp_dimorder),TRIM(td_dim%c_sname)) 
     2223         IF( il_ind == 0 )THEN 
     2224            CALL logger_warn( & 
     2225            &  " MPP ADD DIM: dimension "//TRIM(td_dim%c_name)//& 
     2226            &  ", short name "//TRIM(td_dim%c_sname)//& 
     2227            &  ", will not be added in mpp "//TRIM(td_mpp%c_name) ) 
     2228         ELSEIF( td_mpp%t_dim(il_ind)%l_use )THEN 
     2229            CALL logger_error( & 
     2230            &  " MPP ADD DIM: dimension "//TRIM(td_dim%c_name)//& 
     2231            &  ", short name "//TRIM(td_dim%c_sname)//& 
     2232            &  ", already used in mpp "//TRIM(td_mpp%c_name) ) 
    22302233         ELSE 
    22312234 
    2232             IF( td_mpp%i_ndim == ip_maxdim )THEN 
    2233                CALL logger_error( & 
    2234                &  "MPP ADD DIM: can not add dimension "//TRIM(td_dim%c_name)//& 
    2235                &  ", short name "//TRIM(td_dim%c_sname)//& 
    2236                &  ", in mpp "//TRIM(td_mpp%c_name)//". Already "//& 
    2237                &  TRIM(fct_str(ip_maxdim))//" dimensions." ) 
    2238             ELSE 
    2239                ! search empty dimension 
    2240                DO ji=1,ip_maxdim 
    2241                   IF( td_mpp%t_dim(ji)%i_id == 0 )THEN 
    2242                      il_ind=ji  
    2243                      EXIT 
    2244                   ENDIF 
    2245                ENDDO 
    2246   
    2247                ! add new dimension     
    2248                td_mpp%t_dim(il_ind)=dim_copy(td_dim) 
    2249                ! update number of attribute 
    2250                td_mpp%i_ndim=COUNT(td_mpp%t_dim(:)%l_use) 
    2251  
    2252                td_mpp%t_dim(il_ind)%l_use=.TRUE. 
    2253                td_mpp%t_dim(il_ind)%i_id=td_mpp%i_ndim 
    2254             ENDIF 
     2235            ! back to disorder dimension array  
     2236            CALL dim_disorder(td_mpp%t_dim(:)) 
     2237 
     2238            ! add new dimension 
     2239            td_mpp%t_dim(td_mpp%i_ndim+1)=dim_copy(td_dim) 
     2240 
     2241            ! update number of attribute 
     2242            td_mpp%i_ndim=COUNT(td_mpp%t_dim(:)%l_use) 
    22552243 
    22562244         ENDIF 
     2245         ! reorder dimension to ('x','y','z','t') 
     2246         CALL dim_reorder(td_mpp%t_dim(:)) 
    22572247 
    22582248      ELSE 
    … …  
    22692259   !> @author J.Paul 
    22702260   !> - November, 2013- Initial Version 
     2261   !> @date July, 2015 - rewrite the same as way var_del_dim 
    22712262   !> 
    22722263   !> @param[inout] td_mpp mpp structure 
    … …  
    22802271 
    22812272      ! local variable 
    2282       INTEGER(i4) :: il_status 
    22832273      INTEGER(i4) :: il_ind 
    2284       TYPE(TDIM), DIMENSION(:), ALLOCATABLE  :: tl_dim 
     2274      TYPE(TDIM)  :: tl_dim 
    22852275 
    22862276      ! loop indices 
    2287       INTEGER(i4) :: ji 
    2288       !---------------------------------------------------------------- 
    2289       ! check if dimension already in mpp structure 
    2290       il_ind=dim_get_index(td_mpp%t_dim(:), td_dim%c_name, td_dim%c_sname) 
    2291       IF( il_ind == 0 )THEN 
    2292  
    2293          CALL logger_error( & 
    2294          &  "MPP DEL DIM: no dimension "//TRIM(td_dim%c_name)//& 
     2277      !---------------------------------------------------------------- 
     2278 
     2279 
     2280      IF( td_mpp%i_ndim <= ip_maxdim )THEN 
     2281 
     2282         CALL logger_trace( & 
     2283         &  " MPP DEL DIM: delete dimension "//TRIM(td_dim%c_name)//& 
    22952284         &  ", short name "//TRIM(td_dim%c_sname)//& 
    22962285         &  ", in mpp "//TRIM(td_mpp%c_name) ) 
     2286          
     2287         ! check if dimension already in variable structure 
     2288         il_ind=SCAN(TRIM(cp_dimorder),TRIM(td_dim%c_sname)) 
     2289 
     2290         ! replace dimension by empty one 
     2291         td_mpp%t_dim(il_ind)=dim_copy(tl_dim) 
     2292 
     2293         ! update number of dimension 
     2294         td_mpp%i_ndim=COUNT(td_mpp%t_dim(:)%l_use) 
     2295 
     2296         ! reorder dimension to ('x','y','z','t') 
     2297         CALL dim_reorder(td_mpp%t_dim) 
    22972298 
    22982299      ELSE 
    2299  
    2300          ALLOCATE( tl_dim(td_mpp%i_ndim-1), stat=il_status ) 
    2301          IF(il_status /= 0 )THEN 
    2302  
    2303             CALL logger_error( & 
    2304             &  "MPP DEL DIM: not enough space to put dimensions from "//& 
    2305             &  TRIM(td_mpp%c_name)//" in temporary dimension structure") 
    2306  
    2307          ELSE 
    2308  
    2309             ! save temporary dimension's mpp structure 
    2310             tl_dim( 1 : il_ind-1 ) = dim_copy(td_mpp%t_dim( 1 : il_ind-1 )) 
    2311             tl_dim( il_ind : td_mpp%i_ndim-1 ) = & 
    2312             &           dim_copy(td_mpp%t_dim( il_ind+1 : td_mpp%i_ndim )) 
    2313  
    2314             ! remove dimension from file 
    2315             CALL dim_clean(td_mpp%t_dim(:)) 
    2316             ! copy dimension in file, except one 
    2317             td_mpp%t_dim(1:td_mpp%i_ndim)=dim_copy(tl_dim(:)) 
    2318  
    2319             ! update number of dimension 
    2320             td_mpp%i_ndim=td_mpp%i_ndim-1 
    2321  
    2322             ! update dimension id 
    2323             DO ji=1,td_mpp%i_ndim 
    2324                td_mpp%t_dim(ji)%i_id=ji 
    2325             ENDDO 
    2326  
    2327             ! clean 
    2328             CALL dim_clean(tl_dim(:)) 
    2329             DEALLOCATE(tl_dim) 
    2330  
    2331          ENDIF 
    2332  
     2300         CALL logger_error( & 
     2301         &  " MPP DEL DIM: too much dimension in mpp "//& 
     2302         &  TRIM(td_mpp%c_name)//" ("//TRIM(fct_str(td_mpp%i_ndim))//")") 
    23332303      ENDIF 
    23342304 
    … …  
    24882458            &  ", in mpp structure "//TRIM(td_mpp%c_name) ) 
    24892459 
    2490             IF( ASSOCIATED(td_mpp%t_proc(1)%t_var) )THEN 
     2460            IF( ASSOCIATED(td_mpp%t_proc(1)%t_att) )THEN 
    24912461               DO ji=1,td_mpp%t_proc(1)%i_natt 
    24922462                  CALL logger_debug( "MPP DEL ATT: in mpp structure : & 
    2493                   &  attribute : "//TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name) ) 
     2463                  &  attribute : "//TRIM(td_mpp%t_proc(1)%t_att(ji)%c_name) ) 
    24942464               ENDDO 
    24952465            ENDIF 
    … …  
    25162486   !> @author J.Paul 
    25172487   !> @date November, 2013 - Initial version 
     2488   !> @date February, 2015 - define local attribute structure to avoid mistake 
     2489   !> with pointer 
    25182490   ! 
    25192491   !> @param[inout] td_mpp    mpp strcuture 
    … …  
    25272499 
    25282500      ! local variable 
    2529       INTEGER(i4)       :: il_attid 
     2501      INTEGER(i4) :: il_attid 
     2502      TYPE(TATT)  :: tl_att 
    25302503      !---------------------------------------------------------------- 
    25312504      ! check if mpp exist 
    … …  
    25512524            IF( il_attid == 0 )THEN 
    25522525 
    2553                CALL logger_warn( & 
     2526               CALL logger_debug( & 
    25542527               &  "MPP DEL ATT : there is no attribute with "//& 
    25552528               &  "name "//TRIM(cd_name)//" in mpp structure "//& 
    … …  
    25582531            ELSE 
    25592532 
    2560                CALL mpp_del_att(td_mpp, td_mpp%t_proc(1)%t_att(il_attid))  
     2533               tl_att=att_copy(td_mpp%t_proc(1)%t_att(il_attid)) 
     2534               CALL mpp_del_att(td_mpp, tl_att)  
    25612535 
    25622536            ENDIF 
    … …  
    28632837 
    28642838            CALL logger_info("MPP OPTIMIZ: number of processor "//& 
    2865             &  TRIM(fct_str(tl_mpp%i_nproc)) ) 
     2839            &   TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//& 
     2840            &   TRIM(fct_str(tl_mpp%i_nproc)) ) 
    28662841            IF( tl_mpp%i_nproc > td_mpp%i_nproc .AND. & 
    28672842            &   tl_mpp%i_nproc <= il_maxproc )THEN 
    28682843               ! save optimiz decomposition  
     2844 
     2845               CALL logger_info("MPP OPTIMIZ:save this decomposition "//& 
     2846               &   TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//& 
     2847               &   TRIM(fct_str(tl_mpp%i_nproc)) ) 
    28692848 
    28702849               ! clean mpp 
    … …  
    34173396 
    34183397      ! local variable 
    3419       INTEGER(i4) :: il_ndim 
    34203398 
    34213399      ! loop indices 
    … …  
    34293407         mpp__check_var_dim=.FALSE. 
    34303408 
    3431          CALL logger_error( & 
    3432          &  "MPP CHECK DIM: variable and mpp dimension differ"//& 
    3433          &  " for variable "//TRIM(td_var%c_name)//& 
    3434          &  " and mpp "//TRIM(td_mpp%c_name)) 
    3435  
    34363409         CALL logger_debug( & 
    34373410         &  " mpp dimension: "//TRIM(fct_str(td_mpp%i_ndim))//& 
    34383411         &  " variable dimension: "//TRIM(fct_str(td_var%i_ndim)) ) 
    3439          il_ndim=MIN(td_var%i_ndim, td_mpp%i_ndim ) 
    3440          DO ji = 1, il_ndim 
     3412         DO ji = 1, ip_maxdim 
    34413413            CALL logger_debug( & 
    34423414            &  "MPP CHECK DIM: for dimension "//& 
    … …  
    34483420            &  ", variable used "//TRIM(fct_str(td_var%t_dim(ji)%l_use))) 
    34493421         ENDDO 
     3422 
     3423         CALL logger_error( & 
     3424         &  "MPP CHECK DIM: variable and mpp dimension differ"//& 
     3425         &  " for variable "//TRIM(td_var%c_name)//& 
     3426         &  " and mpp "//TRIM(td_mpp%c_name)) 
     3427 
    34503428      ENDIF 
    34513429 
Note: See TracChangeset for help on using the changeset viewer.