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

    r10248 r10251  
    165165!>    to get processors to be used:<br/> 
    166166!> @code 
    167 !>    CALL mpp_get_use( td_mpp, id_imin, id_imax, &  
    168 !>    &                         id_jmin, id_jmax ) 
     167!>    CALL mpp_get_use( td_mpp, id_imin, id_imax, id_idim, &  
     168!>    &                         id_jmin, id_jmax, id_jdim ) 
    169169!> @endcode 
    170170!>       - id_imin  
    171171!>       - id_imax  
     172!>       - id_idim  
    172173!>       - id_jmin  
    173174!>       - id_jmax  
     175!>       - id_jdim  
    174176!> 
    175177!>    to get sub domains which form global domain contour:<br/> 
    … …  
    350352   !> 
    351353   !> @author J.Paul 
    352    !> @date November, 2013 - Initial Version 
     354   !> - November, 2013- Initial Version 
    353355   !> @date November, 2014 
    354356   !>    - use function instead of overload assignment operator  
    … …  
    377379      ! copy mpp variable 
    378380      mpp__copy_unit%c_name     = TRIM(td_mpp%c_name) 
    379       mpp__copy_unit%i_id       = td_mpp%i_id 
    380381      mpp__copy_unit%i_niproc   = td_mpp%i_niproc 
    381382      mpp__copy_unit%i_njproc   = td_mpp%i_njproc 
    … …  
    424425   !> 
    425426   !> @author J.Paul 
    426    !> @date November, 2013 - Initial Version 
     427   !> - November, 2013- Initial Version 
    427428   !> @date November, 2014 
    428429   !>    - use function instead of overload assignment operator  
    … …  
    453454   ! 
    454455   !> @author J.Paul 
    455    !> @date November, 2013 - Initial Version 
     456   !> - Nov, 2013- Initial Version 
    456457   ! 
    457458   !> @param[in] td_mpp mpp structure 
    … …  
    494495      ! print dimension 
    495496      IF(  td_mpp%i_ndim /= 0 )THEN 
    496          WRITE(*,'(/a)') " MPP dimension" 
     497         WRITE(*,'(/a)') " File dimension" 
    497498         DO ji=1,ip_maxdim 
    498499            IF( td_mpp%t_dim(ji)%l_use )THEN 
    … …  
    697698      CALL dim_clean(tl_dim) 
    698699 
    699       IF( (       PRESENT(id_niproc)  .AND. (.NOT. PRESENT(id_njproc))) .OR. & 
     700      IF( (       PRESENT(id_niproc)  .AND. (.NOT. PRESENT(id_niproc))) .OR. & 
    700701          ((.NOT. PRESENT(id_niproc)) .AND.        PRESENT(id_njproc) ) )THEN 
    701702          CALL logger_warn( "MPP INIT: number of processors following I and J "//& 
    … …  
    911912   !> 
    912913   !> @author J.Paul 
    913    !> @date November, 2013 - Initial Version 
     914   !> - November, 2013- Initial Version 
    914915   ! 
    915916   !> @param[in] td_file   file strcuture 
    … …  
    10271028            ! create some attributes for domain decomposition (use with dimg file) 
    10281029            tl_att=att_init( "DOMAIN_number_total", mpp__init_file%i_nproc ) 
    1029             CALL mpp_move_att(mpp__init_file, tl_att) 
     1030            CALL mpp_add_att(mpp__init_file, tl_att) 
    10301031 
    10311032            tl_att=att_init( "DOMAIN_I_position_first", mpp__init_file%t_proc(:)%i_impp ) 
    1032             CALL mpp_move_att(mpp__init_file, tl_att) 
     1033            CALL mpp_add_att(mpp__init_file, tl_att) 
    10331034 
    10341035            tl_att=att_init( "DOMAIN_J_position_first", mpp__init_file%t_proc(:)%i_jmpp ) 
    1035             CALL mpp_move_att(mpp__init_file, tl_att) 
     1036            CALL mpp_add_att(mpp__init_file, tl_att) 
    10361037 
    10371038            tl_att=att_init( "DOMAIN_I_position_last", mpp__init_file%t_proc(:)%i_lci ) 
    1038             CALL mpp_move_att(mpp__init_file, tl_att) 
     1039            CALL mpp_add_att(mpp__init_file, tl_att) 
    10391040 
    10401041            tl_att=att_init( "DOMAIN_J_position_last", mpp__init_file%t_proc(:)%i_lcj ) 
    1041             CALL mpp_move_att(mpp__init_file, tl_att) 
     1042            CALL mpp_add_att(mpp__init_file, tl_att) 
    10421043 
    10431044            tl_att=att_init( "DOMAIN_I_halo_size_start", mpp__init_file%t_proc(:)%i_ldi ) 
    1044             CALL mpp_move_att(mpp__init_file, tl_att) 
     1045            CALL mpp_add_att(mpp__init_file, tl_att) 
    10451046 
    10461047            tl_att=att_init( "DOMAIN_J_halo_size_start", mpp__init_file%t_proc(:)%i_ldj ) 
    1047             CALL mpp_move_att(mpp__init_file, tl_att) 
     1048            CALL mpp_add_att(mpp__init_file, tl_att) 
    10481049 
    10491050            tl_att=att_init( "DOMAIN_I_halo_size_end", mpp__init_file%t_proc(:)%i_lei ) 
    1050             CALL mpp_move_att(mpp__init_file, tl_att) 
     1051            CALL mpp_add_att(mpp__init_file, tl_att) 
    10511052 
    10521053            tl_att=att_init( "DOMAIN_J_halo_size_end", mpp__init_file%t_proc(:)%i_lej ) 
    1053             CALL mpp_move_att(mpp__init_file, tl_att) 
     1054            CALL mpp_add_att(mpp__init_file, tl_att) 
    10541055             
    10551056            ! clean 
    … …  
    11211122      CALL file_clean(tl_file) 
    11221123 
     1124      CALL logger_debug("MPP INIT READ: fin init_read ") 
    11231125   END FUNCTION mpp__init_file 
    11241126   !------------------------------------------------------------------- 
    … …  
    11291131   ! 
    11301132   !> @author J.Paul 
    1131    !> @date November, 2013 - Initial Version 
    1132    !> @date July, 2015 - add only use dimension in MPP structure 
     1133   !> - November, 2013- Initial Version 
    11331134   !> 
    11341135   !> @param[in] td_file   file strcuture 
    … …  
    11621163         IF( td_file%i_id == 0 )THEN 
    11631164            CALL logger_info(" id "//TRIM(fct_str(td_file%i_id)))  
    1164             CALL logger_error("MPP INIT READ: netcdf file "//& 
    1165                &  TRIM(td_file%c_name)//" not opened") 
     1165            CALL logger_error("MPP INIT READ: netcdf file "//TRIM(td_file%c_name)//& 
     1166            &  " not opened") 
    11661167         ELSE 
    11671168 
    … …  
    11901191               CALL mpp_add_dim(mpp__init_file_cdf,tl_dim) 
    11911192            ENDIF 
    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 
     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) 
    12021198 
    12031199            ! initialise file/processor 
    … …  
    13161312   ! 
    13171313   !> @author J.Paul 
    1318    !> @date November, 2013 - Initial Version 
     1314   !> - November, 2013- Initial Version 
    13191315   ! 
    13201316   !> @param[in] td_file   file strcuture 
    … …  
    15361532   ! 
    15371533   !> @author J.Paul 
    1538    !> @date November, 2013 - Initial Version 
     1534   !> - Nov, 2013- Initial Version 
    15391535   ! 
    15401536   !> @param[in] td_mpp    mpp structure 
    … …  
    16281624            IF( il_varid /= 0 )THEN 
    16291625 
     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) ) 
    16391636 
    16401637            ELSE 
    … …  
    16781675   ! 
    16791676   !> @author J.Paul 
    1680    !> @date November, 2013 - Initial Version 
     1677   !> - November, 2013- Initial Version 
    16811678   ! 
    16821679   !> @param[in] td_mpp    mpp structure 
    … …  
    18431840   !> @author J.Paul 
    18441841   !> @date November, 2013 - Initial version 
    1845    !> @date February, 2015  
    1846    !> - define local variable structure to avoid mistake with pointer 
    18471842   ! 
    18481843   !> @param[inout] td_mpp    mpp strcuture 
    … …  
    18571852      ! local variable 
    18581853      INTEGER(i4)       :: il_varid 
    1859       TYPE(TVAR)        :: tl_var 
    18601854      !---------------------------------------------------------------- 
    18611855      ! check if mpp exist 
    … …  
    18881882            ELSE 
    18891883 
    1890                tl_var=var_copy(td_mpp%t_proc(1)%t_var(il_varid)) 
    1891                CALL mpp_del_var(td_mpp, tl_var) 
     1884               CALL mpp_del_var(td_mpp, td_mpp%t_proc(1)%t_var(il_varid))  
    18921885 
    18931886            ENDIF 
    … …  
    22002193   !> 
    22012194   !> @author J.Paul 
    2202    !> @date November, 2013 - Initial Version 
    2203    !> @date July, 2015  
    2204    !> - rewrite the same as way var_add_dim 
     2195   !> - November, 2013- Initial Version 
    22052196   !> 
    22062197   !> @param[inout] td_mpp mpp structure 
    … …  
    22172208 
    22182209      ! loop indices 
     2210      INTEGER(i4) :: ji 
    22192211      !---------------------------------------------------------------- 
    22202212      IF( td_mpp%i_ndim <= ip_maxdim )THEN 
    22212213 
    2222          ! check if dimension already used in mpp structure 
    2223          il_ind=SCAN(TRIM(cp_dimorder),TRIM(td_dim%c_sname)) 
    2224          IF( il_ind == 0 )THEN 
    2225             CALL logger_warn( & 
    2226             &  " MPP ADD DIM: dimension "//TRIM(td_dim%c_name)//& 
    2227             &  ", short name "//TRIM(td_dim%c_sname)//& 
    2228             &  ", will not be added in mpp "//TRIM(td_mpp%c_name) ) 
    2229          ELSEIF( td_mpp%t_dim(il_ind)%l_use )THEN 
    2230             CALL logger_error( & 
    2231             &  " MPP ADD DIM: dimension "//TRIM(td_dim%c_name)//& 
    2232             &  ", short name "//TRIM(td_dim%c_sname)//& 
    2233             &  ", already used in mpp "//TRIM(td_mpp%c_name) ) 
     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 
    22342230         ELSE 
    22352231 
    2236             ! back to disorder dimension array  
    2237             CALL dim_disorder(td_mpp%t_dim(:)) 
    2238  
    2239             ! add new dimension 
    2240             td_mpp%t_dim(td_mpp%i_ndim+1)=dim_copy(td_dim) 
    2241  
    2242             ! update number of attribute 
    2243             td_mpp%i_ndim=COUNT(td_mpp%t_dim(:)%l_use) 
     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 
    22442255 
    22452256         ENDIF 
    2246          ! reorder dimension to ('x','y','z','t') 
    2247          CALL dim_reorder(td_mpp%t_dim(:)) 
    22482257 
    22492258      ELSE 
    … …  
    22592268   !> 
    22602269   !> @author J.Paul 
    2261    !> @date November, 2013 - Initial Version 
    2262    !> @date July, 2015  
    2263    !> - rewrite the same as way var_del_dim 
     2270   !> - November, 2013- Initial Version 
    22642271   !> 
    22652272   !> @param[inout] td_mpp mpp structure 
    … …  
    22732280 
    22742281      ! local variable 
     2282      INTEGER(i4) :: il_status 
    22752283      INTEGER(i4) :: il_ind 
    2276       TYPE(TDIM)  :: tl_dim 
     2284      TYPE(TDIM), DIMENSION(:), ALLOCATABLE  :: tl_dim 
    22772285 
    22782286      ! loop indices 
    2279       !---------------------------------------------------------------- 
    2280  
    2281  
    2282       IF( td_mpp%i_ndim <= ip_maxdim )THEN 
    2283  
    2284          CALL logger_trace( & 
    2285          &  " MPP DEL DIM: delete dimension "//TRIM(td_dim%c_name)//& 
     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)//& 
    22862295         &  ", short name "//TRIM(td_dim%c_sname)//& 
    22872296         &  ", in mpp "//TRIM(td_mpp%c_name) ) 
    2288           
    2289          ! check if dimension already in variable structure 
    2290          il_ind=SCAN(TRIM(cp_dimorder),TRIM(td_dim%c_sname)) 
    2291  
    2292          ! replace dimension by empty one 
    2293          td_mpp%t_dim(il_ind)=dim_copy(tl_dim) 
    2294  
    2295          ! update number of dimension 
    2296          td_mpp%i_ndim=COUNT(td_mpp%t_dim(:)%l_use) 
    2297  
    2298          ! reorder dimension to ('x','y','z','t') 
    2299          CALL dim_reorder(td_mpp%t_dim) 
    23002297 
    23012298      ELSE 
    2302          CALL logger_error( & 
    2303          &  " MPP DEL DIM: too much dimension in mpp "//& 
    2304          &  TRIM(td_mpp%c_name)//" ("//TRIM(fct_str(td_mpp%i_ndim))//")") 
     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 
    23052333      ENDIF 
    23062334 
    … …  
    23122340   !> 
    23132341   !> @author J.Paul 
    2314    !> @date November, 2013 - Initial Version 
     2342   !> - November, 2013- Initial Version 
    23152343   !> 
    23162344   !> @param[inout] td_mpp mpp structure 
    … …  
    24602488            &  ", in mpp structure "//TRIM(td_mpp%c_name) ) 
    24612489 
    2462             IF( ASSOCIATED(td_mpp%t_proc(1)%t_att) )THEN 
     2490            IF( ASSOCIATED(td_mpp%t_proc(1)%t_var) )THEN 
    24632491               DO ji=1,td_mpp%t_proc(1)%i_natt 
    24642492                  CALL logger_debug( "MPP DEL ATT: in mpp structure : & 
    2465                   &  attribute : "//TRIM(td_mpp%t_proc(1)%t_att(ji)%c_name) ) 
     2493                  &  attribute : "//TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name) ) 
    24662494               ENDDO 
    24672495            ENDIF 
    … …  
    24882516   !> @author J.Paul 
    24892517   !> @date November, 2013 - Initial version 
    2490    !> @date February, 2015  
    2491    !> - define local attribute structure to avoid mistake with pointer 
    24922518   ! 
    24932519   !> @param[inout] td_mpp    mpp strcuture 
    … …  
    25012527 
    25022528      ! local variable 
    2503       INTEGER(i4) :: il_attid 
    2504       TYPE(TATT)  :: tl_att 
     2529      INTEGER(i4)       :: il_attid 
    25052530      !---------------------------------------------------------------- 
    25062531      ! check if mpp exist 
    … …  
    25262551            IF( il_attid == 0 )THEN 
    25272552 
    2528                CALL logger_debug( & 
     2553               CALL logger_warn( & 
    25292554               &  "MPP DEL ATT : there is no attribute with "//& 
    25302555               &  "name "//TRIM(cd_name)//" in mpp structure "//& 
    … …  
    25332558            ELSE 
    25342559 
    2535                tl_att=att_copy(td_mpp%t_proc(1)%t_att(il_attid)) 
    2536                CALL mpp_del_att(td_mpp, tl_att)  
     2560               CALL mpp_del_att(td_mpp, td_mpp%t_proc(1)%t_att(il_attid))  
    25372561 
    25382562            ENDIF 
    … …  
    28392863 
    28402864            CALL logger_info("MPP OPTIMIZ: number of processor "//& 
    2841             &   TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//& 
    2842             &   TRIM(fct_str(tl_mpp%i_nproc)) ) 
     2865            &  TRIM(fct_str(tl_mpp%i_nproc)) ) 
    28432866            IF( tl_mpp%i_nproc > td_mpp%i_nproc .AND. & 
    28442867            &   tl_mpp%i_nproc <= il_maxproc )THEN 
    28452868               ! save optimiz decomposition  
    2846  
    2847                CALL logger_info("MPP OPTIMIZ:save this decomposition "//& 
    2848                &   TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//& 
    2849                &   TRIM(fct_str(tl_mpp%i_nproc)) ) 
    28502869 
    28512870               ! clean mpp 
    … …  
    31273146   !> 
    31283147   !> @author J.Paul 
    3129    !> @date November, 2013 - Initial version 
     3148   !> @date November, 2013 
    31303149   !> 
    31313150   !> @param[inout] td_mpp mpp strcuture 
    … …  
    31653184   !> 
    31663185   !> @author J.Paul 
    3167    !> @date November, 2013 - Initial version 
     3186   !> @date November, 2013 
    31683187   !> 
    31693188   !> @param[in] td_mpp    mpp strcuture 
    … …  
    32303249   ! 
    32313250   !> @author J.Paul 
    3232    !> @date November, 2013 - Initial version 
     3251   !> @date November, 2013 
    32333252   ! 
    32343253   !> @param[in] td_mpp    mpp strcuture 
    … …  
    32923311   !> 
    32933312   !> @author J.Paul 
    3294    !> @date November, 2013 - Initial version 
     3313   !> @date November, 2013 
    32953314   !> 
    32963315   !> @param[inout] td_mpp mpp strcuture 
    … …  
    33853404   !> 
    33863405   !> @author J.Paul 
    3387    !> @date November, 2013 - Initial Version 
     3406   !> - November, 2013- Initial Version 
    33883407   !> 
    33893408   !> @param[in] td_mpp mpp structure 
    … …  
    33983417 
    33993418      ! local variable 
     3419      INTEGER(i4) :: il_ndim 
    34003420 
    34013421      ! loop indices 
    … …  
    34093429         mpp__check_var_dim=.FALSE. 
    34103430 
     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 
    34113436         CALL logger_debug( & 
    34123437         &  " mpp dimension: "//TRIM(fct_str(td_mpp%i_ndim))//& 
    34133438         &  " variable dimension: "//TRIM(fct_str(td_var%i_ndim)) ) 
    3414          DO ji = 1, ip_maxdim 
     3439         il_ndim=MIN(td_var%i_ndim, td_mpp%i_ndim ) 
     3440         DO ji = 1, il_ndim 
    34153441            CALL logger_debug( & 
    34163442            &  "MPP CHECK DIM: for dimension "//& 
    … …  
    34223448            &  ", variable used "//TRIM(fct_str(td_var%t_dim(ji)%l_use))) 
    34233449         ENDDO 
    3424  
    3425          CALL logger_error( & 
    3426          &  "MPP CHECK DIM: variable and mpp dimension differ"//& 
    3427          &  " for variable "//TRIM(td_var%c_name)//& 
    3428          &  " and mpp "//TRIM(td_mpp%c_name)) 
    3429  
    34303450      ENDIF 
    34313451 
    … …  
    34363456   ! 
    34373457   !> @author J.Paul 
    3438    !> @date November, 2013 - Initial Version 
     3458   !> - November, 2013- Initial Version 
    34393459   ! 
    34403460   !> @param[in] td_file   array of file structure 
    … …  
    34763496   ! 
    34773497   !> @author J.Paul 
    3478    !> @date Ocotber, 2014 - Initial Version 
     3498   !> - Ocotber, 2014- Initial Version 
    34793499   ! 
    34803500   !> @param[in] td_mpp   mpp file structure 
Note: See TracChangeset for help on using the changeset viewer.