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/iom_mpp.f90 – NEMO

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

update nemo trunk

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r9598 r12080  
    22! NEMO system team, System and Interface for oceanic RElocable Nesting 
    33!---------------------------------------------------------------------- 
    4 ! 
    5 ! MODULE: iom_mpp 
    64! 
    75! DESCRIPTION: 
    … …  
    8684!> @author 
    8785!> J.Paul 
    88 ! REVISION HISTORY: 
     86!> 
    8987!> @date November, 2013 - Initial Version 
    9088!> 
    91 !> @note Software governed by the CeCILL licence     (./LICENSE) 
     89!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    9290!---------------------------------------------------------------------- 
    9391MODULE iom_mpp 
     92 
    9493   USE netcdf                          ! nf90 library 
    9594   USE global                          ! global parameter 
    … …  
    103102   USE iom                             ! I/O manager 
    104103   USE mpp                             ! mpp manager 
     104 
    105105   IMPLICIT NONE 
    106106   ! NOTE_avoid_public_variables_if_possible 
    … …  
    123123 
    124124CONTAINS 
     125   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     126   SUBROUTINE iom_mpp_open(td_mpp, id_perio, id_ew) 
    125127   !------------------------------------------------------------------- 
    126128   !> @brief This subroutine open files composing mpp structure to be used. 
    … …  
    138140   !> @author J.Paul 
    139141   !> @date November, 2013 - Initial Version 
    140    ! 
     142   !> @date August, 2017  
     143   !> - handle use of domain decomposition for monoproc file 
     144   !> 
    141145   !> @param[inout] td_mpp mpp structure 
    142146   !------------------------------------------------------------------- 
    143    SUBROUTINE iom_mpp_open(td_mpp, id_perio, id_ew) 
     147 
    144148      IMPLICIT NONE 
     149 
    145150      ! Argument       
    146151      TYPE(TMPP) , INTENT(INOUT)  :: td_mpp 
    … …  
    150155      ! local variable 
    151156      CHARACTER(LEN=lc) :: cl_name 
     157      INTEGER(i4) :: il_pid   
     158      INTEGER(i4) :: il_impp  
     159      INTEGER(i4) :: il_jmpp  
     160      INTEGER(i4) :: il_lci   
     161      INTEGER(i4) :: il_lcj   
     162      INTEGER(i4) :: il_ldi   
     163      INTEGER(i4) :: il_ldj   
     164      INTEGER(i4) :: il_lei   
     165      INTEGER(i4) :: il_lej   
     166      LOGICAL     :: ll_ctr   
     167      LOGICAL     :: ll_use   
     168      LOGICAL     :: ll_create   
     169      INTEGER(i4) :: il_iind  
     170      INTEGER(i4) :: il_jind  
    152171 
    153172      ! loop indices 
    … …  
    175194 
    176195         td_mpp%t_proc(:)%c_type=TRIM(td_mpp%c_type)  
    177          IF( td_mpp%i_nproc > 1 )THEN 
     196         IF( td_mpp%i_nproc > 1 .AND. td_mpp%l_usempp )THEN 
    178197            DO ji=1,td_mpp%i_nproc 
    179198               IF( td_mpp%t_proc(ji)%l_use )THEN 
    … …  
    200219 
    201220               CALL iom_open(td_mpp%t_proc(1)) 
     221 
     222               IF( .NOT. td_mpp%l_usempp )THEN 
     223                  ! copy file structure of first proc, except layout decomposition 
     224                  ! do not do it when creating output file. 
     225                  ll_create=( ALL(td_mpp%t_proc(:)%l_wrt) .AND. & 
     226                  &           ALL(td_mpp%t_proc(:)%l_use) ) 
     227                  IF( .NOT. ll_create )THEN 
     228                     DO ji=2,td_mpp%i_nproc 
     229                        IF( td_mpp%t_proc(ji)%l_use )THEN 
     230                           il_pid  = td_mpp%t_proc(ji)%i_pid   
     231                           il_impp = td_mpp%t_proc(ji)%i_impp  
     232                           il_jmpp = td_mpp%t_proc(ji)%i_jmpp  
     233                           il_lci  = td_mpp%t_proc(ji)%i_lci   
     234                           il_lcj  = td_mpp%t_proc(ji)%i_lcj   
     235                           il_ldi  = td_mpp%t_proc(ji)%i_ldi   
     236                           il_ldj  = td_mpp%t_proc(ji)%i_ldj   
     237                           il_lei  = td_mpp%t_proc(ji)%i_lei   
     238                           il_lej  = td_mpp%t_proc(ji)%i_lej   
     239                           ll_ctr  = td_mpp%t_proc(ji)%l_ctr   
     240                           ll_use  = td_mpp%t_proc(ji)%l_use   
     241                           il_iind = td_mpp%t_proc(ji)%i_iind  
     242                           il_jind = td_mpp%t_proc(ji)%i_jind  
     243 
     244                           td_mpp%t_proc(ji)=file_copy(td_mpp%t_proc(1)) 
     245                           td_mpp%t_proc(ji)%i_id=td_mpp%t_proc(1)%i_id 
     246                           td_mpp%t_proc(ji)%l_def=.FALSE. 
     247 
     248                           td_mpp%t_proc(ji)%i_pid  = il_pid   
     249                           td_mpp%t_proc(ji)%i_impp = il_impp  
     250                           td_mpp%t_proc(ji)%i_jmpp = il_jmpp  
     251                           td_mpp%t_proc(ji)%i_lci  = il_lci   
     252                           td_mpp%t_proc(ji)%i_lcj  = il_lcj   
     253                           td_mpp%t_proc(ji)%i_ldi  = il_ldi   
     254                           td_mpp%t_proc(ji)%i_ldj  = il_ldj   
     255                           td_mpp%t_proc(ji)%i_lei  = il_lei   
     256                           td_mpp%t_proc(ji)%i_lej  = il_lej   
     257                           td_mpp%t_proc(ji)%l_ctr  = ll_ctr   
     258                           td_mpp%t_proc(ji)%l_use  = ll_use   
     259                           td_mpp%t_proc(ji)%i_iind = il_iind  
     260                           td_mpp%t_proc(ji)%i_jind = il_jind  
     261                        ENDIF 
     262                     ENDDO 
     263                  ELSE 
     264                     ! keep file id 
     265                     DO ji=2,td_mpp%i_nproc 
     266                        IF( td_mpp%t_proc(ji)%l_use )THEN  
     267                           td_mpp%t_proc(ji)%i_id=td_mpp%t_proc(1)%i_id 
     268                           td_mpp%t_proc(ji)%l_def=.FALSE. 
     269                        ENDIF 
     270                     ENDDO 
     271                  ENDIF 
     272               ENDIF 
     273 
    202274         ENDIF 
    203275 
    … …  
    219291 
    220292   END SUBROUTINE iom_mpp_open 
     293   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     294   SUBROUTINE iom_mpp_create(td_mpp) 
    221295   !------------------------------------------------------------------- 
    222296   !> @brief This subroutine create files, composing mpp structure to be used, 
    … …  
    225299   !> @author J.Paul 
    226300   !> @date November, 2013 - Initial Version 
    227    ! 
     301   !> 
    228302   !> @param[inout] td_mpp mpp structure 
    229303   !------------------------------------------------------------------- 
    230    SUBROUTINE iom_mpp_create(td_mpp) 
     304 
    231305      IMPLICIT NONE 
     306 
    232307      ! Argument       
    233308      TYPE(TMPP), INTENT(INOUT)  :: td_mpp 
    … …  
    247322 
    248323   END SUBROUTINE iom_mpp_create 
     324   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     325   SUBROUTINE iom_mpp_close(td_mpp) 
    249326   !------------------------------------------------------------------- 
    250327   !> @brief This subroutine close files composing mpp structure. 
    … …  
    252329   !> @author J.Paul 
    253330   !> @date November, 2013 - Initial Version 
    254    ! 
     331   !> 
    255332   !> @param[in] td_mpp mpp structure 
    256333   !------------------------------------------------------------------- 
    257    SUBROUTINE iom_mpp_close(td_mpp) 
     334 
    258335      IMPLICIT NONE 
     336 
    259337      ! Argument       
    260338      TYPE(TMPP), INTENT(INOUT) :: td_mpp 
    … …  
    273351         td_mpp%i_id=0          
    274352 
    275          DO ji=1,td_mpp%i_nproc 
    276             IF( td_mpp%t_proc(ji)%i_id /= 0 )THEN 
    277                CALL iom_close(td_mpp%t_proc(ji)) 
     353         IF( td_mpp%l_usempp )THEN 
     354            DO ji=1,td_mpp%i_nproc 
     355               IF( td_mpp%t_proc(ji)%i_id /= 0 )THEN 
     356                  CALL iom_close(td_mpp%t_proc(ji)) 
     357               ENDIF 
     358            ENDDO 
     359         ELSE 
     360            IF( td_mpp%t_proc(1)%i_id /= 0 )THEN 
     361               CALL iom_close(td_mpp%t_proc(1)) 
     362               td_mpp%t_proc(:)%i_id=0 
    278363            ENDIF 
    279          ENDDO 
     364         ENDIF 
    280365         td_mpp%t_proc(:)%l_use=.FALSE. 
     366 
    281367      ENDIF 
    282368 
    283369   END SUBROUTINE iom_mpp_close 
     370   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     371   FUNCTION iom_mpp__read_var_id(td_mpp, id_varid, id_start, id_count) & 
     372         & RESULT (tf_var) 
    284373   !------------------------------------------------------------------- 
    285374   !> @brief This function read variable value in opened mpp files, 
    … …  
    302391   !> @return  variable structure  
    303392   !------------------------------------------------------------------- 
    304    TYPE(TVAR) FUNCTION iom_mpp__read_var_id(td_mpp, id_varid,& 
    305    &                                        id_start, id_count) 
     393 
    306394      IMPLICIT NONE 
     395 
    307396      ! Argument       
    308397      TYPE(TMPP),                INTENT(IN) :: td_mpp 
    … …  
    311400      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count       
    312401 
     402      ! function 
     403      TYPE(TVAR)                            :: tf_var 
     404 
    313405      ! local variable 
    314406      INTEGER(i4), DIMENSION(1) :: il_ind 
    … …  
    334426            IF( il_ind(1) /= 0 )THEN 
    335427 
    336                iom_mpp__read_var_id=var_copy(td_mpp%t_proc(1)%t_var(il_ind(1))) 
     428               tf_var=var_copy(td_mpp%t_proc(1)%t_var(il_ind(1))) 
    337429 
    338430               !!! read variable value 
    339                CALL iom_mpp__read_var_value(td_mpp, iom_mpp__read_var_id, & 
    340                &                            id_start, id_count) 
     431               CALL iom_mpp__read_var_value(td_mpp, tf_var, id_start, id_count) 
    341432 
    342433            ELSE 
    … …  
    354445 
    355446   END FUNCTION iom_mpp__read_var_id 
     447   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     448   FUNCTION iom_mpp__read_var_name(td_mpp, cd_name, id_start, id_count) & 
     449         & RESULT (tf_var) 
    356450   !------------------------------------------------------------------- 
    357451   !> @brief This function read variable value in opened mpp files,  
    … …  
    365459   !> exist in file, look for variable standard name.<br/> 
    366460   !> If variable name is not present, check variable standard name.<br/> 
    367    ! 
     461   !> 
    368462   !> @author J.Paul 
    369463   !> @date November, 2013 - Initial Version 
    370464   !> @date October, 2014 
    371465   !> - use start and count array instead of domain structure. 
    372    ! 
     466   !> 
    373467   !> @param[in] td_mpp    mpp structure 
    374468   !> @param[in] cd_name   variable name 
    … …  
    378472   !> @return  variable structure  
    379473   !------------------------------------------------------------------- 
    380    TYPE(TVAR) FUNCTION iom_mpp__read_var_name(td_mpp, cd_name,    & 
    381    &                                          id_start, id_count ) 
     474 
    382475      IMPLICIT NONE 
     476 
    383477      ! Argument       
    384478      TYPE(TMPP),                INTENT(IN) :: td_mpp 
    385479      CHARACTER(LEN=*),          INTENT(IN) :: cd_name 
    386480      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start 
    387       INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count       
     481      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count 
     482 
     483      ! function 
     484      TYPE(TVAR)                            :: tf_var 
    388485 
    389486      ! local variable 
    … …  
    400497         CALL logger_error( " IOM MPP READ VAR: mpp structure not opened. "//& 
    401498         &               " can not read variable in "//TRIM(td_mpp%c_name))    
    402        
     499  
    403500      ELSE 
    404501 
    … …  
    406503            IF( il_ind /= 0 )THEN 
    407504 
    408                iom_mpp__read_var_name=var_copy(td_mpp%t_proc(1)%t_var(il_ind)) 
     505               tf_var=var_copy(td_mpp%t_proc(1)%t_var(il_ind)) 
    409506 
    410507               !!! read variable value 
    411                CALL iom_mpp__read_var_value( td_mpp, & 
    412                &                             iom_mpp__read_var_name, & 
    413                &                             id_start, id_count) 
     508               CALL iom_mpp__read_var_value( td_mpp, tf_var, id_start, id_count) 
    414509 
    415510            ELSE 
    … …  
    424519       
    425520   END FUNCTION iom_mpp__read_var_name 
     521   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     522   SUBROUTINE iom_mpp__read_var_value(td_mpp, td_var, id_start, id_count) 
    426523   !------------------------------------------------------------------- 
    427524   !> @brief This subroutine read variable value 
    … …  
    431528   !> Optionally start indices and number of point to be read could be specify. 
    432529   !> as well as East West ovelap of the global domain. 
    433    ! 
     530   !> 
    434531   !> @author J.Paul 
    435532   !> @date November, 2013 - Initial Version 
    … …  
    443540   !> @param[in] id_count  number of indices selected along each dimension 
    444541   !------------------------------------------------------------------- 
    445    SUBROUTINE iom_mpp__read_var_value(td_mpp, td_var, & 
    446    &                                  id_start, id_count ) 
     542 
    447543      IMPLICIT NONE 
     544 
    448545      ! Argument       
    449       TYPE(TMPP),   INTENT(IN)    :: td_mpp 
    450       TYPE(TVAR),  INTENT(INOUT) :: td_var 
    451       INTEGER(i4), DIMENSION(:), INTENT(IN),  OPTIONAL :: id_start 
    452       INTEGER(i4), DIMENSION(:), INTENT(IN),  OPTIONAL :: id_count       
     546      TYPE(TMPP)               , INTENT(IN   ) :: td_mpp 
     547      TYPE(TVAR)               , INTENT(INOUT) :: td_var 
     548      INTEGER(i4), DIMENSION(:), INTENT(IN   ), OPTIONAL :: id_start 
     549      INTEGER(i4), DIMENSION(:), INTENT(IN   ), OPTIONAL :: id_count       
    453550 
    454551      ! local variable 
    … …  
    494591               &  TRIM(fct_str(il_count(jp_K)))//","//& 
    495592               &  TRIM(fct_str(il_count(jp_L))) ) 
     593 
     594      !IF( td_mpp%l_usempp .AND. (PRESENT(id_start) .OR. PRESENT(id_count)))THEN 
     595      !   CALL logger_fatal("IOM MPP READ VAR VALUE: should not use"//& 
     596      !      &  " start or count arguments when usempp is False.") 
     597      !ENDIF 
    496598 
    497599      DO jk=1,ip_maxdim 
    … …  
    574676 
    575677            IF( (il_i1<=il_i2).AND.(il_j1<=il_j2) )THEN 
    576                il_strt(:)=(/ il_i1-il_i1p+1, & 
    577                &             il_j1-il_j1p+1, & 
    578                &             1,1 /) 
     678               IF( td_mpp%l_usempp )THEN 
     679                  il_strt(:)=(/ il_i1-il_i1p+1, & 
     680                  &             il_j1-il_j1p+1, & 
     681                  &             1,1 /) 
     682               ELSE 
     683                  il_strt(:)=(/ il_i1, & 
     684                  &             il_j1, & 
     685                  &             1,1 /) 
     686               ENDIF 
    579687 
    580688               il_cnt(:)=(/ il_i2-il_i1+1,         & 
    … …  
    616724 
    617725   END SUBROUTINE iom_mpp__read_var_value 
     726   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     727   SUBROUTINE iom_mpp_write_file(td_mpp, cd_dimorder) 
    618728   !------------------------------------------------------------------- 
    619729   !> @brief This subroutine write files composing mpp structure. 
    620    ! 
     730   !> 
    621731   !> @details 
    622732   !> optionally, you could specify the dimension order (default 'xyzt') 
    623    ! 
     733   !> 
    624734   !> @author J.Paul 
    625735   !> @date November, 2013 - Initial Version 
    626    !> @date July, 2015 - add dimension order option  
    627    ! 
     736   !> @date July, 2015  
     737   !> - add dimension order option  
     738   !> @date August, 2017  
     739   !> - handle use of domain decomposition for monoproc file 
     740   !> 
    628741   !> @param[inout] td_mpp mpp structure 
    629    !> @param[In] cd_dimorder dimension order 
    630    !------------------------------------------------------------------- 
    631    SUBROUTINE iom_mpp_write_file(td_mpp, cd_dimorder) 
     742   !> @param[in] cd_dimorder dimension order 
     743   !------------------------------------------------------------------- 
     744 
    632745      IMPLICIT NONE 
     746 
    633747      ! Argument       
    634748      TYPE(TMPP)      , INTENT(INOUT) :: td_mpp 
    … …  
    639753      INTEGER(i4) :: ji 
    640754      !---------------------------------------------------------------- 
     755 
    641756      ! check if mpp exist 
    642757      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN 
    … …  
    646761 
    647762      ELSE 
    648          DO ji=1, td_mpp%i_nproc 
    649             IF( td_mpp%t_proc(ji)%i_id /= 0 )THEN 
    650                CALL iom_write_file(td_mpp%t_proc(ji), cd_dimorder) 
    651             ELSE 
    652                CALL logger_debug( " MPP WRITE: no id associated to file "//& 
    653                &              TRIM(td_mpp%t_proc(ji)%c_name) ) 
     763         IF( td_mpp%l_usempp )THEN 
     764            DO ji=1, td_mpp%i_nproc 
     765               IF( td_mpp%t_proc(ji)%i_id /= 0 )THEN 
     766                  CALL logger_debug("MPP WRITE: proc "//TRIM(fct_str(ji))) 
     767                  CALL iom_write_file(td_mpp%t_proc(ji), cd_dimorder) 
     768               ELSE 
     769                  CALL logger_debug( " MPP WRITE: no id associated to file "//& 
     770                  &              TRIM(td_mpp%t_proc(ji)%c_name) ) 
     771               ENDIF 
     772            ENDDO 
     773         ELSE 
     774            CALL iom_write_header(td_mpp%t_proc(1), cd_dimorder, td_mpp%t_dim(:)) 
     775 
     776            CALL iom_mpp__write_var(td_mpp, cd_dimorder) 
     777         ENDIF 
     778      ENDIF 
     779 
     780   END SUBROUTINE iom_mpp_write_file 
     781   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     782   SUBROUTINE iom_mpp__write_var(td_mpp, cd_dimorder) 
     783   !------------------------------------------------------------------- 
     784   !> @brief This subroutine write variables from mpp structure in one output 
     785   !> file. 
     786   !> 
     787   !> @details 
     788   !> optionally, you could specify the dimension order (default 'xyzt') 
     789   !> 
     790   !> @author J.Paul 
     791   !> @date August, 2017 - Initial Version 
     792   !> 
     793   !> @param[inout] td_mpp mpp structure 
     794   !> @param[in] cd_dimorder dimension order 
     795   !------------------------------------------------------------------- 
     796 
     797      IMPLICIT NONE 
     798 
     799      ! Argument       
     800      TYPE(TMPP)      , INTENT(INOUT) :: td_mpp 
     801      CHARACTER(LEN=*), INTENT(IN   ), OPTIONAL :: cd_dimorder 
     802 
     803      ! local variable 
     804      INTEGER(i4), DIMENSION(4)         :: il_ind 
     805      INTEGER(i4)                       :: il_i1p 
     806      INTEGER(i4)                       :: il_i2p 
     807      INTEGER(i4)                       :: il_j1p 
     808      INTEGER(i4)                       :: il_j2p 
     809      INTEGER(i4)                       :: il_i1 
     810      INTEGER(i4)                       :: il_i2 
     811      INTEGER(i4)                       :: il_j1 
     812      INTEGER(i4)                       :: il_j2 
     813 
     814      INTEGER(i4), DIMENSION(ip_maxdim) :: il_start 
     815      INTEGER(i4), DIMENSION(ip_maxdim) :: il_count      
     816 
     817      INTEGER(i4), DIMENSION(ip_maxdim) :: il_strt 
     818      INTEGER(i4), DIMENSION(ip_maxdim) :: il_cnt       
     819 
     820      REAL(dp)                          :: dl_fill 
     821 
     822      TYPE(TFILE)                       :: tl_file 
     823 
     824      ! loop indices 
     825      INTEGER(i4) :: ji 
     826      INTEGER(i4) :: jj 
     827      !---------------------------------------------------------------- 
     828 
     829      ! write variable in file 
     830      DO jj = 1, td_mpp%i_nproc 
     831          
     832         ! link 
     833         tl_file=td_mpp%t_proc(jj) 
     834         CALL logger_debug("IOM MPP WRITE: proc "//fct_str(jj)) 
     835 
     836         ! get processor indices 
     837         il_ind(:)=mpp_get_proc_index( td_mpp, jj ) 
     838         il_i1p = il_ind(1) 
     839         il_i2p = il_ind(2) 
     840         il_j1p = il_ind(3) 
     841         il_j2p = il_ind(4) 
     842       
     843         IF( jj > 1 )THEN 
     844            ! force to use id from variable write on first proc 
     845            tl_file%t_var(:)%i_id=td_mpp%t_proc(1)%t_var(:)%i_id 
     846         ENDIF 
     847 
     848         DO ji = 1, tl_file%i_nvar 
     849 
     850            IF( jj > 1 )THEN 
     851               ! check _FillValue 
     852               dl_fill=td_mpp%t_proc(1)%t_var(ji)%d_fill 
     853               IF( tl_file%t_var(ji)%d_fill /= dl_fill )THEN 
     854                  CALL var_chg_FillValue( tl_file%t_var(ji), dl_fill ) 
     855               ENDIF 
    654856            ENDIF 
     857 
     858            il_start(:)=1 
     859            il_count(:)=td_mpp%t_dim(:)%i_len 
     860 
     861            IF( .NOT. tl_file%t_var(ji)%t_dim(1)%l_use )THEN 
     862               il_i1p=1 ; il_i2p=1 
     863               il_count(1) = 1 
     864            ENDIF 
     865            IF( .NOT. tl_file%t_var(ji)%t_dim(2)%l_use )THEN 
     866               il_j1p=1 ; il_j2p=1 
     867               il_count(2) = 1 
     868            ENDIF             
     869             
     870            il_i1=MAX(il_i1p, il_start(1)) 
     871            il_i2=MIN(il_i2p, il_count(1)) 
     872 
     873            il_j1=MAX(il_j1p, il_start(2)) 
     874            il_j2=MIN(il_j2p, il_count(2)) 
     875          
     876            IF( (il_i1<=il_i2).AND.(il_j1<=il_j2) )THEN 
     877               il_strt(:)=(/ il_i1, & 
     878               &             il_j1, & 
     879               &             1,1 /) 
     880 
     881               il_cnt(:)=(/ il_i2-il_i1+1,         & 
     882               &            il_j2-il_j1+1,         & 
     883               &            tl_file%t_var(ji)%t_dim(3)%i_len, & 
     884               &            tl_file%t_var(ji)%t_dim(4)%i_len /) 
     885 
     886               CALL iom_write_var(tl_file, cd_dimorder, & 
     887               &                  id_start=il_strt(:), & 
     888               &                  id_count=il_cnt(:)) 
     889            ENDIF 
     890 
    655891         ENDDO 
    656       ENDIF 
    657    END SUBROUTINE iom_mpp_write_file 
     892      ENDDO 
     893 
     894   END SUBROUTINE iom_mpp__write_var    
     895   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    658896END MODULE iom_mpp 
Note: See TracChangeset for help on using the changeset viewer.