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 9987 for branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/TOOLS/SIREN/src/iom_mpp.f90 – NEMO

Ignore:
Timestamp:
2018-07-23T11:33:03+02:00 (6 years ago)
Author:
emmafiedler
Message:

Merge with GO6 FOAMv14 package branch r9288

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/TOOLS/SIREN/src/iom_mpp.f90

    r5037 r9987  
    8787!> J.Paul 
    8888! REVISION HISTORY: 
    89 !> @date Nov, 2013 - Initial Version 
     89!> @date November, 2013 - Initial Version 
    9090!> 
    9191!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    137137   !> 
    138138   !> @author J.Paul 
    139    !> - November, 2013- Initial Version 
     139   !> @date November, 2013 - Initial Version 
    140140   ! 
    141141   !> @param[inout] td_mpp mpp structure 
     
    161161 
    162162      ELSE 
     163         !  
     164         td_mpp%i_id=1 
     165 
    163166         ! if no processor file selected 
    164167         ! force to open all files  
     
    221224   !>  
    222225   !> @author J.Paul 
    223    !> - November, 2013- Initial Version 
     226   !> @date November, 2013 - Initial Version 
    224227   ! 
    225228   !> @param[inout] td_mpp mpp structure 
     
    248251   !> 
    249252   !> @author J.Paul 
    250    !> - November, 2013- Initial Version 
     253   !> @date November, 2013 - Initial Version 
    251254   ! 
    252255   !> @param[in] td_mpp mpp structure 
     
    267270 
    268271      ELSE 
     272         !  
     273         td_mpp%i_id=0          
     274 
    269275         DO ji=1,td_mpp%i_nproc 
    270276            IF( td_mpp%t_proc(ji)%i_id /= 0 )THEN 
     
    285291   !> 
    286292   !> @author J.Paul 
    287    !> - November, 2013- Initial Version 
     293   !> @date November, 2013 - Initial Version 
    288294   !> @date October, 2014 
    289295   !> - use start and count array instead of domain structure. 
     
    314320         &               " in mpp strcuture "//TRIM(td_mpp%c_name)) 
    315321 
     322      ELSEIF( td_mpp%i_id == 0 )THEN 
     323 
     324         CALL logger_error( " IOM MPP READ VAR: mpp structure not opened. "//& 
     325         &               " can not read variable in "//TRIM(td_mpp%c_name))    
     326       
    316327      ELSE 
     328 
    317329 
    318330         IF( ANY(td_mpp%t_proc(:)%i_id /= 0) )THEN 
     
    355367   ! 
    356368   !> @author J.Paul 
    357    !> - November, 2013- Initial Version 
     369   !> @date November, 2013 - Initial Version 
    358370   !> @date October, 2014 
    359371   !> - use start and count array instead of domain structure. 
     
    384396         &               " in mpp strcuture "//TRIM(td_mpp%c_name)) 
    385397 
     398      ELSEIF( td_mpp%i_id == 0 )THEN 
     399 
     400         CALL logger_error( " IOM MPP READ VAR: mpp structure not opened. "//& 
     401         &               " can not read variable in "//TRIM(td_mpp%c_name))    
     402       
    386403      ELSE 
    387404 
     
    400417               CALL logger_error( & 
    401418               &  " IOM MPP READ VAR: there is no variable with "//& 
    402                &  "name or standard name"//TRIM(cd_name)//& 
     419               &  "name or standard name "//TRIM(cd_name)//& 
    403420               &  " in processor/file "//TRIM(td_mpp%t_proc(1)%c_name)) 
    404421            ENDIF 
     
    416433   ! 
    417434   !> @author J.Paul 
    418    !> - November, 2013- Initial Version 
     435   !> @date November, 2013 - Initial Version 
    419436   !> @date October, 2014 
    420437   !> - use start and count array instead of domain structure. 
     
    467484      IF( PRESENT(id_count) ) il_count(:)=id_count(:) 
    468485 
     486      CALL logger_debug("IOM MPP READ VAR VALUE: start "//& 
     487               &  TRIM(fct_str(il_start(jp_I)))//","//& 
     488               &  TRIM(fct_str(il_start(jp_J)))//","//& 
     489               &  TRIM(fct_str(il_start(jp_K)))//","//& 
     490               &  TRIM(fct_str(il_start(jp_L))) ) 
     491      CALL logger_debug("IOM MPP READ VAR VALUE: count "//& 
     492               &  TRIM(fct_str(il_count(jp_I)))//","//& 
     493               &  TRIM(fct_str(il_count(jp_J)))//","//& 
     494               &  TRIM(fct_str(il_count(jp_K)))//","//& 
     495               &  TRIM(fct_str(il_count(jp_L))) ) 
     496 
    469497      DO jk=1,ip_maxdim 
    470498         IF( .NOT. td_var%t_dim(jk)%l_use )THEN 
     
    476504      ENDDO 
    477505 
    478  
    479506      IF( ANY(il_end(:) > td_mpp%t_dim(:)%i_len) )THEN 
     507            CALL logger_debug("IOM MPP READ VAR VALUE: start + count "//& 
     508               &  TRIM(fct_str(il_end(jp_I)))//","//& 
     509               &  TRIM(fct_str(il_end(jp_J)))//","//& 
     510               &  TRIM(fct_str(il_end(jp_K)))//","//& 
     511               &  TRIM(fct_str(il_end(jp_L))) ) 
     512            CALL logger_debug("IOM MPP READ VAR VALUE: dimension "//& 
     513               &  TRIM(fct_str(td_mpp%t_dim(jp_I)%i_len))//","//& 
     514               &  TRIM(fct_str(td_mpp%t_dim(jp_J)%i_len))//","//& 
     515               &  TRIM(fct_str(td_mpp%t_dim(jp_K)%i_len))//","//& 
     516               &  TRIM(fct_str(td_mpp%t_dim(jp_L)%i_len)) ) 
    480517            CALL logger_fatal("IOM MPP READ VAR VALUE: start + count "//& 
    481518            &                 "exceed dimension bound.") 
     
    583620   ! 
    584621   !> @details 
     622   !> optionally, you could specify the dimension order (default 'xyzt') 
    585623   ! 
    586624   !> @author J.Paul 
    587    !> - November, 2013- Initial Version 
     625   !> @date November, 2013 - Initial Version 
     626   !> @date July, 2015 - add dimension order option  
    588627   ! 
    589628   !> @param[inout] td_mpp mpp structure 
    590    !------------------------------------------------------------------- 
    591    SUBROUTINE iom_mpp_write_file(td_mpp) 
     629   !> @param[In] cd_dimorder dimension order 
     630   !------------------------------------------------------------------- 
     631   SUBROUTINE iom_mpp_write_file(td_mpp, cd_dimorder) 
    592632      IMPLICIT NONE 
    593633      ! Argument       
    594       TYPE(TMPP), INTENT(INOUT) :: td_mpp 
     634      TYPE(TMPP)      , INTENT(INOUT) :: td_mpp 
     635      CHARACTER(LEN=*), INTENT(IN   ), OPTIONAL :: cd_dimorder 
    595636 
    596637      ! local variable 
     
    610651               !CALL file_del_att(td_mpp%t_proc(ji), 'ew_overlap') 
    611652 
    612                CALL iom_write_file(td_mpp%t_proc(ji)) 
     653               CALL iom_write_file(td_mpp%t_proc(ji), cd_dimorder) 
    613654            ELSE 
    614655               CALL logger_debug( " MPP WRITE: no id associated to file "//& 
Note: See TracChangeset for help on using the changeset viewer.